source: git/libpolys/polys/monomials/ring.cc @ 757616

jengelh-datetimespielwiese
Last change on this file since 757616 was 757616, checked in by Hans Schoenemann <hannes@…>, 9 years ago
chg: moved char_ptr_bin to ring.cc because of tests
  • Property mode set to 100644
File size: 141.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT - the interpreter related ring operations
6*/
7
8/* includes */
9#include <math.h>
10
11#ifdef HAVE_CONFIG_H
12#include "libpolysconfig.h"
13#endif /* HAVE_CONFIG_H */
14
15#include <omalloc/omalloc.h>
16
17#include <misc/auxiliary.h>
18#include <misc/mylimits.h>
19#include <misc/options.h>
20#include <misc/int64vec.h>
21
22#include <coeffs/numbers.h>
23#include <coeffs/coeffs.h>
24
25#include <polys/monomials/p_polys.h>
26#include <polys/simpleideals.h>
27// #include <???/febase.h>
28// #include <???/intvec.h>
29// #include <coeffs/ffields.h>
30#include <polys/monomials/ring.h>
31#include <polys/monomials/maps.h>
32#include <polys/prCopy.h>
33// #include "../Singular/ipshell.h"
34#include <polys/templates/p_Procs.h>
35
36#include <polys/matpol.h>
37
38#include <polys/monomials/ring.h>
39
40#ifdef HAVE_PLURAL
41#include <polys/nc/nc.h>
42#include <polys/nc/sca.h>
43#endif
44// #include <???/maps.h>
45// #include <???/matpol.h>
46
47
48#include "ext_fields/algext.h"
49#include "ext_fields/transext.h"
50
51
52#define BITS_PER_LONG 8*SIZEOF_LONG
53
54omBin sip_sring_bin = omGetSpecBin(sizeof(ip_sring));
55omBin char_ptr_bin =  omGetSpecBin(sizeof(char*));
56
57
58static const char * const ringorder_name[] =
59{
60  " ?", ///< ringorder_no = 0,
61  "a", ///< ringorder_a,
62  "A", ///< ringorder_a64,
63  "c", ///< ringorder_c,
64  "C", ///< ringorder_C,
65  "M", ///< ringorder_M,
66  "S", ///< ringorder_S,
67  "s", ///< ringorder_s,
68  "lp", ///< ringorder_lp,
69  "dp", ///< ringorder_dp,
70  "rp", ///< ringorder_rp,
71  "Dp", ///< ringorder_Dp,
72  "wp", ///< ringorder_wp,
73  "Wp", ///< ringorder_Wp,
74  "ls", ///< ringorder_ls,
75  "ds", ///< ringorder_ds,
76  "Ds", ///< ringorder_Ds,
77  "ws", ///< ringorder_ws,
78  "Ws", ///< ringorder_Ws,
79  "am",  ///< ringorder_am,
80  "L", ///< ringorder_L,
81  "aa", ///< ringorder_aa
82  "rs", ///< ringorder_rs,
83  "IS", ///<  ringorder_IS
84  " _" ///< ringorder_unspec
85};
86
87
88const char * rSimpleOrdStr(int ord)
89{
90  return ringorder_name[ord];
91}
92
93/// unconditionally deletes fields in r
94void rDelete(ring r);
95/// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
96static void rSetVarL(ring r);
97/// get r->divmask depending on bits per exponent
98static unsigned long rGetDivMask(int bits);
99/// right-adjust r->VarOffset
100static void rRightAdjustVarOffset(ring r);
101static void rOptimizeLDeg(ring r);
102
103/*0 implementation*/
104//BOOLEAN rField_is_R(ring r)
105//{
106//  if (r->cf->ch== -1)
107//  {
108//    if (r->float_len==(short)0) return TRUE;
109//  }
110//  return FALSE;
111//}
112
113ring rDefault(const coeffs cf, int N, char **n,int ord_size, int *ord, int *block0, int *block1, int** wvhdl)
114{
115  assume( cf != NULL);
116  ring r=(ring) omAlloc0Bin(sip_sring_bin);
117  r->N     = N;
118  r->cf = cf;
119  /*rPar(r)  = 0; Alloc0 */
120  /*names*/
121  r->names = (char **) omAlloc0(N * sizeof(char *));
122  int i;
123  for(i=0;i<N;i++)
124  {
125    r->names[i]  = omStrDup(n[i]);
126  }
127  /*weights: entries for 2 blocks: NULL*/
128  if (wvhdl==NULL)
129    r->wvhdl = (int **)omAlloc0((ord_size+1) * sizeof(int *));
130  else
131    r->wvhdl=wvhdl;
132  r->order = ord;
133  r->block0 = block0;
134  r->block1 = block1;
135  /*polynomial ring*/
136  r->OrdSgn    = 1;
137
138  /* complete ring intializations */
139  rComplete(r);
140  return r;
141}
142ring rDefault(int ch, int N, char **n,int ord_size, int *ord, int *block0, int *block1,int ** wvhdl)
143{
144  coeffs cf;
145  if (ch==0) cf=nInitChar(n_Q,NULL);
146  else       cf=nInitChar(n_Zp,(void*)(long)ch);
147  assume( cf != NULL);
148  return rDefault(cf,N,n,ord_size,ord,block0,block1,wvhdl);
149}
150ring   rDefault(const coeffs cf, int N, char **n)
151{
152  assume( cf != NULL);
153  /*order: lp,0*/
154  int *order = (int *) omAlloc(2* sizeof(int));
155  int *block0 = (int *)omAlloc0(2 * sizeof(int));
156  int *block1 = (int *)omAlloc0(2 * sizeof(int));
157  /* ringorder dp for the first block: var 1..N */
158  order[0]  = ringorder_lp;
159  block0[0] = 1;
160  block1[0] = N;
161  /* the last block: everything is 0 */
162  order[1]  = 0;
163
164  return rDefault(cf,N,n,2,order,block0,block1);
165}
166
167ring rDefault(int ch, int N, char **n)
168{
169  coeffs cf;
170  if (ch==0) cf=nInitChar(n_Q,NULL);
171  else       cf=nInitChar(n_Zp,(void*)(long)ch);
172  assume( cf != NULL);
173  return rDefault(cf,N,n);
174}
175
176///////////////////////////////////////////////////////////////////////////
177//
178// rInit: define a new ring from sleftv's
179//
180//-> ipshell.cc
181
182/////////////////////////////
183// Auxillary functions
184//
185
186// check intvec, describing the ordering
187BOOLEAN rCheckIV(intvec *iv)
188{
189  if ((iv->length()!=2)&&(iv->length()!=3))
190  {
191    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
192    return TRUE;
193  }
194  return FALSE;
195}
196
197int rTypeOfMatrixOrder(intvec * order)
198{
199  int i=0,j,typ=1;
200  int sz = (int)sqrt((double)(order->length()-2));
201  if ((sz*sz)!=(order->length()-2))
202  {
203    WerrorS("Matrix order is not a square matrix");
204    typ=0;
205  }
206  while ((i<sz) && (typ==1))
207  {
208    j=0;
209    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
210    if (j>=sz)
211    {
212      typ = 0;
213      WerrorS("Matrix order not complete");
214    }
215    else if ((*order)[j*sz+i+2]<0)
216      typ = -1;
217    else
218      i++;
219  }
220  return typ;
221}
222
223/*2
224 * set a new ring from the data:
225 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
226 */
227
228int r_IsRingVar(const char *n, ring r)
229{
230  if ((r!=NULL) && (r->names!=NULL))
231  {
232    for (int i=0; i<r->N; i++)
233    {
234      if (r->names[i]==NULL) return -1;
235      if (strcmp(n,r->names[i]) == 0) return (int)i;
236    }
237  }
238  return -1;
239}
240
241
242void   rWrite(ring r, BOOLEAN details)
243{
244  if ((r==NULL)||(r->order==NULL))
245    return; /*to avoid printing after errors....*/
246
247  assume(r != NULL);
248  const coeffs C = r->cf;
249  assume(C != NULL);
250
251  int nblocks=rBlocks(r);
252
253  // omCheckAddrSize(r,sizeof(ip_sring));
254  omCheckAddrSize(r->order,nblocks*sizeof(int));
255  omCheckAddrSize(r->block0,nblocks*sizeof(int));
256  omCheckAddrSize(r->block1,nblocks*sizeof(int));
257  omCheckAddrSize(r->wvhdl,nblocks*sizeof(int *));
258  omCheckAddrSize(r->names,r->N*sizeof(char *));
259
260  nblocks--;
261
262
263  if( nCoeff_is_algExt(C) )
264  {
265    // NOTE: the following (non-thread-safe!) UGLYNESS
266    // (changing naRing->ShortOut for a while) is due to Hans!
267    // Just think of other ring using the VERY SAME naRing and possible
268    // side-effects...
269    ring R = C->extRing;
270    const BOOLEAN bSaveShortOut = rShortOut(R); R->ShortOut = rShortOut(r) & rCanShortOut(R);
271
272    n_CoeffWrite(C, details); // for correct printing of minpoly... WHAT AN UGLYNESS!!!
273
274    R->ShortOut = bSaveShortOut;
275  }
276  else
277    n_CoeffWrite(C, details);
278//   {
279//     PrintS("//   characteristic : ");
280//
281//     char const * const * const params = rParameter(r);
282//
283//     if (params!=NULL)
284//     {
285//       Print ("//   %d parameter    : ",rPar(r));
286//
287//       char const * const * sp= params;
288//       int nop=0;
289//       while (nop<rPar(r))
290//       {
291//         PrintS(*sp);
292//         PrintS(" ");
293//         sp++; nop++;
294//       }
295//       PrintS("\n//   minpoly        : ");
296//       if ( rField_is_long_C(r) )
297//       {
298//         // i^2+1:
299//         Print("(%s^2+1)\n", params[0]);
300//       }
301//       else if (rMinpolyIsNULL(r))
302//       {
303//         PrintS("0\n");
304//       }
305//       else
306//       {
307//         StringSetS(""); n_Write(r->cf->minpoly, r); PrintS(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
308//       }
309//       //if (r->qideal!=NULL)
310//       //{
311//       //  iiWriteMatrix((matrix)r->qideal,"//   minpolys",1,r,0);
312//       //  PrintLn();
313//       //}
314//     }
315//   }
316  Print("//   number of vars : %d",r->N);
317
318  //for (nblocks=0; r->order[nblocks]; nblocks++);
319  nblocks=rBlocks(r)-1;
320
321  for (int l=0, nlen=0 ; l<nblocks; l++)
322  {
323    int i;
324    Print("\n//        block %3d : ",l+1);
325
326    Print("ordering %s", rSimpleOrdStr(r->order[l]));
327
328
329    if (r->order[l] == ringorder_s)
330    {
331      assume( l == 0 );
332#ifndef NDEBUG
333      Print("  syzcomp at %d",r->typ[l].data.syz.limit);
334#endif
335      continue;
336    }
337    else if (r->order[l] == ringorder_IS)
338    {
339      assume( r->block0[l] == r->block1[l] );
340      const int s = r->block0[l];
341      assume( (-2 < s) && (s < 2) );
342      Print("(%d)", s); // 0 => prefix! +/-1 => suffix!
343      continue;
344    }
345    else if (
346    (  (r->order[l] >= ringorder_lp)
347    ||(r->order[l] == ringorder_M)
348    ||(r->order[l] == ringorder_a)
349    ||(r->order[l] == ringorder_am)
350    ||(r->order[l] == ringorder_a64)
351    ||(r->order[l] == ringorder_aa) ) && (r->order[l] < ringorder_IS) )
352    {
353      PrintS("\n//                  : names   ");
354      for (i = r->block0[l]-1; i<r->block1[l]; i++)
355      {
356        nlen = strlen(r->names[i]);
357        Print(" %s",r->names[i]);
358      }
359    }
360
361    if (r->wvhdl[l]!=NULL)
362    {
363      for (int j= 0;
364           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
365           j+=i)
366      {
367        PrintS("\n//                  : weights ");
368        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
369        {
370          if (r->order[l] == ringorder_a64)
371          {
372            int64 *w=(int64 *)r->wvhdl[l];
373            #if SIZEOF_LONG == 4
374            Print("%*lld " ,nlen,w[i+j]);
375            #else
376            Print(" %*ld"  ,nlen,w[i+j]);
377            #endif
378          }
379          else
380            Print(" %*d" ,nlen,r->wvhdl[l][i+j]);
381        }
382        if (r->order[l]!=ringorder_M) break;
383      }
384      if (r->order[l]==ringorder_am)
385      {
386        int m=r->wvhdl[l][i];
387        Print("\n//                  : %d module weights ",m);
388        m+=i;i++;
389        for(;i<=m;i++) Print(" %*d" ,nlen,r->wvhdl[l][i]);
390      }
391    }
392  }
393#ifdef HAVE_PLURAL
394  if(rIsPluralRing(r))
395  {
396    PrintS("\n//   noncommutative relations:");
397    if( details )
398    {
399      poly pl=NULL;
400      int nl;
401      int i,j;
402      for (i = 1; i<r->N; i++)
403      {
404        for (j = i+1; j<=r->N; j++)
405        {
406          nl = n_IsOne(p_GetCoeff(MATELEM(r->GetNC()->C,i,j),r), r->cf);
407          if ( (MATELEM(r->GetNC()->D,i,j)!=NULL) || (!nl) )
408          {
409            Print("\n//    %s%s=",r->names[j-1],r->names[i-1]);
410            pl = MATELEM(r->GetNC()->MT[UPMATELEM(i,j,r->N)],1,1);
411            p_Write0(pl, r, r);
412          }
413        }
414      }
415    } else
416      PrintS(" ...");
417
418#if MYTEST  /*Singularg should not differ from Singular except in error case*/
419    Print("\n//   noncommutative type:%d", (int)ncRingType(r));
420    Print("\n//      is skew constant:%d",r->GetNC()->IsSkewConstant);
421    if( rIsSCA(r) )
422    {
423      Print("\n//   alternating variables: [%d, %d]", scaFirstAltVar(r), scaLastAltVar(r));
424      const ideal Q = SCAQuotient(r); // resides within r!
425      PrintS("\n//   quotient of sca by ideal");
426
427      if (Q!=NULL)
428      {
429//        if (r==currRing)
430//        {
431//          PrintLn();
432          iiWriteMatrix((matrix)Q,"scaQ",1,r,0);
433//        }
434//        else
435//            PrintS(" ...");
436      }
437      else
438        PrintS(" (NULL)");
439    }
440#endif
441  }
442#endif
443  if (r->qideal!=NULL)
444  {
445    PrintS("\n// quotient ring from ideal");
446    if( details )
447    {
448      PrintLn();
449      iiWriteMatrix((matrix)r->qideal,"_",1,r,0);
450    } else PrintS(" ...");
451  }
452}
453
454void rDelete(ring r)
455{
456  int i, j;
457
458  if (r == NULL) return;
459
460  assume( r->ref <= 0 );
461
462  if( r->ref > 0 ) // ->ref means the number of Interpreter objects refearring to the ring...
463    return; // NOTE: There may be memory leaks due to inconsisten use of r->ref!!! (e.g. due to ext_fields)
464
465  if( r->qideal != NULL )
466  {
467    ideal q = r->qideal;
468    r->qideal = NULL;
469    id_Delete(&q, r);
470  }
471
472#ifdef HAVE_PLURAL
473  if (rIsPluralRing(r))
474    nc_rKill(r);
475#endif
476
477  nKillChar(r->cf); r->cf = NULL;
478  rUnComplete(r);
479  // delete order stuff
480  if (r->order != NULL)
481  {
482    i=rBlocks(r);
483    assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
484    // delete order
485    omFreeSize((ADDRESS)r->order,i*sizeof(int));
486    omFreeSize((ADDRESS)r->block0,i*sizeof(int));
487    omFreeSize((ADDRESS)r->block1,i*sizeof(int));
488    // delete weights
489    for (j=0; j<i; j++)
490    {
491      if (r->wvhdl[j]!=NULL)
492        omFree(r->wvhdl[j]);
493    }
494    omFreeSize((ADDRESS)r->wvhdl,i*sizeof(int *));
495  }
496  else
497  {
498    assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
499  }
500
501  // delete varnames
502  if(r->names!=NULL)
503  {
504    for (i=0; i<r->N; i++)
505    {
506      if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
507    }
508    omFreeSize((ADDRESS)r->names,r->N*sizeof(char *));
509  }
510
511  omFreeBin(r, sip_sring_bin);
512}
513
514int rOrderName(char * ordername)
515{
516  int order=ringorder_unspec;
517  while (order!= 0)
518  {
519    if (strcmp(ordername,rSimpleOrdStr(order))==0)
520      break;
521    order--;
522  }
523  if (order==0) Werror("wrong ring order `%s`",ordername);
524  omFree((ADDRESS)ordername);
525  return order;
526}
527
528char * rOrdStr(ring r)
529{
530  if ((r==NULL)||(r->order==NULL)) return omStrDup("");
531  int nblocks,l,i;
532
533  for (nblocks=0; r->order[nblocks]; nblocks++);
534  nblocks--;
535
536  StringSetS("");
537  for (l=0; ; l++)
538  {
539    StringAppendS((char *)rSimpleOrdStr(r->order[l]));
540    if (
541           (r->order[l] != ringorder_c)
542        && (r->order[l] != ringorder_C)
543        && (r->order[l] != ringorder_s)
544        && (r->order[l] != ringorder_S)
545        && (r->order[l] != ringorder_IS)
546       )
547    {
548      if (r->wvhdl[l]!=NULL)
549      {
550        StringAppendS("(");
551        for (int j= 0;
552             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
553             j+=i+1)
554        {
555          char c=',';
556          if(r->order[l]==ringorder_a64)
557          {
558            int64 * w=(int64 *)r->wvhdl[l];
559            for (i = 0; i<r->block1[l]-r->block0[l]; i++)
560            {
561              StringAppend("%lld," ,w[i]);
562            }
563            StringAppend("%lld)" ,w[i]);
564            break;
565          }
566          else
567          {
568            for (i = 0; i<r->block1[l]-r->block0[l]; i++)
569            {
570              StringAppend("%d," ,r->wvhdl[l][i+j]);
571            }
572          }
573          if (r->order[l]!=ringorder_M)
574          {
575            StringAppend("%d)" ,r->wvhdl[l][i+j]);
576            break;
577          }
578          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
579            c=')';
580          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
581        }
582      }
583      else
584        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
585    }
586    else if (r->order[l] == ringorder_IS)
587    {
588      assume( r->block0[l] == r->block1[l] );
589      const int s = r->block0[l];
590      assume( (-2 < s) && (s < 2) );
591
592      StringAppend("(%d)", s);
593    }
594
595    if (l==nblocks) return StringEndS();
596    StringAppendS(",");
597  }
598}
599
600char * rVarStr(ring r)
601{
602  if ((r==NULL)||(r->names==NULL)) return omStrDup("");
603  int i;
604  int l=2;
605  char *s;
606
607  for (i=0; i<r->N; i++)
608  {
609    l+=strlen(r->names[i])+1;
610  }
611  s=(char *)omAlloc((long)l);
612  s[0]='\0';
613  for (i=0; i<r->N-1; i++)
614  {
615    strcat(s,r->names[i]);
616    strcat(s,",");
617  }
618  strcat(s,r->names[i]);
619  return s;
620}
621
622/// TODO: make it a virtual method of coeffs, together with:
623/// Decompose & Compose, rParameter & rPar
624char * rCharStr(ring r)
625{
626  char *s;
627  int i;
628
629#ifdef HAVE_RINGS
630  if (rField_is_Ring_Z(r))
631  {
632    s=omStrDup("integer");                   // Z
633    return s;
634  }
635  if(rField_is_Ring_2toM(r))
636  {
637    char* s = (char*) omAlloc(7+10+2);
638    sprintf(s,"integer,%lu",r->cf->modExponent);
639    return s;
640  }
641  if(rField_is_Ring_ModN(r))
642  {
643    long l = (long)mpz_sizeinbase(r->cf->modBase, 10) + 2+7;
644    char* s = (char*) omAlloc(l);
645    gmp_sprintf(s,"integer,%Zd",r->cf->modBase);
646    return s;
647  }
648  if(rField_is_Ring_PtoM(r))
649  {
650    long l = (long)mpz_sizeinbase(r->cf->modBase, 10) + 2+7+10;
651    char* s = (char*) omAlloc(l);
652    gmp_sprintf(s,"integer,%Zd^%lu",r->cf->modBase,r->cf->modExponent);
653    return s;
654  }
655#endif
656  if (rField_is_long_R(r))
657  {
658    i = MAX_INT_LEN*2+7; // 2 integers and real,,
659    s=(char *)omAlloc(i);
660    snprintf(s,i,"real,%d,%d",r->cf->float_len,r->cf->float_len2); /* long_R */
661    return s;
662  }
663  if (rField_is_R(r))
664  {
665    return omStrDup("real"); /* short real */
666  }
667  char const * const * const params = rParameter(r);
668  if (params==NULL)
669  {
670    s=(char *)omAlloc(MAX_INT_LEN+1);
671    snprintf(s,MAX_INT_LEN+1,"%d",n_GetChar(r->cf));         /* Q, Z/p */
672    return s;
673  }
674  if (rField_is_long_C(r))
675  {
676    i=strlen(params[0])+21;
677    s=(char *)omAlloc(i);
678    snprintf(s,i,"complex,%d,%s",r->cf->float_len,params[0]);   /* C */
679    return s;
680  }
681  if (nCoeff_is_GF(r->cf))
682  {
683    i=strlen(params[0])+21;
684    s=(char *)omAlloc(i);
685    snprintf(s,i,"%d,%s",r->cf->m_nfCharQ,params[0]); /* GF(q)  */
686    return s;
687  }
688  int l=0;
689  for(i=0; i<rPar(r);i++)
690  {
691    l+=(strlen(params[i])+1);
692  }
693  s=(char *)omAlloc((long)(l+MAX_INT_LEN+1));
694  s[0]='\0';
695  snprintf(s,MAX_INT_LEN+1,"%d",r->cf->ch); /* Fp(a) or Q(a) */
696  char tt[2];
697  tt[0]=',';
698  tt[1]='\0';
699  for(i=0; i<rPar(r);i++)
700  {
701    strcat(s,tt);
702    strcat(s,params[i]);
703  }
704  return s;
705}
706
707char * rParStr(ring r)
708{
709  if ((r==NULL)||(rParameter(r)==NULL)) return omStrDup("");
710
711  char const * const * const params = rParameter(r);
712
713  int i;
714  int l=2;
715
716  for (i=0; i<rPar(r); i++)
717  {
718    l+=strlen(params[i])+1;
719  }
720  char *s=(char *)omAlloc((long)l);
721  s[0]='\0';
722  for (i=0; i<rPar(r)-1; i++)
723  {
724    strcat(s, params[i]);
725    strcat(s,",");
726  }
727  strcat(s, params[i]);
728  return s;
729}
730
731char * rString(ring r)
732{
733  if (r!=NULL)
734  {
735    char *ch=rCharStr(r);
736    char *var=rVarStr(r);
737    char *ord=rOrdStr(r);
738    char *res=(char *)omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
739    sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
740    omFree((ADDRESS)ch);
741    omFree((ADDRESS)var);
742    omFree((ADDRESS)ord);
743    return res;
744  }
745  else
746    return omStrDup("NULL");
747}
748
749
750/*
751// The fowolling function seems to be never used. Remove?
752static int binaryPower (const int a, const int b)
753{
754  // computes a^b according to the binary representation of b,
755  //   i.e., a^7 = a^4 * a^2 * a^1. This saves some multiplications.
756  int result = 1;
757  int factor = a;
758  int bb = b;
759  while (bb != 0)
760  {
761    if (bb % 2 != 0) result = result * factor;
762    bb = bb / 2;
763    factor = factor * factor;
764  }
765  return result;
766}
767*/
768
769/* we keep this otherwise superfluous method for compatibility reasons
770   towards the SINGULAR svn trunk */
771int rChar(ring r) { return r->cf->ch; }
772
773// typedef char *             char_ptr;
774// omBin char_ptr_bin = omGetSpecBin(sizeof(char_ptr)); // deallocation?
775
776
777// creates a commutative nc extension; "converts" comm.ring to a Plural ring
778#ifdef HAVE_PLURAL
779ring nc_rCreateNCcomm_rCopy(ring r)
780{
781  r = rCopy(r);
782  if (rIsPluralRing(r))
783    return r;
784
785  matrix C = mpNew(r->N,r->N); // ring-independent!?!
786  matrix D = mpNew(r->N,r->N);
787
788  for(int i=1; i<r->N; i++)
789    for(int j=i+1; j<=r->N; j++)
790      MATELEM(C,i,j) = p_One( r);
791
792  if (nc_CallPlural(C, D, NULL, NULL, r, false, true, false, r/*??currRing??*/, TRUE)) // TODO: what about quotient ideal?
793    WarnS("Error initializing multiplication!"); // No reaction!???
794
795  return r;
796}
797#endif
798
799
800/*2
801 *returns -1 for not compatible, (sum is undefined)
802 *         1 for compatible (and sum)
803 */
804/* vartest: test for variable/paramter names
805* dp_dp: for comm. rings: use block order dp + dp/ds/wp
806*/
807int rSumInternal(ring r1, ring r2, ring &sum, BOOLEAN vartest, BOOLEAN dp_dp)
808{
809
810  ip_sring tmpR;
811  memset(&tmpR,0,sizeof(tmpR));
812  /* check coeff. field =====================================================*/
813
814  if (r1->cf==r2->cf)
815  {
816    tmpR.cf=r1->cf;
817    r1->cf->ref++;
818  }
819  else /* different type */
820  {
821    if (getCoeffType(r1->cf)==n_Zp)
822    {
823      if (getCoeffType(r2->cf)==n_Q)
824      {
825        tmpR.cf=r1->cf;
826        r1->cf->ref++;
827      }
828      else if (nCoeff_is_Extension(r2->cf) && rChar(r2) == rChar(r1))
829      {
830        /*AlgExtInfo extParam;
831        extParam.r = r2->cf->extRing;
832        extParam.i = r2->cf->extRing->qideal;*/
833        tmpR.cf=r2->cf;
834        r2->cf->ref++;
835      }
836      else
837      {
838        WerrorS("Z/p+...");
839        return -1;
840      }
841    }
842    else if (getCoeffType(r1->cf)==n_R)
843    {
844      WerrorS("R+..");
845      return -1;
846    }
847    else if (getCoeffType(r1->cf)==n_Q)
848    {
849      if (getCoeffType(r2->cf)==n_Zp)
850      {
851        tmpR.cf=r2->cf;
852        r2->cf->ref++;
853      }
854      else if (nCoeff_is_Extension(r2->cf))
855      {
856        tmpR.cf=r2->cf;
857        r2->cf->ref++;
858      }
859      else
860      {
861        WerrorS("Q+...");
862        return -1;
863      }
864    }
865    else if (nCoeff_is_Extension(r1->cf))
866    {
867      if (r1->cf->extRing->cf==r2->cf)
868      {
869        tmpR.cf=r1->cf;
870        r1->cf->ref++;
871      }
872      else if (getCoeffType(r1->cf->extRing->cf)==n_Zp && getCoeffType(r2->cf)==n_Q) //r2->cf == n_Zp should have been handled above
873      {
874        tmpR.cf=r1->cf;
875        r1->cf->ref++;
876      }
877      else
878      {
879        WerrorS ("coeff sum of two extension fields not implemented");
880        return -1;
881      }
882    }
883    else
884    {
885      WerrorS("coeff sum not yet implemented");
886      return -1;
887    }
888  }
889  /* variable names ========================================================*/
890  int i,j,k;
891  int l=r1->N+r2->N;
892  char **names=(char **)omAlloc0(l*sizeof(char *));
893  k=0;
894
895  // collect all varnames from r1, except those which are parameters
896  // of r2, or those which are the empty string
897  for (i=0;i<r1->N;i++)
898  {
899    BOOLEAN b=TRUE;
900
901    if (*(r1->names[i]) == '\0')
902      b = FALSE;
903    else if ((rParameter(r2)!=NULL) && (strlen(r1->names[i])==1))
904    {
905      if (vartest)
906      {
907        for(j=0;j<rPar(r2);j++)
908        {
909          if (strcmp(r1->names[i],rParameter(r2)[j])==0)
910          {
911            b=FALSE;
912            break;
913          }
914        }
915      }
916    }
917
918    if (b)
919    {
920      //Print("name : %d: %s\n",k,r1->names[i]);
921      names[k]=omStrDup(r1->names[i]);
922      k++;
923    }
924    //else
925    //  Print("no name (par1) %s\n",r1->names[i]);
926  }
927  // Add variables from r2, except those which are parameters of r1
928  // those which are empty strings, and those which equal a var of r1
929  for(i=0;i<r2->N;i++)
930  {
931    BOOLEAN b=TRUE;
932
933    if (*(r2->names[i]) == '\0')
934      b = FALSE;
935    else if ((rParameter(r1)!=NULL) && (strlen(r2->names[i])==1))
936    {
937      if (vartest)
938      {
939        for(j=0;j<rPar(r1);j++)
940        {
941          if (strcmp(r2->names[i],rParameter(r1)[j])==0)
942          {
943            b=FALSE;
944            break;
945          }
946        }
947      }
948    }
949
950    if (b)
951    {
952      if (vartest)
953      {
954        for(j=0;j<r1->N;j++)
955        {
956          if (strcmp(r1->names[j],r2->names[i])==0)
957          {
958            b=FALSE;
959            break;
960          }
961        }
962      }
963      if (b)
964      {
965        //Print("name : %d : %s\n",k,r2->names[i]);
966        names[k]=omStrDup(r2->names[i]);
967        k++;
968      }
969      //else
970      //  Print("no name (var): %s\n",r2->names[i]);
971    }
972    //else
973    //  Print("no name (par): %s\n",r2->names[i]);
974  }
975  // check whether we found any vars at all
976  if (k == 0)
977  {
978    names[k]=omStrDup("");
979    k=1;
980  }
981  tmpR.N=k;
982  tmpR.names=names;
983  /* ordering *======================================================== */
984  tmpR.OrdSgn=1;
985  if (dp_dp
986#ifdef HAVE_PLURAL
987      && !rIsPluralRing(r1) && !rIsPluralRing(r2)
988#endif
989     )
990  {
991    tmpR.order=(int*)omAlloc(4*sizeof(int));
992    tmpR.block0=(int*)omAlloc0(4*sizeof(int));
993    tmpR.block1=(int*)omAlloc0(4*sizeof(int));
994    tmpR.wvhdl=(int**)omAlloc0(4*sizeof(int *));
995    tmpR.order[0]=ringorder_dp;
996    tmpR.block0[0]=1;
997    tmpR.block1[0]=rVar(r1);
998    if (r2->OrdSgn==1)
999    {
1000      if ((r2->block0[0]==1)
1001      && (r2->block1[0]==rVar(r2))
1002      && ((r2->order[0]==ringorder_wp)
1003        || (r2->order[0]==ringorder_Wp)
1004        || (r2->order[0]==ringorder_Dp))
1005     )
1006     {
1007       tmpR.order[1]=r2->order[0];
1008       if (r2->wvhdl[0]!=NULL)
1009         tmpR.wvhdl[1]=(int *)omMemDup(r2->wvhdl[0]);
1010     }
1011     else
1012        tmpR.order[1]=ringorder_dp;
1013    }
1014    else
1015    {
1016      tmpR.order[1]=ringorder_ds;
1017      tmpR.OrdSgn=-1;
1018    }
1019    tmpR.block0[1]=rVar(r1)+1;
1020    tmpR.block1[1]=rVar(r1)+rVar(r2);
1021    tmpR.order[2]=ringorder_C;
1022    tmpR.order[3]=0;
1023  }
1024  else
1025  {
1026    if ((r1->order[0]==ringorder_unspec)
1027        && (r2->order[0]==ringorder_unspec))
1028    {
1029      tmpR.order=(int*)omAlloc(3*sizeof(int));
1030      tmpR.block0=(int*)omAlloc(3*sizeof(int));
1031      tmpR.block1=(int*)omAlloc(3*sizeof(int));
1032      tmpR.wvhdl=(int**)omAlloc0(3*sizeof(int *));
1033      tmpR.order[0]=ringorder_unspec;
1034      tmpR.order[1]=ringorder_C;
1035      tmpR.order[2]=0;
1036      tmpR.block0[0]=1;
1037      tmpR.block1[0]=tmpR.N;
1038    }
1039    else if (l==k) /* r3=r1+r2 */
1040    {
1041      int b;
1042      ring rb;
1043      if (r1->order[0]==ringorder_unspec)
1044      {
1045        /* extend order of r2 to r3 */
1046        b=rBlocks(r2);
1047        rb=r2;
1048        tmpR.OrdSgn=r2->OrdSgn;
1049      }
1050      else if (r2->order[0]==ringorder_unspec)
1051      {
1052        /* extend order of r1 to r3 */
1053        b=rBlocks(r1);
1054        rb=r1;
1055        tmpR.OrdSgn=r1->OrdSgn;
1056      }
1057      else
1058      {
1059        b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1060        rb=NULL;
1061      }
1062      tmpR.order=(int*)omAlloc0(b*sizeof(int));
1063      tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1064      tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1065      tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int *));
1066      /* weights not implemented yet ...*/
1067      if (rb!=NULL)
1068      {
1069        for (i=0;i<b;i++)
1070        {
1071          tmpR.order[i]=rb->order[i];
1072          tmpR.block0[i]=rb->block0[i];
1073          tmpR.block1[i]=rb->block1[i];
1074          if (rb->wvhdl[i]!=NULL)
1075            WarnS("rSum: weights not implemented");
1076        }
1077        tmpR.block0[0]=1;
1078      }
1079      else /* ring sum for complete rings */
1080      {
1081        for (i=0;r1->order[i]!=0;i++)
1082        {
1083          tmpR.order[i]=r1->order[i];
1084          tmpR.block0[i]=r1->block0[i];
1085          tmpR.block1[i]=r1->block1[i];
1086          if (r1->wvhdl[i]!=NULL)
1087            tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1088        }
1089        j=i;
1090        i--;
1091        if ((r1->order[i]==ringorder_c)
1092            ||(r1->order[i]==ringorder_C))
1093        {
1094          j--;
1095          tmpR.order[b-2]=r1->order[i];
1096        }
1097        for (i=0;r2->order[i]!=0;i++)
1098        {
1099          if ((r2->order[i]!=ringorder_c)
1100              &&(r2->order[i]!=ringorder_C))
1101          {
1102            tmpR.order[j]=r2->order[i];
1103            tmpR.block0[j]=r2->block0[i]+rVar(r1);
1104            tmpR.block1[j]=r2->block1[i]+rVar(r1);
1105            if (r2->wvhdl[i]!=NULL)
1106            {
1107              tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1108            }
1109            j++;
1110          }
1111        }
1112        if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1113          tmpR.OrdSgn=-1;
1114      }
1115    }
1116    else if ((k==rVar(r1)) && (k==rVar(r2))) /* r1 and r2 are "quite"
1117                                                the same ring */
1118      /* copy r1, because we have the variables from r1 */
1119    {
1120      int b=rBlocks(r1);
1121
1122      tmpR.order=(int*)omAlloc0(b*sizeof(int));
1123      tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1124      tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1125      tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int *));
1126      /* weights not implemented yet ...*/
1127      for (i=0;i<b;i++)
1128      {
1129        tmpR.order[i]=r1->order[i];
1130        tmpR.block0[i]=r1->block0[i];
1131        tmpR.block1[i]=r1->block1[i];
1132        if (r1->wvhdl[i]!=NULL)
1133        {
1134          tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1135        }
1136      }
1137      tmpR.OrdSgn=r1->OrdSgn;
1138    }
1139    else
1140    {
1141      for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1142      omFreeSize((ADDRESS)names,tmpR.N*sizeof(char *));
1143      Werror("difficulties with variables: %d,%d -> %d",rVar(r1),rVar(r2),k);
1144      return -1;
1145    }
1146  }
1147  sum=(ring)omAllocBin(sip_sring_bin);
1148  memcpy(sum,&tmpR,sizeof(ip_sring));
1149  rComplete(sum);
1150
1151//#ifdef RDEBUG
1152//  rDebugPrint(sum);
1153//#endif
1154
1155
1156
1157#ifdef HAVE_PLURAL
1158  if(1)
1159  {
1160//    ring old_ring = currRing;
1161
1162    BOOLEAN R1_is_nc = rIsPluralRing(r1);
1163    BOOLEAN R2_is_nc = rIsPluralRing(r2);
1164
1165    if ( (R1_is_nc) || (R2_is_nc))
1166    {
1167      ring R1 = nc_rCreateNCcomm_rCopy(r1);
1168      assume( rIsPluralRing(R1) );
1169
1170#if 0
1171#ifdef RDEBUG
1172      rWrite(R1);
1173      rDebugPrint(R1);
1174#endif
1175#endif
1176      ring R2 = nc_rCreateNCcomm_rCopy(r2);
1177#if 0
1178#ifdef RDEBUG
1179      rWrite(R2);
1180      rDebugPrint(R2);
1181#endif
1182#endif
1183
1184//      rChangeCurrRing(sum); // ?
1185
1186      // Projections from R_i into Sum:
1187      /* multiplication matrices business: */
1188      /* find permutations of vars and pars */
1189      int *perm1 = (int *)omAlloc0((rVar(R1)+1)*sizeof(int));
1190      int *par_perm1 = NULL;
1191      if (rPar(R1)!=0) par_perm1=(int *)omAlloc0((rPar(R1)+1)*sizeof(int));
1192
1193      int *perm2 = (int *)omAlloc0((rVar(R2)+1)*sizeof(int));
1194      int *par_perm2 = NULL;
1195      if (rPar(R2)!=0) par_perm2=(int *)omAlloc0((rPar(R2)+1)*sizeof(int));
1196
1197      maFindPerm(R1->names,  rVar(R1),  rParameter(R1),  rPar(R1),
1198                 sum->names, rVar(sum), rParameter(sum), rPar(sum),
1199                 perm1, par_perm1, sum->cf->type);
1200
1201      maFindPerm(R2->names,  rVar(R2),  rParameter(R2),  rPar(R2),
1202                 sum->names, rVar(sum), rParameter(sum), rPar(sum),
1203                 perm2, par_perm2, sum->cf->type);
1204
1205
1206      matrix C1 = R1->GetNC()->C, C2 = R2->GetNC()->C;
1207      matrix D1 = R1->GetNC()->D, D2 = R2->GetNC()->D;
1208
1209      // !!!! BUG? C1 and C2 might live in different baserings!!!
1210
1211      int l = rVar(R1) + rVar(R2);
1212
1213      matrix C  = mpNew(l,l);
1214      matrix D  = mpNew(l,l);
1215
1216      for (i = 1; i <= rVar(R1); i++)
1217        for (j= rVar(R1)+1; j <= l; j++)
1218          MATELEM(C,i,j) = p_One(sum); // in 'sum'
1219
1220      id_Test((ideal)C, sum);
1221
1222      nMapFunc nMap1 = n_SetMap(R1->cf,sum->cf); /* can change something global: not usable
1223                                                    after the next nSetMap call :( */
1224      // Create blocked C and D matrices:
1225      for (i=1; i<= rVar(R1); i++)
1226        for (j=i+1; j<=rVar(R1); j++)
1227        {
1228          assume(MATELEM(C1,i,j) != NULL);
1229          MATELEM(C,i,j) = p_PermPoly(MATELEM(C1,i,j), perm1, R1, sum, nMap1, par_perm1, rPar(R1)); // need ADD + CMP ops.
1230
1231          if (MATELEM(D1,i,j) != NULL)
1232            MATELEM(D,i,j) = p_PermPoly(MATELEM(D1,i,j), perm1, R1, sum, nMap1, par_perm1, rPar(R1));
1233        }
1234
1235      id_Test((ideal)C, sum);
1236      id_Test((ideal)D, sum);
1237
1238
1239      nMapFunc nMap2 = n_SetMap(R2->cf,sum->cf); /* can change something global: not usable
1240                                                    after the next nSetMap call :( */
1241      for (i=1; i<= rVar(R2); i++)
1242        for (j=i+1; j<=rVar(R2); j++)
1243        {
1244          assume(MATELEM(C2,i,j) != NULL);
1245          MATELEM(C,rVar(R1)+i,rVar(R1)+j) = p_PermPoly(MATELEM(C2,i,j),perm2,R2,sum, nMap2,par_perm2,rPar(R2));
1246
1247          if (MATELEM(D2,i,j) != NULL)
1248            MATELEM(D,rVar(R1)+i,rVar(R1)+j) = p_PermPoly(MATELEM(D2,i,j),perm2,R2,sum, nMap2,par_perm2,rPar(R2));
1249        }
1250
1251      id_Test((ideal)C, sum);
1252      id_Test((ideal)D, sum);
1253
1254      // Now sum is non-commutative with blocked structure constants!
1255      if (nc_CallPlural(C, D, NULL, NULL, sum, false, false, true, sum))
1256        WarnS("Error initializing non-commutative multiplication!");
1257
1258      /* delete R1, R2*/
1259
1260#if 0
1261#ifdef RDEBUG
1262      rWrite(sum);
1263      rDebugPrint(sum);
1264
1265      Print("\nRefs: R1: %d, R2: %d\n", R1->GetNC()->ref, R2->GetNC()->ref);
1266
1267#endif
1268#endif
1269
1270
1271      rDelete(R1);
1272      rDelete(R2);
1273
1274      /* delete perm arrays */
1275      if (perm1!=NULL) omFree((ADDRESS)perm1);
1276      if (perm2!=NULL) omFree((ADDRESS)perm2);
1277      if (par_perm1!=NULL) omFree((ADDRESS)par_perm1);
1278      if (par_perm2!=NULL) omFree((ADDRESS)par_perm2);
1279
1280//      rChangeCurrRing(old_ring);
1281    }
1282
1283  }
1284#endif
1285
1286  ideal Q=NULL;
1287  ideal Q1=NULL, Q2=NULL;
1288  if (r1->qideal!=NULL)
1289  {
1290//    rChangeCurrRing(sum);
1291//     if (r2->qideal!=NULL)
1292//     {
1293//       WerrorS("todo: qring+qring");
1294//       return -1;
1295//     }
1296//     else
1297//     {}
1298    /* these were defined in the Plural Part above... */
1299    int *perm1 = (int *)omAlloc0((rVar(r1)+1)*sizeof(int));
1300    int *par_perm1 = NULL;
1301    if (rPar(r1)!=0) par_perm1=(int *)omAlloc0((rPar(r1)+1)*sizeof(int));
1302    maFindPerm(r1->names,  rVar(r1),  rParameter(r1),  rPar(r1),
1303               sum->names, rVar(sum), rParameter(sum), rPar(sum),
1304               perm1, par_perm1, sum->cf->type);
1305    nMapFunc nMap1 = n_SetMap(r1->cf,sum->cf);
1306    Q1 = idInit(IDELEMS(r1->qideal),1);
1307
1308    for (int for_i=0;for_i<IDELEMS(r1->qideal);for_i++)
1309      Q1->m[for_i] = p_PermPoly(
1310                                r1->qideal->m[for_i], perm1,
1311                                r1, sum,
1312                                nMap1,
1313                                par_perm1, rPar(r1));
1314
1315    omFree((ADDRESS)perm1);
1316  }
1317
1318  if (r2->qideal!=NULL)
1319  {
1320    //if (currRing!=sum)
1321    //  rChangeCurrRing(sum);
1322    int *perm2 = (int *)omAlloc0((rVar(r2)+1)*sizeof(int));
1323    int *par_perm2 = NULL;
1324    if (rPar(r2)!=0) par_perm2=(int *)omAlloc0((rPar(r2)+1)*sizeof(int));
1325    maFindPerm(r2->names,  rVar(r2),  rParameter(r2),  rPar(r2),
1326               sum->names, rVar(sum), rParameter(sum), rPar(sum),
1327               perm2, par_perm2, sum->cf->type);
1328    nMapFunc nMap2 = n_SetMap(r2->cf,sum->cf);
1329    Q2 = idInit(IDELEMS(r2->qideal),1);
1330
1331    for (int for_i=0;for_i<IDELEMS(r2->qideal);for_i++)
1332      Q2->m[for_i] = p_PermPoly(
1333                  r2->qideal->m[for_i], perm2,
1334                  r2, sum,
1335                  nMap2,
1336                  par_perm2, rPar(r2));
1337
1338    omFree((ADDRESS)perm2);
1339  }
1340  if ( (Q1!=NULL) || ( Q2!=NULL))
1341  {
1342    Q = id_SimpleAdd(Q1,Q2,sum);
1343  }
1344  sum->qideal = Q;
1345
1346#ifdef HAVE_PLURAL
1347  if( rIsPluralRing(sum) )
1348    nc_SetupQuotient( sum );
1349#endif
1350  return 1;
1351}
1352
1353/*2
1354 *returns -1 for not compatible, (sum is undefined)
1355 *         0 for equal, (and sum)
1356 *         1 for compatible (and sum)
1357 */
1358int rSum(ring r1, ring r2, ring &sum)
1359{
1360  if (r1==r2)
1361  {
1362    sum=r1;
1363    r1->ref++;
1364    return 0;
1365  }
1366  return rSumInternal(r1,r2,sum,TRUE,FALSE);
1367}
1368
1369/*2
1370 * create a copy of the ring r
1371 * used for qring definition,..
1372 * DOES NOT CALL rComplete
1373 */
1374ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
1375{
1376  if (r == NULL) return NULL;
1377  int i,j;
1378  ring res=(ring)omAllocBin(sip_sring_bin);
1379  memset(res,0,sizeof(ip_sring));
1380  //memcpy(res,r,sizeof(ip_sring));
1381  //memset: res->idroot=NULL; /* local objects */
1382  //ideal      minideal;
1383  res->options=r->options; /* ring dependent options */
1384
1385  //memset: res->ordsgn=NULL;
1386  //memset: res->typ=NULL;
1387  //memset: res->VarOffset=NULL;
1388  //memset: res->firstwv=NULL;
1389
1390  //struct omBin   PolyBin; /* Bin from where monoms are allocated */
1391  //memset: res->PolyBin=NULL; // rComplete
1392  res->cf=r->cf;     /* coeffs */
1393  res->cf->ref++;
1394
1395  //memset: res->ref=0; /* reference counter to the ring */
1396
1397  res->N=rVar(r);      /* number of vars */
1398  res->OrdSgn=r->OrdSgn; /* 1 for polynomial rings, -1 otherwise */
1399
1400  res->firstBlockEnds=r->firstBlockEnds;
1401#ifdef HAVE_PLURAL
1402  res->real_var_start=r->real_var_start;
1403  res->real_var_end=r->real_var_end;
1404#endif
1405
1406#ifdef HAVE_SHIFTBBA
1407  res->isLPring=r->isLPring; /* 0 for non-letterplace rings, otherwise the number of LP blocks, at least 1, known also as lV */
1408#endif
1409
1410  res->VectorOut=r->VectorOut;
1411  res->ShortOut=r->ShortOut;
1412  res->CanShortOut=r->CanShortOut;
1413  res->LexOrder=r->LexOrder; // TRUE if the monomial ordering has polynomial and power series blocks
1414  res->MixedOrder=r->MixedOrder; // ?? 1 for lex ordering (except ls), -1 otherwise
1415  res->ComponentOrder=r->ComponentOrder;
1416
1417  //memset: res->ExpL_Size=0;
1418  //memset: res->CmpL_Size=0;
1419  //memset: res->VarL_Size=0;
1420  //memset: res->pCompIndex=0;
1421  //memset: res->pOrdIndex=0;
1422  //memset: res->OrdSize=0;
1423  //memset: res->VarL_LowIndex=0;
1424  //memset: res->MinExpPerLong=0;
1425  //memset: res->NegWeightL_Size=0;
1426  //memset: res->NegWeightL_Offset=NULL;
1427  //memset: res->VarL_Offset=NULL;
1428
1429  // the following are set by rComplete unless predefined
1430  // therefore, we copy these values: maybe they are non-standard
1431  /* mask for getting single exponents */
1432  res->bitmask=r->bitmask;
1433  res->divmask=r->divmask;
1434  res->BitsPerExp = r->BitsPerExp;
1435  res->ExpPerLong =  r->ExpPerLong;
1436
1437  //memset: res->p_Procs=NULL;
1438  //memset: res->pFDeg=NULL;
1439  //memset: res->pLDeg=NULL;
1440  //memset: res->pFDegOrig=NULL;
1441  //memset: res->pLDegOrig=NULL;
1442  //memset: res->p_Setm=NULL;
1443  //memset: res->cf=NULL;
1444
1445/*
1446  if (r->extRing!=NULL)
1447    r->extRing->ref++;
1448
1449  res->extRing=r->extRing;
1450  //memset: res->qideal=NULL;
1451*/
1452
1453
1454  if (copy_ordering == TRUE)
1455  {
1456    i=rBlocks(r);
1457    res->wvhdl   = (int **)omAlloc(i * sizeof(int *));
1458    res->order   = (int *) omAlloc(i * sizeof(int));
1459    res->block0  = (int *) omAlloc(i * sizeof(int));
1460    res->block1  = (int *) omAlloc(i * sizeof(int));
1461    for (j=0; j<i; j++)
1462    {
1463      if (r->wvhdl[j]!=NULL)
1464      {
1465        res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1466      }
1467      else
1468        res->wvhdl[j]=NULL;
1469    }
1470    memcpy(res->order,r->order,i * sizeof(int));
1471    memcpy(res->block0,r->block0,i * sizeof(int));
1472    memcpy(res->block1,r->block1,i * sizeof(int));
1473  }
1474  //memset: else
1475  //memset: {
1476  //memset:   res->wvhdl = NULL;
1477  //memset:   res->order = NULL;
1478  //memset:   res->block0 = NULL;
1479  //memset:   res->block1 = NULL;
1480  //memset: }
1481
1482  res->names   = (char **)omAlloc0(rVar(r) * sizeof(char *));
1483  for (i=0; i<rVar(res); i++)
1484  {
1485    res->names[i] = omStrDup(r->names[i]);
1486  }
1487  if (r->qideal!=NULL)
1488  {
1489    if (copy_qideal)
1490    {
1491      #ifndef NDEBUG
1492      if (!copy_ordering)
1493        WerrorS("internal error: rCopy0(Q,TRUE,FALSE)");
1494      else
1495      #endif
1496      {
1497      #ifndef NDEBUG
1498        WarnS("internal bad stuff: rCopy0(Q,TRUE,TRUE)");
1499      #endif
1500        rComplete(res);
1501        res->qideal= idrCopyR_NoSort(r->qideal, r, res);
1502        rUnComplete(res);
1503      }
1504    }
1505    //memset: else res->qideal = NULL;
1506  }
1507  //memset: else res->qideal = NULL;
1508  //memset: res->GetNC() = NULL; // copy is purely commutative!!!
1509  return res;
1510}
1511
1512/*2
1513 * create a copy of the ring r
1514 * used for qring definition,..
1515 * DOES NOT CALL rComplete
1516 */
1517ring rCopy0AndAddA(const ring r,  int64vec *wv64, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
1518{
1519  if (r == NULL) return NULL;
1520  int i,j;
1521  ring res=(ring)omAllocBin(sip_sring_bin);
1522  memset(res,0,sizeof(ip_sring));
1523  //memcpy(res,r,sizeof(ip_sring));
1524  //memset: res->idroot=NULL; /* local objects */
1525  //ideal      minideal;
1526  res->options=r->options; /* ring dependent options */
1527
1528  //memset: res->ordsgn=NULL;
1529  //memset: res->typ=NULL;
1530  //memset: res->VarOffset=NULL;
1531  //memset: res->firstwv=NULL;
1532
1533  //struct omBin   PolyBin; /* Bin from where monoms are allocated */
1534  //memset: res->PolyBin=NULL; // rComplete
1535  res->cf=r->cf;     /* coeffs */
1536  res->cf->ref++;
1537
1538  //memset: res->ref=0; /* reference counter to the ring */
1539
1540  res->N=rVar(r);      /* number of vars */
1541  res->OrdSgn=r->OrdSgn; /* 1 for polynomial rings, -1 otherwise */
1542
1543  res->firstBlockEnds=r->firstBlockEnds;
1544#ifdef HAVE_PLURAL
1545  res->real_var_start=r->real_var_start;
1546  res->real_var_end=r->real_var_end;
1547#endif
1548
1549#ifdef HAVE_SHIFTBBA
1550  res->isLPring=r->isLPring; /* 0 for non-letterplace rings, otherwise the number of LP blocks, at least 1, known also as lV */
1551#endif
1552
1553  res->VectorOut=r->VectorOut;
1554  res->ShortOut=r->ShortOut;
1555  res->CanShortOut=r->CanShortOut;
1556  res->LexOrder=r->LexOrder; // TRUE if the monomial ordering has polynomial and power series blocks
1557  res->MixedOrder=r->MixedOrder; // ?? 1 for lex ordering (except ls), -1 otherwise
1558  res->ComponentOrder=r->ComponentOrder;
1559
1560  //memset: res->ExpL_Size=0;
1561  //memset: res->CmpL_Size=0;
1562  //memset: res->VarL_Size=0;
1563  //memset: res->pCompIndex=0;
1564  //memset: res->pOrdIndex=0;
1565  //memset: res->OrdSize=0;
1566  //memset: res->VarL_LowIndex=0;
1567  //memset: res->MinExpPerLong=0;
1568  //memset: res->NegWeightL_Size=0;
1569  //memset: res->NegWeightL_Offset=NULL;
1570  //memset: res->VarL_Offset=NULL;
1571
1572  // the following are set by rComplete unless predefined
1573  // therefore, we copy these values: maybe they are non-standard
1574  /* mask for getting single exponents */
1575  res->bitmask=r->bitmask;
1576  res->divmask=r->divmask;
1577  res->BitsPerExp = r->BitsPerExp;
1578  res->ExpPerLong =  r->ExpPerLong;
1579
1580  //memset: res->p_Procs=NULL;
1581  //memset: res->pFDeg=NULL;
1582  //memset: res->pLDeg=NULL;
1583  //memset: res->pFDegOrig=NULL;
1584  //memset: res->pLDegOrig=NULL;
1585  //memset: res->p_Setm=NULL;
1586  //memset: res->cf=NULL;
1587
1588/*
1589  if (r->extRing!=NULL)
1590    r->extRing->ref++;
1591
1592  res->extRing=r->extRing;
1593  //memset: res->qideal=NULL;
1594*/
1595
1596
1597  if (copy_ordering == TRUE)
1598  {
1599    i=rBlocks(r)+1; // DIFF to rCopy0
1600    res->wvhdl   = (int **)omAlloc(i * sizeof(int *));
1601    res->order   = (int *) omAlloc(i * sizeof(int));
1602    res->block0  = (int *) omAlloc(i * sizeof(int));
1603    res->block1  = (int *) omAlloc(i * sizeof(int));
1604    for (j=0; j<i-1; j++)
1605    {
1606      if (r->wvhdl[j]!=NULL)
1607      {
1608        res->wvhdl[j+1] = (int*) omMemDup(r->wvhdl[j]); //DIFF
1609      }
1610      else
1611        res->wvhdl[j+1]=NULL; //DIFF
1612    }
1613    memcpy(&(res->order[1]),r->order,(i-1) * sizeof(int)); //DIFF
1614    memcpy(&(res->block0[1]),r->block0,(i-1) * sizeof(int)); //DIFF
1615    memcpy(&(res->block1[1]),r->block1,(i-1) * sizeof(int)); //DIFF
1616  }
1617  //memset: else
1618  //memset: {
1619  //memset:   res->wvhdl = NULL;
1620  //memset:   res->order = NULL;
1621  //memset:   res->block0 = NULL;
1622  //memset:   res->block1 = NULL;
1623  //memset: }
1624
1625  //the added A
1626  res->order[0]=ringorder_a64;
1627  int length=wv64->rows();
1628  int64 *A=(int64 *)omAlloc(length*sizeof(int64));
1629  for(j=length-1;j>=0;j--)
1630  {
1631     A[j]=(*wv64)[j];
1632  }
1633  res->wvhdl[0]=(int *)A;
1634  res->block0[0]=1;
1635  res->block1[0]=length;
1636  //
1637
1638  res->names   = (char **)omAlloc0(rVar(r) * sizeof(char *));
1639  for (i=0; i<rVar(res); i++)
1640  {
1641    res->names[i] = omStrDup(r->names[i]);
1642  }
1643  if (r->qideal!=NULL)
1644  {
1645    if (copy_qideal)
1646    {
1647      #ifndef NDEBUG
1648      if (!copy_ordering)
1649        WerrorS("internal error: rCopy0(Q,TRUE,FALSE)");
1650      else
1651      #endif
1652      {
1653      #ifndef NDEBUG
1654        WarnS("internal bad stuff: rCopy0(Q,TRUE,TRUE)");
1655      #endif
1656        rComplete(res);
1657        res->qideal= idrCopyR_NoSort(r->qideal, r, res);
1658        rUnComplete(res);
1659      }
1660    }
1661    //memset: else res->qideal = NULL;
1662  }
1663  //memset: else res->qideal = NULL;
1664  //memset: res->GetNC() = NULL; // copy is purely commutative!!!
1665  return res;
1666}
1667
1668/*2
1669 * create a copy of the ring r, which must be equivalent to currRing
1670 * used for qring definition,..
1671 * (i.e.: normal rings: same nCopy as currRing;
1672 *        qring:        same nCopy, same idCopy as currRing)
1673 */
1674ring rCopy(ring r)
1675{
1676  if (r == NULL) return NULL;
1677  ring res=rCopy0(r,FALSE,TRUE);
1678  rComplete(res, 1); // res is purely commutative so far
1679  if (r->qideal!=NULL) res->qideal=idrCopyR_NoSort(r->qideal, r, res);
1680
1681#ifdef HAVE_PLURAL
1682  if (rIsPluralRing(r))
1683    if( nc_rCopy(res, r, true) ) {}
1684#endif
1685
1686  return res;
1687}
1688
1689BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1690{
1691  if( !rSamePolyRep(r1, r2) )
1692    return FALSE;
1693
1694  int i/*, j*/;
1695
1696  if (r1 == r2) return TRUE;
1697  if (r1 == NULL || r2 == NULL) return FALSE;
1698
1699  assume( r1->cf == r2->cf );
1700  assume( rVar(r1) == rVar(r2) );
1701
1702  for (i=0; i<rVar(r1); i++)
1703  {
1704    if (r1->names[i] != NULL && r2->names[i] != NULL)
1705    {
1706      if (strcmp(r1->names[i], r2->names[i])) return FALSE;
1707    }
1708    else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1709    {
1710      return FALSE;
1711    }
1712  }
1713
1714  if (qr)
1715  {
1716    if (r1->qideal != NULL)
1717    {
1718      ideal id1 = r1->qideal, id2 = r2->qideal;
1719      int i, n;
1720      poly *m1, *m2;
1721
1722      if (id2 == NULL) return FALSE;
1723      if ((n = IDELEMS(id1)) != IDELEMS(id2)) return FALSE;
1724
1725      {
1726        m1 = id1->m;
1727        m2 = id2->m;
1728        for (i=0; i<n; i++)
1729          if (! p_EqualPolys(m1[i],m2[i], r1, r2)) return FALSE;
1730      }
1731    }
1732    else if (r2->qideal != NULL) return FALSE;
1733  }
1734
1735  return TRUE;
1736}
1737
1738BOOLEAN rSamePolyRep(ring r1, ring r2)
1739{
1740  int i, j;
1741
1742  if (r1 == r2) return TRUE;
1743
1744  if (r1 == NULL || r2 == NULL) return FALSE;
1745
1746  if ((r1->cf != r2->cf)
1747  || (rVar(r1) != rVar(r2))
1748  || (r1->OrdSgn != r2->OrdSgn))
1749    return FALSE;
1750
1751  i=0;
1752  while (r1->order[i] != 0)
1753  {
1754    if (r2->order[i] == 0) return FALSE;
1755    if ((r1->order[i] != r2->order[i])
1756    || (r1->block0[i] != r2->block0[i])
1757    || (r1->block1[i] != r2->block1[i]))
1758      return FALSE;
1759    if (r1->wvhdl[i] != NULL)
1760    {
1761      if (r2->wvhdl[i] == NULL)
1762        return FALSE;
1763      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1764        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1765          return FALSE;
1766    }
1767    else if (r2->wvhdl[i] != NULL) return FALSE;
1768    i++;
1769  }
1770  if (r2->order[i] != 0) return FALSE;
1771
1772  // we do not check variable names
1773  // we do not check minpoly/minideal
1774  // we do not check qideal
1775
1776  return TRUE;
1777}
1778
1779rOrderType_t rGetOrderType(ring r)
1780{
1781  // check for simple ordering
1782  if (rHasSimpleOrder(r))
1783  {
1784    if ((r->order[1] == ringorder_c)
1785    || (r->order[1] == ringorder_C))
1786    {
1787      switch(r->order[0])
1788      {
1789          case ringorder_dp:
1790          case ringorder_wp:
1791          case ringorder_ds:
1792          case ringorder_ws:
1793          case ringorder_ls:
1794          case ringorder_unspec:
1795            if (r->order[1] == ringorder_C
1796            ||  r->order[0] == ringorder_unspec)
1797              return rOrderType_ExpComp;
1798            return rOrderType_Exp;
1799
1800          default:
1801            assume(r->order[0] == ringorder_lp ||
1802                   r->order[0] == ringorder_rs ||
1803                   r->order[0] == ringorder_Dp ||
1804                   r->order[0] == ringorder_Wp ||
1805                   r->order[0] == ringorder_Ds ||
1806                   r->order[0] == ringorder_Ws);
1807
1808            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1809            return rOrderType_Exp;
1810      }
1811    }
1812    else
1813    {
1814      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1815      return rOrderType_CompExp;
1816    }
1817  }
1818  else
1819    return rOrderType_General;
1820}
1821
1822BOOLEAN rHasSimpleOrder(const ring r)
1823{
1824  if (r->order[0] == ringorder_unspec) return TRUE;
1825  int blocks = rBlocks(r) - 1;
1826  assume(blocks >= 1);
1827  if (blocks == 1) return TRUE;
1828
1829  int s = 0;
1830  while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1831  {
1832    s++;
1833    blocks--;
1834  }
1835
1836  if ((blocks - s) > 2)  return FALSE;
1837
1838  assume( blocks == s + 2 );
1839
1840  if (
1841     (r->order[s] != ringorder_c)
1842  && (r->order[s] != ringorder_C)
1843  && (r->order[s+1] != ringorder_c)
1844  && (r->order[s+1] != ringorder_C)
1845     )
1846    return FALSE;
1847  if ((r->order[s+1] == ringorder_M)
1848  || (r->order[s] == ringorder_M))
1849    return FALSE;
1850  return TRUE;
1851}
1852
1853// returns TRUE, if simple lp or ls ordering
1854BOOLEAN rHasSimpleLexOrder(const ring r)
1855{
1856  return rHasSimpleOrder(r) &&
1857    (r->order[0] == ringorder_ls ||
1858     r->order[0] == ringorder_lp ||
1859     r->order[1] == ringorder_ls ||
1860     r->order[1] == ringorder_lp);
1861}
1862
1863BOOLEAN rOrder_is_DegOrdering(const rRingOrder_t order)
1864{
1865  switch(order)
1866  {
1867      case ringorder_dp:
1868      case ringorder_Dp:
1869      case ringorder_ds:
1870      case ringorder_Ds:
1871      case ringorder_Ws:
1872      case ringorder_Wp:
1873      case ringorder_ws:
1874      case ringorder_wp:
1875        return TRUE;
1876
1877      default:
1878        return FALSE;
1879  }
1880}
1881
1882BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1883{
1884  switch(order)
1885  {
1886      case ringorder_Ws:
1887      case ringorder_Wp:
1888      case ringorder_ws:
1889      case ringorder_wp:
1890        return TRUE;
1891
1892      default:
1893        return FALSE;
1894  }
1895}
1896
1897BOOLEAN rHasSimpleOrderAA(ring r)
1898{
1899  if (r->order[0] == ringorder_unspec) return TRUE;
1900  int blocks = rBlocks(r) - 1;
1901  assume(blocks >= 1);
1902  if (blocks == 1) return TRUE;
1903
1904  int s = 0;
1905  while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1906  {
1907    s++;
1908    blocks--;
1909  }
1910
1911  if ((blocks - s) > 3)  return FALSE;
1912
1913//  if ((blocks > 3) || (blocks < 2)) return FALSE;
1914  if ((blocks - s) == 3)
1915  {
1916    return (((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M) &&
1917             ((r->order[s+2] == ringorder_c) || (r->order[s+2] == ringorder_C))) ||
1918            (((r->order[s] == ringorder_c) || (r->order[s] == ringorder_C)) &&
1919             (r->order[s+1] == ringorder_aa) && (r->order[s+2] != ringorder_M)));
1920  }
1921  else
1922  {
1923    return ((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M));
1924  }
1925}
1926
1927// return TRUE if p_SetComp requires p_Setm
1928BOOLEAN rOrd_SetCompRequiresSetm(ring r)
1929{
1930  if (r->typ != NULL)
1931  {
1932    int pos;
1933    for (pos=0;pos<r->OrdSize;pos++)
1934    {
1935      sro_ord* o=&(r->typ[pos]);
1936      if (   (o->ord_typ == ro_syzcomp)
1937          || (o->ord_typ == ro_syz)
1938          || (o->ord_typ == ro_is)
1939          || (o->ord_typ == ro_am)
1940          || (o->ord_typ == ro_isTemp))
1941        return TRUE;
1942    }
1943  }
1944  return FALSE;
1945}
1946
1947// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
1948BOOLEAN rOrd_is_Totaldegree_Ordering(ring r)
1949{
1950  // Hmm.... what about Syz orderings?
1951  return (rVar(r) > 1 &&
1952          ((rHasSimpleOrder(r) &&
1953           (rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) ||
1954            rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) ||
1955           (rHasSimpleOrderAA(r) &&
1956            (rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) ||
1957             rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
1958}
1959
1960// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
1961BOOLEAN rOrd_is_WeightedDegree_Ordering(ring r )
1962{
1963  // Hmm.... what about Syz orderings?
1964  return ((rVar(r) > 1) &&
1965          rHasSimpleOrder(r) &&
1966          (rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) ||
1967           rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
1968}
1969
1970BOOLEAN rIsPolyVar(int v, ring r)
1971{
1972  int  i=0;
1973  while(r->order[i]!=0)
1974  {
1975    if((r->block0[i]<=v)
1976    && (r->block1[i]>=v))
1977    {
1978      switch(r->order[i])
1979      {
1980        case ringorder_a:
1981          return (r->wvhdl[i][v-r->block0[i]]>0);
1982        case ringorder_M:
1983          return 2; /*don't know*/
1984        case ringorder_a64: /* assume: all weight are non-negative!*/
1985        case ringorder_lp:
1986        case ringorder_rs:
1987        case ringorder_dp:
1988        case ringorder_Dp:
1989        case ringorder_wp:
1990        case ringorder_Wp:
1991          return TRUE;
1992        case ringorder_ls:
1993        case ringorder_ds:
1994        case ringorder_Ds:
1995        case ringorder_ws:
1996        case ringorder_Ws:
1997          return FALSE;
1998        default:
1999          break;
2000      }
2001    }
2002    i++;
2003  }
2004  return 3; /* could not find var v*/
2005}
2006
2007#ifdef RDEBUG
2008// This should eventually become a full-fledge ring check, like pTest
2009BOOLEAN rDBTest(ring r, const char* fn, const int l)
2010{
2011  int i,j;
2012
2013  if (r == NULL)
2014  {
2015    dReportError("Null ring in %s:%d", fn, l);
2016    return FALSE;
2017  }
2018
2019
2020  if (r->N == 0) return TRUE;
2021
2022//  omCheckAddrSize(r,sizeof(ip_sring));
2023#if OM_CHECK > 0
2024  i=rBlocks(r);
2025  omCheckAddrSize(r->order,i*sizeof(int));
2026  omCheckAddrSize(r->block0,i*sizeof(int));
2027  omCheckAddrSize(r->block1,i*sizeof(int));
2028  if (r->wvhdl!=NULL)
2029  {
2030    omCheckAddrSize(r->wvhdl,i*sizeof(int *));
2031    for (j=0;j<i; j++)
2032    {
2033      if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
2034    }
2035  }
2036#endif
2037  if (r->VarOffset == NULL)
2038  {
2039    dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
2040    return FALSE;
2041  }
2042  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
2043
2044  if ((r->OrdSize==0)!=(r->typ==NULL))
2045  {
2046    dReportError("mismatch OrdSize and typ-pointer in %s:%d");
2047    return FALSE;
2048  }
2049  omcheckAddrSize(r->typ,r->OrdSize*sizeof(*(r->typ)));
2050  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(*(r->VarOffset)));
2051  // test assumptions:
2052  for(i=0;i<=r->N;i++) // for all variables (i = 0..N)
2053  {
2054    if(r->typ!=NULL)
2055    {
2056      for(j=0;j<r->OrdSize;j++) // for all ordering blocks (j =0..OrdSize-1)
2057      {
2058        if(r->typ[j].ord_typ == ro_isTemp)
2059        {
2060          const int p = r->typ[j].data.isTemp.suffixpos;
2061
2062          if(p <= j)
2063            dReportError("ordrec prefix %d is unmatched",j);
2064
2065          assume( p < r->OrdSize );
2066
2067          if(r->typ[p].ord_typ != ro_is)
2068            dReportError("ordrec prefix %d is unmatched (suffix: %d is wrong!!!)",j, p);
2069
2070          // Skip all intermediate blocks for undone variables:
2071          if(r->typ[j].data.isTemp.pVarOffset[i] != -1) // Check i^th variable
2072          {
2073            j = p - 1; // SKIP ALL INTERNAL BLOCKS...???
2074            continue; // To make for check OrdSize bound...
2075          }
2076        }
2077        else if (r->typ[j].ord_typ == ro_is)
2078        {
2079          // Skip all intermediate blocks for undone variables:
2080          if(r->typ[j].data.is.pVarOffset[i] != -1)
2081          {
2082            // TODO???
2083          }
2084
2085        }
2086        else
2087        {
2088          if (r->typ[j].ord_typ==ro_cp)
2089          {
2090            if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
2091              dReportError("ordrec %d conflicts with var %d",j,i);
2092          }
2093          else
2094            if ((r->typ[j].ord_typ!=ro_syzcomp)
2095            && (r->VarOffset[i] == r->typ[j].data.dp.place))
2096              dReportError("ordrec %d conflicts with var %d",j,i);
2097        }
2098      }
2099    }
2100    int tmp;
2101      tmp=r->VarOffset[i] & 0xffffff;
2102      #if SIZEOF_LONG == 8
2103        if ((r->VarOffset[i] >> 24) >63)
2104      #else
2105        if ((r->VarOffset[i] >> 24) >31)
2106      #endif
2107          dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
2108      if (i > 0 && ((tmp<0) ||(tmp>r->ExpL_Size-1)))
2109      {
2110        dReportError("varoffset out of range for var %d: %d",i,tmp);
2111      }
2112  }
2113  if(r->typ!=NULL)
2114  {
2115    for(j=0;j<r->OrdSize;j++)
2116    {
2117      if ((r->typ[j].ord_typ==ro_dp)
2118      || (r->typ[j].ord_typ==ro_wp)
2119      || (r->typ[j].ord_typ==ro_wp_neg))
2120      {
2121        if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
2122          dReportError("in ordrec %d: start(%d) > end(%d)",j,
2123            r->typ[j].data.dp.start, r->typ[j].data.dp.end);
2124        if ((r->typ[j].data.dp.start < 1)
2125        || (r->typ[j].data.dp.end > r->N))
2126          dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
2127            r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
2128      }
2129    }
2130  }
2131
2132  assume(r != NULL);
2133  assume(r->cf != NULL);
2134
2135  if (nCoeff_is_algExt(r->cf))
2136  {
2137    assume(r->cf->extRing != NULL);
2138    assume(r->cf->extRing->qideal != NULL);
2139    omCheckAddr(r->cf->extRing->qideal->m[0]);
2140  }
2141
2142  //assume(r->cf!=NULL);
2143
2144  return TRUE;
2145}
2146#endif
2147
2148static void rO_Align(int &place, int &bitplace)
2149{
2150  // increment place to the next aligned one
2151  // (count as Exponent_t,align as longs)
2152  if (bitplace!=BITS_PER_LONG)
2153  {
2154    place++;
2155    bitplace=BITS_PER_LONG;
2156  }
2157}
2158
2159static void rO_TDegree(int &place, int &bitplace, int start, int end,
2160    long *o, sro_ord &ord_struct)
2161{
2162  // degree (aligned) of variables v_start..v_end, ordsgn 1
2163  rO_Align(place,bitplace);
2164  ord_struct.ord_typ=ro_dp;
2165  ord_struct.data.dp.start=start;
2166  ord_struct.data.dp.end=end;
2167  ord_struct.data.dp.place=place;
2168  o[place]=1;
2169  place++;
2170  rO_Align(place,bitplace);
2171}
2172
2173static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2174    long *o, sro_ord &ord_struct)
2175{
2176  // degree (aligned) of variables v_start..v_end, ordsgn -1
2177  rO_Align(place,bitplace);
2178  ord_struct.ord_typ=ro_dp;
2179  ord_struct.data.dp.start=start;
2180  ord_struct.data.dp.end=end;
2181  ord_struct.data.dp.place=place;
2182  o[place]=-1;
2183  place++;
2184  rO_Align(place,bitplace);
2185}
2186
2187static void rO_WDegree(int &place, int &bitplace, int start, int end,
2188    long *o, sro_ord &ord_struct, int *weights)
2189{
2190  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2191  while((start<end) && (weights[0]==0)) { start++; weights++; }
2192  while((start<end) && (weights[end-start]==0)) { end--; }
2193  int i;
2194  int pure_tdeg=1;
2195  for(i=start;i<=end;i++)
2196  {
2197    if(weights[i-start]!=1)
2198    {
2199      pure_tdeg=0;
2200      break;
2201    }
2202  }
2203  if (pure_tdeg)
2204  {
2205    rO_TDegree(place,bitplace,start,end,o,ord_struct);
2206    return;
2207  }
2208  rO_Align(place,bitplace);
2209  ord_struct.ord_typ=ro_wp;
2210  ord_struct.data.wp.start=start;
2211  ord_struct.data.wp.end=end;
2212  ord_struct.data.wp.place=place;
2213  ord_struct.data.wp.weights=weights;
2214  o[place]=1;
2215  place++;
2216  rO_Align(place,bitplace);
2217  for(i=start;i<=end;i++)
2218  {
2219    if(weights[i-start]<0)
2220    {
2221      ord_struct.ord_typ=ro_wp_neg;
2222      break;
2223    }
2224  }
2225}
2226
2227static void rO_WMDegree(int &place, int &bitplace, int start, int end,
2228    long *o, sro_ord &ord_struct, int *weights)
2229{
2230  assume(weights != NULL);
2231
2232  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2233//  while((start<end) && (weights[0]==0)) { start++; weights++; }
2234//  while((start<end) && (weights[end-start]==0)) { end--; }
2235  rO_Align(place,bitplace);
2236  ord_struct.ord_typ=ro_am;
2237  ord_struct.data.am.start=start;
2238  ord_struct.data.am.end=end;
2239  ord_struct.data.am.place=place;
2240  ord_struct.data.am.weights=weights;
2241  ord_struct.data.am.weights_m = weights + (end-start+1);
2242  ord_struct.data.am.len_gen=weights[end-start+1];
2243  assume( ord_struct.data.am.weights_m[0] == ord_struct.data.am.len_gen );
2244  o[place]=1;
2245  place++;
2246  rO_Align(place,bitplace);
2247}
2248
2249static void rO_WDegree64(int &place, int &bitplace, int start, int end,
2250    long *o, sro_ord &ord_struct, int64 *weights)
2251{
2252  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1,
2253  // reserved 2 places
2254  rO_Align(place,bitplace);
2255  ord_struct.ord_typ=ro_wp64;
2256  ord_struct.data.wp64.start=start;
2257  ord_struct.data.wp64.end=end;
2258  ord_struct.data.wp64.place=place;
2259  ord_struct.data.wp64.weights64=weights;
2260  o[place]=1;
2261  place++;
2262  o[place]=1;
2263  place++;
2264  rO_Align(place,bitplace);
2265}
2266
2267static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2268    long *o, sro_ord &ord_struct, int *weights)
2269{
2270  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2271  while((start<end) && (weights[0]==0)) { start++; weights++; }
2272  while((start<end) && (weights[end-start]==0)) { end--; }
2273  rO_Align(place,bitplace);
2274  ord_struct.ord_typ=ro_wp;
2275  ord_struct.data.wp.start=start;
2276  ord_struct.data.wp.end=end;
2277  ord_struct.data.wp.place=place;
2278  ord_struct.data.wp.weights=weights;
2279  o[place]=-1;
2280  place++;
2281  rO_Align(place,bitplace);
2282  int i;
2283  for(i=start;i<=end;i++)
2284  {
2285    if(weights[i-start]<0)
2286    {
2287      ord_struct.ord_typ=ro_wp_neg;
2288      break;
2289    }
2290  }
2291}
2292
2293static void rO_LexVars(int &place, int &bitplace, int start, int end,
2294  int &prev_ord, long *o,int *v, int bits, int opt_var)
2295{
2296  // a block of variables v_start..v_end with lex order, ordsgn 1
2297  int k;
2298  int incr=1;
2299  if(prev_ord==-1) rO_Align(place,bitplace);
2300
2301  if (start>end)
2302  {
2303    incr=-1;
2304  }
2305  for(k=start;;k+=incr)
2306  {
2307    bitplace-=bits;
2308    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2309    o[place]=1;
2310    v[k]= place | (bitplace << 24);
2311    if (k==end) break;
2312  }
2313  prev_ord=1;
2314  if (opt_var!= -1)
2315  {
2316    assume((opt_var == end+1) ||(opt_var == end-1));
2317    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
2318    int save_bitplace=bitplace;
2319    bitplace-=bits;
2320    if (bitplace < 0)
2321    {
2322      bitplace=save_bitplace;
2323      return;
2324    }
2325    // there is enough space for the optional var
2326    v[opt_var]=place | (bitplace << 24);
2327  }
2328}
2329
2330static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2331  int &prev_ord, long *o,int *v, int bits, int opt_var)
2332{
2333  // a block of variables v_start..v_end with lex order, ordsgn -1
2334  int k;
2335  int incr=1;
2336  if(prev_ord==1) rO_Align(place,bitplace);
2337
2338  if (start>end)
2339  {
2340    incr=-1;
2341  }
2342  for(k=start;;k+=incr)
2343  {
2344    bitplace-=bits;
2345    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2346    o[place]=-1;
2347    v[k]=place | (bitplace << 24);
2348    if (k==end) break;
2349  }
2350  prev_ord=-1;
2351//  #if 0
2352  if (opt_var!= -1)
2353  {
2354    assume((opt_var == end+1) ||(opt_var == end-1));
2355    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
2356    int save_bitplace=bitplace;
2357    bitplace-=bits;
2358    if (bitplace < 0)
2359    {
2360      bitplace=save_bitplace;
2361      return;
2362    }
2363    // there is enough space for the optional var
2364    v[opt_var]=place | (bitplace << 24);
2365  }
2366//  #endif
2367}
2368
2369static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2370    long *o, sro_ord &ord_struct)
2371{
2372  // ordering is derived from component number
2373  rO_Align(place,bitplace);
2374  ord_struct.ord_typ=ro_syzcomp;
2375  ord_struct.data.syzcomp.place=place;
2376  ord_struct.data.syzcomp.Components=NULL;
2377  ord_struct.data.syzcomp.ShiftedComponents=NULL;
2378  o[place]=1;
2379  prev_ord=1;
2380  place++;
2381  rO_Align(place,bitplace);
2382}
2383
2384static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2385    long *o, sro_ord &ord_struct)
2386{
2387  // ordering is derived from component number
2388  // let's reserve one Exponent_t for it
2389  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
2390    rO_Align(place,bitplace);
2391  ord_struct.ord_typ=ro_syz;
2392  ord_struct.data.syz.place=place;
2393  ord_struct.data.syz.limit=0;
2394  ord_struct.data.syz.syz_index = NULL;
2395  ord_struct.data.syz.curr_index = 1;
2396  o[place]= -1;
2397  prev_ord=-1;
2398  place++;
2399}
2400
2401#ifndef NDEBUG
2402# define MYTEST 0
2403#else /* ifndef NDEBUG */
2404# define MYTEST 0
2405#endif /* ifndef NDEBUG */
2406
2407static void rO_ISPrefix(int &place, int &bitplace, int &prev_ord,
2408    long *o, int /*N*/, int *v, sro_ord &ord_struct)
2409{
2410  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
2411    rO_Align(place,bitplace);
2412  // since we add something afterwards - it's better to start with anew!?
2413
2414  ord_struct.ord_typ = ro_isTemp;
2415  ord_struct.data.isTemp.start = place;
2416  ord_struct.data.isTemp.pVarOffset = (int *)omMemDup(v);
2417  ord_struct.data.isTemp.suffixpos = -1;
2418
2419  // We will act as rO_Syz on our own!!!
2420  // Here we allocate an exponent as a level placeholder
2421  o[place]= -1;
2422  prev_ord=-1;
2423  place++;
2424}
2425static void rO_ISSuffix(int &place, int &bitplace, int &prev_ord, long *o,
2426  int N, int *v, sro_ord *tmp_typ, int &typ_i, int sgn)
2427{
2428
2429  // Let's find previous prefix:
2430  int typ_j = typ_i - 1;
2431  while(typ_j >= 0)
2432  {
2433    if( tmp_typ[typ_j].ord_typ == ro_isTemp)
2434      break;
2435    typ_j --;
2436  }
2437
2438  assume( typ_j >= 0 );
2439
2440  if( typ_j < 0 ) // Found NO prefix!!! :(
2441    return;
2442
2443  assume( tmp_typ[typ_j].ord_typ == ro_isTemp );
2444
2445  // Get saved state:
2446  const int start = tmp_typ[typ_j].data.isTemp.start;
2447  int *pVarOffset = tmp_typ[typ_j].data.isTemp.pVarOffset;
2448
2449/*
2450  // shift up all blocks
2451  while(typ_j < (typ_i-1))
2452  {
2453    tmp_typ[typ_j] = tmp_typ[typ_j+1];
2454    typ_j++;
2455  }
2456  typ_j = typ_i - 1; // No increment for typ_i
2457*/
2458  tmp_typ[typ_j].data.isTemp.suffixpos = typ_i;
2459
2460  // Let's keep that dummy for now...
2461  typ_j = typ_i; // the typ to change!
2462  typ_i++; // Just for now...
2463
2464
2465  for( int i = 0; i <= N; i++ ) // Note [0] == component !!! No Skip?
2466  {
2467    // Was i-th variable allocated inbetween?
2468    if( v[i] != pVarOffset[i] )
2469    {
2470      pVarOffset[i] = v[i]; // Save for later...
2471      v[i] = -1; // Undo!
2472      assume( pVarOffset[i] != -1 );
2473    }
2474    else
2475      pVarOffset[i] = -1; // No change here...
2476  }
2477
2478  if( pVarOffset[0] != -1 )
2479    pVarOffset[0] &= 0x0fff;
2480
2481  sro_ord &ord_struct = tmp_typ[typ_j];
2482
2483
2484  ord_struct.ord_typ = ro_is;
2485  ord_struct.data.is.start = start;
2486  ord_struct.data.is.end   = place;
2487  ord_struct.data.is.pVarOffset = pVarOffset;
2488
2489
2490  // What about component???
2491//   if( v[0] != -1 ) // There is a component already...???
2492//     if( o[ v[0] & 0x0fff ] == sgn )
2493//     {
2494//       pVarOffset[0] = -1; // NEVER USED Afterwards...
2495//       return;
2496//     }
2497
2498
2499  // Moreover: we need to allocate the module component (v[0]) here!
2500  if( v[0] == -1) // It's possible that there was module component v0 at the begining (before prefix)!
2501  {
2502    // Start with a whole long exponent
2503    if( bitplace != BITS_PER_LONG )
2504      rO_Align(place, bitplace);
2505
2506    assume( bitplace == BITS_PER_LONG );
2507    bitplace -= BITS_PER_LONG;
2508    assume(bitplace == 0);
2509    v[0] = place | (bitplace << 24); // Never mind whether pVarOffset[0] > 0!!!
2510    o[place] = sgn; // Singnum for component ordering
2511    prev_ord = sgn;
2512  }
2513}
2514
2515
2516static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
2517{
2518  if (bitmask == 0)
2519  {
2520    bits=16; bitmask=0xffff;
2521  }
2522  else if (bitmask <= 1L)
2523  {
2524    bits=1; bitmask = 1L;
2525  }
2526  else if (bitmask <= 3L)
2527  {
2528    bits=2; bitmask = 3L;
2529  }
2530  else if (bitmask <= 7L)
2531  {
2532    bits=3; bitmask=7L;
2533  }
2534  else if (bitmask <= 0xfL)
2535  {
2536    bits=4; bitmask=0xfL;
2537  }
2538  else if (bitmask <= 0x1fL)
2539  {
2540    bits=5; bitmask=0x1fL;
2541  }
2542  else if (bitmask <= 0x3fL)
2543  {
2544    bits=6; bitmask=0x3fL;
2545  }
2546#if SIZEOF_LONG == 8
2547  else if (bitmask <= 0x7fL)
2548  {
2549    bits=7; bitmask=0x7fL; /* 64 bit longs only */
2550  }
2551#endif
2552  else if (bitmask <= 0xffL)
2553  {
2554    bits=8; bitmask=0xffL;
2555  }
2556#if SIZEOF_LONG == 8
2557  else if (bitmask <= 0x1ffL)
2558  {
2559    bits=9; bitmask=0x1ffL; /* 64 bit longs only */
2560  }
2561#endif
2562  else if (bitmask <= 0x3ffL)
2563  {
2564    bits=10; bitmask=0x3ffL;
2565  }
2566#if SIZEOF_LONG == 8
2567  else if (bitmask <= 0xfffL)
2568  {
2569    bits=12; bitmask=0xfff; /* 64 bit longs only */
2570  }
2571#endif
2572  else if (bitmask <= 0xffffL)
2573  {
2574    bits=16; bitmask=0xffffL;
2575  }
2576#if SIZEOF_LONG == 8
2577  else if (bitmask <= 0xfffffL)
2578  {
2579    bits=20; bitmask=0xfffffL; /* 64 bit longs only */
2580  }
2581  else if (bitmask <= 0xffffffffL)
2582  {
2583    bits=32; bitmask=0xffffffffL;
2584  }
2585  else if (bitmask <= 0x7fffffffffffffffL)
2586  {
2587    bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2588  }
2589  else
2590  {
2591    bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2592  }
2593#else
2594  else if (bitmask <= 0x7fffffff)
2595  {
2596    bits=31; bitmask=0x7fffffff; /* for overflow tests*/
2597  }
2598  else
2599  {
2600    bits=31; bitmask=0x7fffffffL; /* for overflow tests*/
2601  }
2602#endif
2603  return bitmask;
2604}
2605
2606/*2
2607* optimize rGetExpSize for a block of N variables, exp <=bitmask
2608*/
2609static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
2610{
2611  bitmask =rGetExpSize(bitmask, bits);
2612  int vars_per_long=BIT_SIZEOF_LONG/bits;
2613  int bits1;
2614  loop
2615  {
2616    if (bits == BIT_SIZEOF_LONG-1)
2617    {
2618      bits =  BIT_SIZEOF_LONG - 1;
2619      return LONG_MAX;
2620    }
2621    unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
2622    int vars_per_long1=BIT_SIZEOF_LONG/bits1;
2623    if ((((N+vars_per_long-1)/vars_per_long) ==
2624         ((N+vars_per_long1-1)/vars_per_long1)))
2625    {
2626      vars_per_long=vars_per_long1;
2627      bits=bits1;
2628      bitmask=bitmask1;
2629    }
2630    else
2631    {
2632      return bitmask; /* and bits */
2633    }
2634  }
2635}
2636
2637
2638/*2
2639 * create a copy of the ring r, which must be equivalent to currRing
2640 * used for std computations
2641 * may share data structures with currRing
2642 * DOES CALL rComplete
2643 */
2644ring rModifyRing(ring r, BOOLEAN omit_degree,
2645                         BOOLEAN omit_comp,
2646                         unsigned long exp_limit)
2647{
2648  assume (r != NULL );
2649  assume (exp_limit > 1);
2650  BOOLEAN need_other_ring;
2651  BOOLEAN omitted_degree = FALSE;
2652
2653  int iNeedInducedOrderingSetup = 0; ///< How many induced ordering block do we have?
2654  int bits;
2655
2656  exp_limit=rGetExpSize(exp_limit, bits, r->N);
2657  need_other_ring = (exp_limit != r->bitmask);
2658
2659  int nblocks=rBlocks(r);
2660  int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2661  int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2662  int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2663  int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int *));
2664
2665  int i=0;
2666  int j=0; /*  i index in r, j index in res */
2667
2668  for( int r_ord=r->order[i]; (r_ord != 0) && (i < nblocks); j++, r_ord=r->order[++i])
2669  {
2670    BOOLEAN copy_block_index=TRUE;
2671
2672    if (r->block0[i]==r->block1[i])
2673    {
2674      switch(r_ord)
2675      {
2676        case ringorder_wp:
2677        case ringorder_dp:
2678        case ringorder_Wp:
2679        case ringorder_Dp:
2680          r_ord=ringorder_lp;
2681          break;
2682        case ringorder_Ws:
2683        case ringorder_Ds:
2684        case ringorder_ws:
2685        case ringorder_ds:
2686          r_ord=ringorder_ls;
2687          break;
2688        default:
2689          break;
2690      }
2691    }
2692    switch(r_ord)
2693    {
2694      case ringorder_S:
2695      {
2696#ifndef NDEBUG
2697        Warn("Error: unhandled ordering in rModifyRing: ringorder_S = [%d]", r_ord);
2698#endif
2699        order[j]=r_ord; /*r->order[i];*/
2700        break;
2701      }
2702      case ringorder_C:
2703      case ringorder_c:
2704        if (!omit_comp)
2705        {
2706          order[j]=r_ord; /*r->order[i]*/;
2707        }
2708        else
2709        {
2710          j--;
2711          need_other_ring=TRUE;
2712          omit_comp=FALSE;
2713          copy_block_index=FALSE;
2714        }
2715        break;
2716      case ringorder_wp:
2717      case ringorder_dp:
2718      case ringorder_ws:
2719      case ringorder_ds:
2720        if(!omit_degree)
2721        {
2722          order[j]=r_ord; /*r->order[i]*/;
2723        }
2724        else
2725        {
2726          order[j]=ringorder_rs;
2727          need_other_ring=TRUE;
2728          omit_degree=FALSE;
2729          omitted_degree = TRUE;
2730        }
2731        break;
2732      case ringorder_Wp:
2733      case ringorder_Dp:
2734      case ringorder_Ws:
2735      case ringorder_Ds:
2736        if(!omit_degree)
2737        {
2738          order[j]=r_ord; /*r->order[i];*/
2739        }
2740        else
2741        {
2742          order[j]=ringorder_lp;
2743          need_other_ring=TRUE;
2744          omit_degree=FALSE;
2745          omitted_degree = TRUE;
2746        }
2747        break;
2748      case ringorder_IS:
2749      {
2750        if (omit_comp)
2751        {
2752#ifndef NDEBUG
2753          Warn("Error: WRONG USAGE of rModifyRing: cannot omit component due to the ordering block [%d]: %d (ringorder_IS)", i, r_ord);
2754#endif
2755          omit_comp = FALSE;
2756        }
2757        order[j]=r_ord; /*r->order[i];*/
2758        iNeedInducedOrderingSetup++;
2759        break;
2760      }
2761      case ringorder_s:
2762      {
2763        assume((i == 0) && (j == 0));
2764        if (omit_comp)
2765        {
2766#ifndef NDEBUG
2767          Warn("WRONG USAGE? of rModifyRing: omitting component due to the ordering block [%d]: %d (ringorder_s)", i, r_ord);
2768#endif
2769          omit_comp = FALSE;
2770        }
2771        order[j]=r_ord; /*r->order[i];*/
2772        break;
2773      }
2774      default:
2775        order[j]=r_ord; /*r->order[i];*/
2776        break;
2777    }
2778    if (copy_block_index)
2779    {
2780      block0[j]=r->block0[i];
2781      block1[j]=r->block1[i];
2782      wvhdl[j]=r->wvhdl[i];
2783    }
2784
2785    // order[j]=ringorder_no; //  done by omAlloc0
2786  }
2787  if(!need_other_ring)
2788  {
2789    omFreeSize(order,(nblocks+1)*sizeof(int));
2790    omFreeSize(block0,(nblocks+1)*sizeof(int));
2791    omFreeSize(block1,(nblocks+1)*sizeof(int));
2792    omFreeSize(wvhdl,(nblocks+1)*sizeof(int *));
2793    return r;
2794  }
2795  ring res=(ring)omAlloc0Bin(sip_sring_bin);
2796  *res = *r;
2797
2798#ifdef HAVE_PLURAL
2799  res->GetNC() = NULL;
2800#endif
2801
2802  // res->qideal, res->idroot ???
2803  res->wvhdl=wvhdl;
2804  res->order=order;
2805  res->block0=block0;
2806  res->block1=block1;
2807  res->bitmask=exp_limit;
2808  int tmpref=r->cf->ref;
2809  rComplete(res, 1);
2810  r->cf->ref=tmpref;
2811
2812  // adjust res->pFDeg: if it was changed globally, then
2813  // it must also be changed for new ring
2814  if (r->pFDegOrig != res->pFDegOrig &&
2815           rOrd_is_WeightedDegree_Ordering(r))
2816  {
2817    // still might need adjustment for weighted orderings
2818    // and omit_degree
2819    res->firstwv = r->firstwv;
2820    res->firstBlockEnds = r->firstBlockEnds;
2821    res->pFDeg = res->pFDegOrig = p_WFirstTotalDegree;
2822  }
2823  if (omitted_degree)
2824    res->pLDeg = r->pLDegOrig;
2825
2826  rOptimizeLDeg(res); // also sets res->pLDegOrig
2827
2828  // set syzcomp
2829  if (res->typ != NULL)
2830  {
2831    if( res->typ[0].ord_typ == ro_syz) // "s" Always on [0] place!
2832    {
2833      res->typ[0] = r->typ[0]; // Copy struct!? + setup the same limit!
2834
2835      if (r->typ[0].data.syz.limit > 0)
2836      {
2837        res->typ[0].data.syz.syz_index
2838          = (int*) omAlloc((r->typ[0].data.syz.limit +1)*sizeof(int));
2839        memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2840              (r->typ[0].data.syz.limit +1)*sizeof(int));
2841      }
2842    }
2843
2844    if( iNeedInducedOrderingSetup > 0 )
2845    {
2846      for(j = 0, i = 0; (i < nblocks) && (iNeedInducedOrderingSetup > 0); i++)
2847        if( res->typ[i].ord_typ == ro_is ) // Search for suffixes!
2848        {
2849          ideal F = idrHeadR(r->typ[i].data.is.F, r, res); // Copy F from r into res!
2850          assume(
2851            rSetISReference( res,
2852              F,  // WILL BE COPIED!
2853              r->typ[i].data.is.limit,
2854              j++
2855              )
2856            );
2857          id_Delete(&F, res);
2858          iNeedInducedOrderingSetup--;
2859        }
2860    } // Process all induced Ordering blocks! ...
2861  }
2862  // the special case: homog (omit_degree) and 1 block rs: that is global:
2863  // it comes from dp
2864  res->OrdSgn=r->OrdSgn;
2865
2866
2867#ifdef HAVE_PLURAL
2868  if (rIsPluralRing(r))
2869  {
2870    if ( nc_rComplete(r, res, false) ) // no qideal!
2871    {
2872#ifndef NDEBUG
2873      WarnS("error in nc_rComplete");
2874#endif
2875      // cleanup?
2876
2877//      rDelete(res);
2878//      return r;
2879
2880      // just go on..
2881    }
2882
2883    if( rIsSCA(r) )
2884    {
2885      if( !sca_Force(res, scaFirstAltVar(r), scaLastAltVar(r)) )
2886      WarnS("error in sca_Force!");
2887    }
2888  }
2889#endif
2890
2891  return res;
2892}
2893
2894// construct Wp,C ring
2895ring rModifyRing_Wp(ring r, int* weights)
2896{
2897  ring res=(ring)omAlloc0Bin(sip_sring_bin);
2898  *res = *r;
2899#ifdef HAVE_PLURAL
2900  res->GetNC() = NULL;
2901#endif
2902
2903  /*weights: entries for 3 blocks: NULL*/
2904  res->wvhdl = (int **)omAlloc0(3 * sizeof(int *));
2905  /*order: Wp,C,0*/
2906  res->order = (int *) omAlloc(3 * sizeof(int *));
2907  res->block0 = (int *)omAlloc0(3 * sizeof(int *));
2908  res->block1 = (int *)omAlloc0(3 * sizeof(int *));
2909  /* ringorder Wp for the first block: var 1..r->N */
2910  res->order[0]  = ringorder_Wp;
2911  res->block0[0] = 1;
2912  res->block1[0] = r->N;
2913  res->wvhdl[0] = weights;
2914  /* ringorder C for the second block: no vars */
2915  res->order[1]  = ringorder_C;
2916  /* the last block: everything is 0 */
2917  res->order[2]  = 0;
2918  /*polynomial ring*/
2919  res->OrdSgn    = 1;
2920
2921  int tmpref=r->cf->ref;
2922  rComplete(res, 1);
2923  r->cf->ref=tmpref;
2924#ifdef HAVE_PLURAL
2925  if (rIsPluralRing(r))
2926  {
2927    if ( nc_rComplete(r, res, false) ) // no qideal!
2928    {
2929#ifndef NDEBUG
2930      WarnS("error in nc_rComplete");
2931#endif
2932      // cleanup?
2933
2934//      rDelete(res);
2935//      return r;
2936
2937      // just go on..
2938    }
2939  }
2940#endif
2941  return res;
2942}
2943
2944// construct lp, C ring with r->N variables, r->names vars....
2945ring rModifyRing_Simple(ring r, BOOLEAN ommit_degree, BOOLEAN ommit_comp, unsigned long exp_limit, BOOLEAN &simple)
2946{
2947  simple=TRUE;
2948  if (!rHasSimpleOrder(r))
2949  {
2950    simple=FALSE; // sorting needed
2951    assume (r != NULL );
2952    assume (exp_limit > 1);
2953    int bits;
2954
2955    exp_limit=rGetExpSize(exp_limit, bits, r->N);
2956
2957    int nblocks=1+(ommit_comp!=0);
2958    int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2959    int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2960    int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2961    int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int *));
2962
2963    order[0]=ringorder_lp;
2964    block0[0]=1;
2965    block1[0]=r->N;
2966    if (!ommit_comp)
2967    {
2968      order[1]=ringorder_C;
2969    }
2970    ring res=(ring)omAlloc0Bin(sip_sring_bin);
2971    *res = *r;
2972#ifdef HAVE_PLURAL
2973    res->GetNC() = NULL;
2974#endif
2975    // res->qideal, res->idroot ???
2976    res->wvhdl=wvhdl;
2977    res->order=order;
2978    res->block0=block0;
2979    res->block1=block1;
2980    res->bitmask=exp_limit;
2981    int tmpref=r->cf->ref;
2982    rComplete(res, 1);
2983    r->cf->ref=tmpref;
2984
2985#ifdef HAVE_PLURAL
2986    if (rIsPluralRing(r))
2987    {
2988      if ( nc_rComplete(r, res, false) ) // no qideal!
2989      {
2990#ifndef NDEBUG
2991        WarnS("error in nc_rComplete");
2992#endif
2993        // cleanup?
2994
2995//      rDelete(res);
2996//      return r;
2997
2998      // just go on..
2999      }
3000    }
3001#endif
3002
3003    rOptimizeLDeg(res);
3004
3005    return res;
3006  }
3007  return rModifyRing(r, ommit_degree, ommit_comp, exp_limit);
3008}
3009
3010void rKillModifiedRing_Simple(ring r)
3011{
3012  rKillModifiedRing(r);
3013}
3014
3015
3016void rKillModifiedRing(ring r)
3017{
3018  rUnComplete(r);
3019  omFree(r->order);
3020  omFree(r->block0);
3021  omFree(r->block1);
3022  omFree(r->wvhdl);
3023  omFreeBin(r,sip_sring_bin);
3024}
3025
3026void rKillModified_Wp_Ring(ring r)
3027{
3028  rUnComplete(r);
3029  omFree(r->order);
3030  omFree(r->block0);
3031  omFree(r->block1);
3032  omFree(r->wvhdl[0]);
3033  omFree(r->wvhdl);
3034  omFreeBin(r,sip_sring_bin);
3035}
3036
3037static void rSetOutParams(ring r)
3038{
3039  r->VectorOut = (r->order[0] == ringorder_c);
3040  r->CanShortOut = TRUE;
3041  {
3042    int i;
3043    if (rParameter(r)!=NULL)
3044    {
3045      for (i=0;i<rPar(r);i++)
3046      {
3047        if(strlen(rParameter(r)[i])>1)
3048        {
3049          r->CanShortOut=FALSE;
3050          break;
3051        }
3052      }
3053    }
3054    if (r->CanShortOut)
3055    {
3056      // Hmm... sometimes (e.g., from maGetPreimage) new variables
3057      // are introduced, but their names are never set
3058      // hence, we do the following awkward trick
3059      int N = omSizeOfAddr(r->names)/sizeof(char*);
3060      if (r->N < N) N = r->N;
3061
3062      for (i=(N-1);i>=0;i--)
3063      {
3064        if(r->names[i] != NULL && strlen(r->names[i])>1)
3065        {
3066          r->CanShortOut=FALSE;
3067          break;
3068        }
3069      }
3070    }
3071  }
3072  r->ShortOut = r->CanShortOut;
3073
3074  assume( !( !r->CanShortOut && r->ShortOut ) );
3075}
3076
3077/*2
3078* sets r->MixedOrder and r->ComponentOrder for orderings with more than one block
3079* block of variables (ip is the block number, o_r the number of the ordering)
3080* o is the position of the orderingering in r
3081*/
3082static void rHighSet(ring r, int o_r, int o)
3083{
3084  switch(o_r)
3085  {
3086    case ringorder_lp:
3087    case ringorder_dp:
3088    case ringorder_Dp:
3089    case ringorder_wp:
3090    case ringorder_Wp:
3091    case ringorder_rp:
3092    case ringorder_a:
3093    case ringorder_aa:
3094    case ringorder_am:
3095    case ringorder_a64:
3096      if (r->OrdSgn==-1) r->MixedOrder=TRUE;
3097      break;
3098    case ringorder_ls:
3099    case ringorder_rs:
3100    case ringorder_ds:
3101    case ringorder_Ds:
3102    case ringorder_s:
3103      break;
3104    case ringorder_ws:
3105    case ringorder_Ws:
3106      if (r->wvhdl[o]!=NULL)
3107      {
3108        int i;
3109        for(i=r->block1[o]-r->block0[o];i>=0;i--)
3110          if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
3111      }
3112      break;
3113    case ringorder_c:
3114      r->ComponentOrder=1;
3115      break;
3116    case ringorder_C:
3117    case ringorder_S:
3118      r->ComponentOrder=-1;
3119      break;
3120    case ringorder_M:
3121      r->LexOrder=TRUE;
3122      break;
3123    case ringorder_IS:
3124    { // TODO: What is r->ComponentOrder???
3125//      r->MixedOrder=TRUE;
3126      if( r->block0[o] != 0 ) // Suffix has the component
3127        r->ComponentOrder = r->block0[o];
3128/*      else // Prefix has level...
3129        r->ComponentOrder=-1;
3130*/
3131      // TODO: think about this a bit...!?
3132      break;
3133    }
3134
3135    default:
3136      dReportError("wrong internal ordering:%d at %s, l:%d\n",o_r,__FILE__,__LINE__);
3137  }
3138}
3139
3140static void rSetFirstWv(ring r, int i, int* order, int* block1, int** wvhdl)
3141{
3142  // cheat for ringorder_aa
3143  if (order[i] == ringorder_aa)
3144    i++;
3145  if(block1[i]!=r->N) r->LexOrder=TRUE;
3146  r->firstBlockEnds=block1[i];
3147  r->firstwv = wvhdl[i];
3148  if ((order[i]== ringorder_ws)
3149  || (order[i]==ringorder_Ws)
3150  || (order[i]== ringorder_wp)
3151  || (order[i]==ringorder_Wp)
3152  || (order[i]== ringorder_a)
3153   /*|| (order[i]==ringorder_A)*/)
3154  {
3155    int j;
3156    for(j=block1[i]-r->block0[i];j>=0;j--)
3157    {
3158      if (r->firstwv[j]<0) r->MixedOrder=TRUE;
3159      if (r->firstwv[j]==0) r->LexOrder=TRUE;
3160    }
3161  }
3162  else if (order[i]==ringorder_a64)
3163  {
3164    int j;
3165    int64 *w=rGetWeightVec(r);
3166    for(j=block1[i]-r->block0[i];j>=0;j--)
3167    {
3168      if (w[j]==0) r->LexOrder=TRUE;
3169    }
3170  }
3171}
3172
3173static void rOptimizeLDeg(ring r)
3174{
3175  if (r->pFDeg == p_Deg)
3176  {
3177    if (r->pLDeg == pLDeg1)
3178      r->pLDeg = pLDeg1_Deg;
3179    if (r->pLDeg == pLDeg1c)
3180      r->pLDeg = pLDeg1c_Deg;
3181  }
3182  else if (r->pFDeg == p_Totaldegree)
3183  {
3184    if (r->pLDeg == pLDeg1)
3185      r->pLDeg = pLDeg1_Totaldegree;
3186    if (r->pLDeg == pLDeg1c)
3187      r->pLDeg = pLDeg1c_Totaldegree;
3188  }
3189  else if (r->pFDeg == p_WFirstTotalDegree)
3190  {
3191    if (r->pLDeg == pLDeg1)
3192      r->pLDeg = pLDeg1_WFirstTotalDegree;
3193    if (r->pLDeg == pLDeg1c)
3194      r->pLDeg = pLDeg1c_WFirstTotalDegree;
3195  }
3196  r->pLDegOrig = r->pLDeg;
3197}
3198
3199// set pFDeg, pLDeg, MixOrder, ComponentOrder, etc
3200static void rSetDegStuff(ring r)
3201{
3202  int* order = r->order;
3203  int* block0 = r->block0;
3204  int* block1 = r->block1;
3205  int** wvhdl = r->wvhdl;
3206
3207  if (order[0]==ringorder_S ||order[0]==ringorder_s || order[0]==ringorder_IS)
3208  {
3209    order++;
3210    block0++;
3211    block1++;
3212    wvhdl++;
3213  }
3214  r->LexOrder = FALSE;
3215  r->MixedOrder = FALSE;
3216  r->ComponentOrder = 1;
3217  r->pFDeg = p_Totaldegree;
3218  r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
3219
3220  /*======== ordering type is (am,_) ==================*/
3221  if (order[0]==ringorder_am)
3222  {
3223    r->MixedOrder = FALSE;
3224    for(int ii=block0[0];ii<=block1[0];ii++)
3225      if (wvhdl[0][ii-1]<0) { r->MixedOrder=TRUE;break;}
3226    r->LexOrder=FALSE;
3227    for(int ii=block0[0];ii<=block1[0];ii++)
3228      if (wvhdl[0][ii-1]==0) { r->LexOrder=TRUE;break;}
3229    if ((block0[0]==1)&&(block1[0]==r->N))
3230    {
3231      r->pFDeg = p_Deg;
3232      r->pLDeg = pLDeg1c_Deg;
3233    }
3234    else
3235   {
3236      r->pFDeg = p_WTotaldegree;
3237      r->LexOrder=TRUE;
3238      r->pLDeg = pLDeg1c_WFirstTotalDegree;
3239    }
3240    r->firstwv = wvhdl[0];
3241  }
3242  /*======== ordering type is (_,c) =========================*/
3243  else if ((order[0]==ringorder_unspec) || (order[1] == 0)
3244      ||(
3245    ((order[1]==ringorder_c)||(order[1]==ringorder_C)
3246     ||(order[1]==ringorder_S)
3247     ||(order[1]==ringorder_s))
3248    && (order[0]!=ringorder_M)
3249    && (order[2]==0))
3250    )
3251  {
3252    if ((order[0]!=ringorder_unspec)
3253    && ((order[1]==ringorder_C)||(order[1]==ringorder_S)||
3254        (order[1]==ringorder_s)))
3255      r->ComponentOrder=-1;
3256    if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
3257    if ((order[0] == ringorder_lp)
3258    || (order[0] == ringorder_ls)
3259    || (order[0] == ringorder_rp)
3260    || (order[0] == ringorder_rs))
3261    {
3262      r->LexOrder=TRUE;
3263      r->pLDeg = pLDeg1c;
3264      r->pFDeg = p_Totaldegree;
3265    }
3266    if ((order[0] == ringorder_a)
3267    || (order[0] == ringorder_wp)
3268    || (order[0] == ringorder_Wp)
3269    || (order[0] == ringorder_ws)
3270    || (order[0] == ringorder_Ws))
3271      r->pFDeg = p_WFirstTotalDegree;
3272    r->firstBlockEnds=block1[0];
3273    r->firstwv = wvhdl[0];
3274  }
3275  /*======== ordering type is (c,_) =========================*/
3276  else if (((order[0]==ringorder_c)
3277            ||(order[0]==ringorder_C)
3278            ||(order[0]==ringorder_S)
3279            ||(order[0]==ringorder_s))
3280  && (order[1]!=ringorder_M)
3281  &&  (order[2]==0))
3282  {
3283    if ((order[0]==ringorder_C)||(order[0]==ringorder_S)||
3284        order[0]==ringorder_s)
3285      r->ComponentOrder=-1;
3286    if ((order[1] == ringorder_lp)
3287    || (order[1] == ringorder_ls)
3288    || (order[1] == ringorder_rp)
3289    || order[1] == ringorder_rs)
3290    {
3291      r->LexOrder=TRUE;
3292      r->pLDeg = pLDeg1c;
3293      r->pFDeg = p_Totaldegree;
3294    }
3295    r->firstBlockEnds=block1[1];
3296    if (wvhdl!=NULL) r->firstwv = wvhdl[1];
3297    if ((order[1] == ringorder_a)
3298    || (order[1] == ringorder_wp)
3299    || (order[1] == ringorder_Wp)
3300    || (order[1] == ringorder_ws)
3301    || (order[1] == ringorder_Ws))
3302      r->pFDeg = p_WFirstTotalDegree;
3303  }
3304  /*------- more than one block ----------------------*/
3305  else
3306  {
3307    if ((r->VectorOut)||(order[0]==ringorder_C)||(order[0]==ringorder_S)||(order[0]==ringorder_s))
3308    {
3309      rSetFirstWv(r, 1, order, block1, wvhdl);
3310    }
3311    else
3312      rSetFirstWv(r, 0, order, block1, wvhdl);
3313
3314    /*the number of orderings:*/
3315    int i = 0; while (order[++i] != 0);
3316
3317    do
3318    {
3319      i--;
3320      rHighSet(r, order[i],i);
3321    }
3322    while (i != 0);
3323
3324    if ((order[0]!=ringorder_c)
3325        && (order[0]!=ringorder_C)
3326        && (order[0]!=ringorder_S)
3327        && (order[0]!=ringorder_s))
3328    {
3329      r->pLDeg = pLDeg1c;
3330    }
3331    else
3332    {
3333      r->pLDeg = pLDeg1;
3334    }
3335    r->pFDeg = p_WTotaldegree; // may be improved: p_Totaldegree for lp/dp/ls/.. blocks
3336  }
3337
3338  if (rOrd_is_Totaldegree_Ordering(r) || rOrd_is_WeightedDegree_Ordering(r))
3339    r->pFDeg = p_Deg;
3340
3341  if( rGetISPos(0, r) != -1 ) // Are there Schreyer induced blocks?
3342  {
3343#ifndef NDEBUG
3344      assume( r->pFDeg == p_Deg || r->pFDeg == p_WTotaldegree || r->pFDeg == p_Totaldegree);
3345#endif
3346
3347    r->pLDeg = pLDeg1; // ?
3348  }
3349
3350  r->pFDegOrig = r->pFDeg;
3351  // NOTE: this leads to wrong ecart during std
3352  // in Old/sre.tst
3353  rOptimizeLDeg(r); // also sets r->pLDegOrig
3354
3355}
3356
3357/*2
3358* set NegWeightL_Size, NegWeightL_Offset
3359*/
3360static void rSetNegWeight(ring r)
3361{
3362  int i,l;
3363  if (r->typ!=NULL)
3364  {
3365    l=0;
3366    for(i=0;i<r->OrdSize;i++)
3367    {
3368      if((r->typ[i].ord_typ==ro_wp_neg)
3369      ||(r->typ[i].ord_typ==ro_am))
3370        l++;
3371    }
3372    if (l>0)
3373    {
3374      r->NegWeightL_Size=l;
3375      r->NegWeightL_Offset=(int *) omAlloc(l*sizeof(int));
3376      l=0;
3377      for(i=0;i<r->OrdSize;i++)
3378      {
3379        if(r->typ[i].ord_typ==ro_wp_neg)
3380        {
3381          r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
3382          l++;
3383        }
3384        else if(r->typ[i].ord_typ==ro_am)
3385        {
3386          r->NegWeightL_Offset[l]=r->typ[i].data.am.place;
3387          l++;
3388        }
3389      }
3390      return;
3391    }
3392  }
3393  r->NegWeightL_Size = 0;
3394  r->NegWeightL_Offset = NULL;
3395}
3396
3397static void rSetOption(ring r)
3398{
3399  // set redthrough
3400  if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
3401    r->options |= Sy_bit(OPT_REDTHROUGH);
3402  else
3403    r->options &= ~Sy_bit(OPT_REDTHROUGH);
3404
3405  // set intStrategy
3406  if ( (r->cf->extRing!=NULL)
3407      || rField_is_Q(r)
3408#ifdef HAVE_RINGS
3409      || rField_is_Ring(r)
3410#endif
3411  )
3412    r->options |= Sy_bit(OPT_INTSTRATEGY);
3413  else
3414    r->options &= ~Sy_bit(OPT_INTSTRATEGY);
3415
3416  // set redTail
3417  if (r->LexOrder || r->OrdSgn == -1 || (r->cf->extRing!=NULL))
3418    r->options &= ~Sy_bit(OPT_REDTAIL);
3419  else
3420    r->options |= Sy_bit(OPT_REDTAIL);
3421}
3422
3423static void rCheckOrdSgn(ring r,int i/*current block*/);
3424
3425/* -------------------------------------------------------- */
3426/*2
3427* change all global variables to fit the description of the new ring
3428*/
3429
3430void p_SetGlobals(const ring r, BOOLEAN complete)
3431{
3432// // //  if (r->ppNoether!=NULL) p_Delete(&r->ppNoether,r); // ???
3433
3434  r->pLexOrder=r->LexOrder;
3435  if (complete)
3436  {
3437    si_opt_1 &= ~ TEST_RINGDEP_OPTS;
3438    si_opt_1 |= r->options;
3439  }
3440}
3441
3442BOOLEAN rComplete(ring r, int force)
3443{
3444  if (r->VarOffset!=NULL && force == 0) return FALSE;
3445  rSetOutParams(r);
3446  int n=rBlocks(r)-1;
3447  int i;
3448  int bits;
3449  r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
3450  r->BitsPerExp = bits;
3451  r->ExpPerLong = BIT_SIZEOF_LONG / bits;
3452  r->divmask=rGetDivMask(bits);
3453
3454  // will be used for ordsgn:
3455  long *tmp_ordsgn=(long *)omAlloc0(3*(n+r->N)*sizeof(long));
3456  // will be used for VarOffset:
3457  int *v=(int *)omAlloc((r->N+1)*sizeof(int));
3458  for(i=r->N; i>=0 ; i--)
3459  {
3460    v[i]=-1;
3461  }
3462  sro_ord *tmp_typ=(sro_ord *)omAlloc0(3*(n+r->N)*sizeof(sro_ord));
3463  int typ_i=0;
3464  int prev_ordsgn=0;
3465
3466  // fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
3467  int j=0;
3468  int j_bits=BITS_PER_LONG;
3469
3470  BOOLEAN need_to_add_comp=FALSE; // Only for ringorder_s and ringorder_S!
3471
3472  for(i=0;i<n;i++)
3473  {
3474    tmp_typ[typ_i].order_index=i;
3475    switch (r->order[i])
3476    {
3477      case ringorder_a:
3478      case ringorder_aa:
3479        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3480                   r->wvhdl[i]);
3481        typ_i++;
3482        break;
3483
3484      case ringorder_am:
3485        rO_WMDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3486                   r->wvhdl[i]);
3487        typ_i++;
3488        break;
3489
3490      case ringorder_a64:
3491        rO_WDegree64(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3492                     tmp_typ[typ_i], (int64 *)(r->wvhdl[i]));
3493        typ_i++;
3494        break;
3495
3496      case ringorder_c:
3497        rO_Align(j, j_bits);
3498        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3499        break;
3500
3501      case ringorder_C:
3502        rO_Align(j, j_bits);
3503        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3504        break;
3505
3506      case ringorder_M:
3507        {
3508          int k,l;
3509          k=r->block1[i]-r->block0[i]+1; // number of vars
3510          for(l=0;l<k;l++)
3511          {
3512            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3513                       tmp_typ[typ_i],
3514                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
3515            typ_i++;
3516          }
3517          break;
3518        }
3519
3520      case ringorder_lp:
3521        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3522                   tmp_ordsgn,v,bits, -1);
3523        break;
3524
3525      case ringorder_ls:
3526        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3527                       tmp_ordsgn,v, bits, -1);
3528        rCheckOrdSgn(r,i);
3529        break;
3530
3531      case ringorder_rs:
3532        rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3533                       tmp_ordsgn,v, bits, -1);
3534        rCheckOrdSgn(r,i);
3535        break;
3536
3537      case ringorder_rp:
3538        rO_LexVars(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3539                       tmp_ordsgn,v, bits, -1);
3540        break;
3541
3542      case ringorder_dp:
3543        if (r->block0[i]==r->block1[i])
3544        {
3545          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3546                     tmp_ordsgn,v, bits, -1);
3547        }
3548        else
3549        {
3550          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3551                     tmp_typ[typ_i]);
3552          typ_i++;
3553          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3554                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3555        }
3556        break;
3557
3558      case ringorder_Dp:
3559        if (r->block0[i]==r->block1[i])
3560        {
3561          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3562                     tmp_ordsgn,v, bits, -1);
3563        }
3564        else
3565        {
3566          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3567                     tmp_typ[typ_i]);
3568          typ_i++;
3569          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3570                     tmp_ordsgn,v, bits, r->block1[i]);
3571        }
3572        break;
3573
3574      case ringorder_ds:
3575        if (r->block0[i]==r->block1[i])
3576        {
3577          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
3578                         tmp_ordsgn,v,bits, -1);
3579        }
3580        else
3581        {
3582          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3583                         tmp_typ[typ_i]);
3584          typ_i++;
3585          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3586                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3587        }
3588        rCheckOrdSgn(r,i);
3589        break;
3590
3591      case ringorder_Ds:
3592        if (r->block0[i]==r->block1[i])
3593        {
3594          rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
3595                         tmp_ordsgn,v, bits, -1);
3596        }
3597        else
3598        {
3599          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3600                         tmp_typ[typ_i]);
3601          typ_i++;
3602          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3603                     tmp_ordsgn,v, bits, r->block1[i]);
3604        }
3605        rCheckOrdSgn(r,i);
3606        break;
3607
3608      case ringorder_wp:
3609        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3610                   tmp_typ[typ_i], r->wvhdl[i]);
3611        typ_i++;
3612        { // check for weights <=0
3613          int jj;
3614          BOOLEAN have_bad_weights=FALSE;
3615          for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3616          {
3617            if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3618          }
3619          if (have_bad_weights)
3620          {
3621             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3622                                     tmp_typ[typ_i]);
3623             typ_i++;
3624             rCheckOrdSgn(r,i);
3625          }
3626        }
3627        if (r->block1[i]!=r->block0[i])
3628        {
3629          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3630                         tmp_ordsgn, v,bits, r->block0[i]);
3631        }
3632        break;
3633
3634      case ringorder_Wp:
3635        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3636                   tmp_typ[typ_i], r->wvhdl[i]);
3637        typ_i++;
3638        { // check for weights <=0
3639          int jj;
3640          BOOLEAN have_bad_weights=FALSE;
3641          for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3642          {
3643            if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3644          }
3645          if (have_bad_weights)
3646          {
3647             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3648                                     tmp_typ[typ_i]);
3649             typ_i++;
3650             rCheckOrdSgn(r,i);
3651          }
3652        }
3653        if (r->block1[i]!=r->block0[i])
3654        {
3655          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3656                     tmp_ordsgn,v, bits, r->block1[i]);
3657        }
3658        break;
3659
3660      case ringorder_ws:
3661        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3662                       tmp_typ[typ_i], r->wvhdl[i]);
3663        typ_i++;
3664        if (r->block1[i]!=r->block0[i])
3665        {
3666          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3667                         tmp_ordsgn, v,bits, r->block0[i]);
3668        }
3669        rCheckOrdSgn(r,i);
3670        break;
3671
3672      case ringorder_Ws:
3673        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3674                       tmp_typ[typ_i], r->wvhdl[i]);
3675        typ_i++;
3676        if (r->block1[i]!=r->block0[i])
3677        {
3678          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3679                     tmp_ordsgn,v, bits, r->block1[i]);
3680        }
3681        rCheckOrdSgn(r,i);
3682        break;
3683
3684      case ringorder_S:
3685        assume(typ_i == 1); // For LaScala3 only: on the 2nd place ([1])!
3686        // TODO: for K[x]: it is 0...?!
3687        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3688        need_to_add_comp=TRUE;
3689        typ_i++;
3690        break;
3691
3692      case ringorder_s:
3693        assume(typ_i == 0 && j == 0);
3694        rO_Syz(j, j_bits, prev_ordsgn, tmp_ordsgn, tmp_typ[typ_i]); // set syz-limit?
3695        need_to_add_comp=TRUE;
3696        typ_i++;
3697        break;
3698
3699      case ringorder_IS:
3700      {
3701
3702        assume( r->block0[i] == r->block1[i] );
3703        const int s = r->block0[i];
3704        assume( -2 < s && s < 2);
3705
3706        if(s == 0) // Prefix IS
3707          rO_ISPrefix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ[typ_i++]); // What about prev_ordsgn?
3708        else // s = +1 or -1 // Note: typ_i might be incrimented here inside!
3709        {
3710          rO_ISSuffix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ, typ_i, s); // Suffix.
3711          need_to_add_comp=FALSE;
3712        }
3713
3714        break;
3715      }
3716      case ringorder_unspec:
3717      case ringorder_no:
3718      default:
3719        dReportError("undef. ringorder used\n");
3720        break;
3721    }
3722  }
3723
3724  int j0=j; // save j
3725  int j_bits0=j_bits; // save jbits
3726  rO_Align(j,j_bits);
3727  r->CmpL_Size = j;
3728
3729  j_bits=j_bits0; j=j0;
3730
3731  // fill in some empty slots with variables not already covered
3732  // v0 is special, is therefore normally already covered
3733  // now we do have rings without comp...
3734  if((need_to_add_comp) && (v[0]== -1))
3735  {
3736    if (prev_ordsgn==1)
3737    {
3738      rO_Align(j, j_bits);
3739      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3740    }
3741    else
3742    {
3743      rO_Align(j, j_bits);
3744      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3745    }
3746  }
3747  // the variables
3748  for(i=1 ; i<=r->N ; i++)
3749  {
3750    if(v[i]==(-1))
3751    {
3752      if (prev_ordsgn==1)
3753      {
3754        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3755      }
3756      else
3757      {
3758        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3759      }
3760    }
3761  }
3762
3763  rO_Align(j,j_bits);
3764  // ----------------------------
3765  // finished with constructing the monomial, computing sizes:
3766
3767  r->ExpL_Size=j;
3768  r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
3769  assume(r->PolyBin != NULL);
3770
3771  // ----------------------------
3772  // indices and ordsgn vector for comparison
3773  //
3774  // r->pCompHighIndex already set
3775  r->ordsgn=(long *)omAlloc0(r->ExpL_Size*sizeof(long));
3776
3777  for(j=0;j<r->CmpL_Size;j++)
3778  {
3779    r->ordsgn[j] = tmp_ordsgn[j];
3780  }
3781
3782  omFreeSize((ADDRESS)tmp_ordsgn,(3*(n+r->N)*sizeof(long)));
3783
3784  // ----------------------------
3785  // description of orderings for setm:
3786  //
3787  r->OrdSize=typ_i;
3788  if (typ_i==0) r->typ=NULL;
3789  else
3790  {
3791    r->typ=(sro_ord*)omAlloc(typ_i*sizeof(sro_ord));
3792    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3793  }
3794  omFreeSize((ADDRESS)tmp_typ,(3*(n+r->N)*sizeof(sro_ord)));
3795
3796  // ----------------------------
3797  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3798  r->VarOffset=v;
3799
3800  // ----------------------------
3801  // other indicies
3802  r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
3803  i=0; // position
3804  j=0; // index in r->typ
3805  if (i==r->pCompIndex) i++; // IS???
3806  while ((j < r->OrdSize)
3807         && ((r->typ[j].ord_typ==ro_syzcomp) ||
3808             (r->typ[j].ord_typ==ro_syz) || (r->typ[j].ord_typ==ro_isTemp) || (r->typ[j].ord_typ==ro_is) ||
3809             (r->order[r->typ[j].order_index] == ringorder_aa)))
3810  {
3811    i++; j++;
3812  }
3813  // No use of j anymore!!!????
3814
3815  if (i==r->pCompIndex) i++;
3816  r->pOrdIndex=i; // How came it is "i" here???!!!! exp[r->pOrdIndex] is order of a poly... This may be wrong!!! IS
3817
3818  // ----------------------------
3819  rSetDegStuff(r);
3820  rSetOption(r);
3821  // ----------------------------
3822  // r->p_Setm
3823  r->p_Setm = p_GetSetmProc(r);
3824
3825  // ----------------------------
3826  // set VarL_*
3827  rSetVarL(r);
3828
3829  //  ----------------------------
3830  // right-adjust VarOffset
3831  rRightAdjustVarOffset(r);
3832
3833  // ----------------------------
3834  // set NegWeightL*
3835  rSetNegWeight(r);
3836
3837  // ----------------------------
3838  // p_Procs: call AFTER NegWeightL
3839  r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
3840  p_ProcsSet(r, r->p_Procs);
3841  return FALSE;
3842}
3843
3844static void rCheckOrdSgn(ring r,int i/*current block*/)
3845{ // set r->OrdSgn
3846  if ( r->OrdSgn==1)
3847  {
3848    int oo=-1;
3849    int jj;
3850    for(jj=i-1;jj>=0;jj--)
3851    {
3852      if(((r->order[jj]==ringorder_a)
3853        ||(r->order[jj]==ringorder_aa)
3854        ||(r->order[jj]==ringorder_a64))
3855      &&(r->block0[jj]<=r->block0[i])
3856      &&(r->block1[jj]>=r->block1[i]))
3857      { oo=1; break;}
3858    }
3859    r->OrdSgn=oo;
3860  }
3861}
3862
3863
3864void rUnComplete(ring r)
3865{
3866  if (r == NULL) return;
3867  if (r->VarOffset != NULL)
3868  {
3869    if (r->OrdSize!=0 && r->typ != NULL)
3870    {
3871      for(int i = 0; i < r->OrdSize; i++)
3872        if( r->typ[i].ord_typ == ro_is) // Search for suffixes! (prefix have the same VarOffset)
3873        {
3874          id_Delete(&r->typ[i].data.is.F, r);
3875          r->typ[i].data.is.F = NULL; // ?
3876
3877          if( r->typ[i].data.is.pVarOffset != NULL )
3878          {
3879            omFreeSize((ADDRESS)r->typ[i].data.is.pVarOffset, (r->N +1)*sizeof(int));
3880            r->typ[i].data.is.pVarOffset = NULL; // ?
3881          }
3882        }
3883        else if (r->typ[i].ord_typ == ro_syz)
3884        {
3885          if(r->typ[i].data.syz.limit > 0)
3886            omFreeSize(r->typ[i].data.syz.syz_index, ((r->typ[i].data.syz.limit) +1)*sizeof(int));
3887          r->typ[i].data.syz.syz_index = NULL;
3888        }
3889        else if (r->typ[i].ord_typ == ro_syzcomp)
3890        {
3891          assume( r->typ[i].data.syzcomp.ShiftedComponents == NULL );
3892          assume( r->typ[i].data.syzcomp.Components        == NULL );
3893//          WarnS( "rUnComplete : ord_typ == ro_syzcomp was unhandled!!! Possibly memory leak!!!"  );
3894#ifndef NDEBUG
3895//          assume(0);
3896#endif
3897        }
3898
3899      omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord)); r->typ = NULL;
3900    }
3901
3902    if (r->order != NULL)
3903    {
3904      // delete r->order!!!???
3905    }
3906
3907    if (r->PolyBin != NULL)
3908      omUnGetSpecBin(&(r->PolyBin));
3909
3910    omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3911
3912    if (r->ordsgn != NULL && r->CmpL_Size != 0)
3913      omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
3914    if (r->p_Procs != NULL)
3915      omFreeSize(r->p_Procs, sizeof(p_Procs_s));
3916    omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
3917  }
3918  if (r->NegWeightL_Offset!=NULL)
3919  {
3920    omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
3921    r->NegWeightL_Offset=NULL;
3922  }
3923}
3924
3925// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
3926static void rSetVarL(ring r)
3927{
3928  int  min = MAX_INT_VAL, min_j = -1;
3929  int* VarL_Number = (int*) omAlloc0(r->ExpL_Size*sizeof(int));
3930
3931  int i,j;
3932
3933  // count how often a var long is occupied by an exponent
3934  for (i=1; i<=r->N; i++)
3935  {
3936    VarL_Number[r->VarOffset[i] & 0xffffff]++;
3937  }
3938
3939  // determine how many and min
3940  for (i=0, j=0; i<r->ExpL_Size; i++)
3941  {
3942    if (VarL_Number[i] != 0)
3943    {
3944      if (min > VarL_Number[i])
3945      {
3946        min = VarL_Number[i];
3947        min_j = j;
3948      }
3949      j++;
3950    }
3951  }
3952
3953  r->VarL_Size = j; // number of long with exp. entries in
3954                    //  in p->exp
3955  r->VarL_Offset = (int*) omAlloc(r->VarL_Size*sizeof(int));
3956  r->VarL_LowIndex = 0;
3957
3958  // set VarL_Offset
3959  for (i=0, j=0; i<r->ExpL_Size; i++)
3960  {
3961    if (VarL_Number[i] != 0)
3962    {
3963      r->VarL_Offset[j] = i;
3964      if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
3965        r->VarL_LowIndex = -1;
3966      j++;
3967    }
3968  }
3969  if (r->VarL_LowIndex >= 0)
3970    r->VarL_LowIndex = r->VarL_Offset[0];
3971
3972  r->MinExpPerLong = min;
3973  if (min_j != 0)
3974  {
3975    j = r->VarL_Offset[min_j];
3976    r->VarL_Offset[min_j] = r->VarL_Offset[0];
3977    r->VarL_Offset[0] = j;
3978  }
3979  omFree(VarL_Number);
3980}
3981
3982static void rRightAdjustVarOffset(ring r)
3983{
3984  int* shifts = (int*) omAlloc(r->ExpL_Size*sizeof(int));
3985  int i;
3986  // initialize shifts
3987  for (i=0;i<r->ExpL_Size;i++)
3988    shifts[i] = BIT_SIZEOF_LONG;
3989
3990  // find minimal bit shift in each long exp entry
3991  for (i=1;i<=r->N;i++)
3992  {
3993    if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
3994      shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
3995  }
3996  // reset r->VarOffset: set the minimal shift to 0
3997  for (i=1;i<=r->N;i++)
3998  {
3999    if (shifts[r->VarOffset[i] & 0xffffff] != 0)
4000      r->VarOffset[i]
4001        = (r->VarOffset[i] & 0xffffff) |
4002        (((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
4003  }
4004  omFree(shifts);
4005}
4006
4007// get r->divmask depending on bits per exponent
4008static unsigned long rGetDivMask(int bits)
4009{
4010  unsigned long divmask = 1;
4011  int i = bits;
4012
4013  while (i < BIT_SIZEOF_LONG)
4014  {
4015    divmask |= (((unsigned long) 1) << (unsigned long) i);
4016    i += bits;
4017  }
4018  return divmask;
4019}
4020
4021#ifdef RDEBUG
4022void rDebugPrint(ring r)
4023{
4024  if (r==NULL)
4025  {
4026    PrintS("NULL ?\n");
4027    return;
4028  }
4029  // corresponds to ro_typ from ring.h:
4030  const char *TYP[]={"ro_dp","ro_wp","ro_am","ro_wp64","ro_wp_neg","ro_cp",
4031                     "ro_syzcomp", "ro_syz", "ro_isTemp", "ro_is", "ro_none"};
4032  int i,j;
4033
4034  Print("ExpL_Size:%d ",r->ExpL_Size);
4035  Print("CmpL_Size:%d ",r->CmpL_Size);
4036  Print("VarL_Size:%d\n",r->VarL_Size);
4037  Print("bitmask=0x%lx (expbound=%ld) \n",r->bitmask, r->bitmask);
4038  Print("divmask=%lx\n", r->divmask);
4039  Print("BitsPerExp=%d ExpPerLong=%d MinExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->MinExpPerLong, r->VarL_Offset[0]);
4040
4041  Print("VarL_LowIndex: %d\n", r->VarL_LowIndex);
4042  PrintS("VarL_Offset:\n");
4043  if (r->VarL_Offset==NULL) PrintS(" NULL");
4044  else
4045    for(j = 0; j < r->VarL_Size; j++)
4046      Print("  VarL_Offset[%d]: %d ", j, r->VarL_Offset[j]);
4047  PrintLn();
4048
4049
4050  PrintS("VarOffset:\n");
4051  if (r->VarOffset==NULL) PrintS(" NULL\n");
4052  else
4053    for(j=0;j<=r->N;j++)
4054      Print("  v%d at e-pos %d, bit %d\n",
4055            j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
4056  PrintS("ordsgn:\n");
4057  for(j=0;j<r->CmpL_Size;j++)
4058    Print("  ordsgn %ld at pos %d\n",r->ordsgn[j],j);
4059  Print("OrdSgn:%d\n",r->OrdSgn);
4060  PrintS("ordrec:\n");
4061  for(j=0;j<r->OrdSize;j++)
4062  {
4063    Print("  typ %s", TYP[r->typ[j].ord_typ]);
4064    if (r->typ[j].ord_typ==ro_syz)
4065    {
4066      const short place = r->typ[j].data.syz.place;
4067      const int limit = r->typ[j].data.syz.limit;
4068      const int curr_index = r->typ[j].data.syz.curr_index;
4069      const int* syz_index = r->typ[j].data.syz.syz_index;
4070
4071      Print("  limit %d (place: %d, curr_index: %d), syz_index: ", limit, place, curr_index);
4072
4073      if( syz_index == NULL )
4074        PrintS("(NULL)");
4075      else
4076      {
4077        Print("{");
4078        for( i=0; i <= limit; i++ )
4079          Print("%d ", syz_index[i]);
4080        Print("}");
4081      }
4082
4083    }
4084    else if (r->typ[j].ord_typ==ro_isTemp)
4085    {
4086      Print("  start (level) %d, suffixpos: %d, VO: ",r->typ[j].data.isTemp.start, r->typ[j].data.isTemp.suffixpos);
4087
4088    }
4089    else if (r->typ[j].ord_typ==ro_is)
4090    {
4091      Print("  start %d, end: %d: ",r->typ[j].data.is.start, r->typ[j].data.is.end);
4092
4093//      for( int k = 0; k <= r->N; k++) if (r->typ[j].data.is.pVarOffset[k] != -1) Print("[%2d]: %04x; ", k, r->typ[j].data.is.pVarOffset[k]);
4094
4095      Print("  limit %d",r->typ[j].data.is.limit);
4096#ifndef NDEBUG
4097      //PrintS("  F: ");idShow(r->typ[j].data.is.F, r, r, 1);
4098#endif
4099
4100      PrintLn();
4101    }
4102    else if  (r->typ[j].ord_typ==ro_am)
4103    {
4104      Print("  place %d",r->typ[j].data.am.place);
4105      Print("  start %d",r->typ[j].data.am.start);
4106      Print("  end %d",r->typ[j].data.am.end);
4107      Print("  len_gen %d",r->typ[j].data.am.len_gen);
4108      PrintS(" w:");
4109      int l=0;
4110      for(l=r->typ[j].data.am.start;l<=r->typ[j].data.am.end;l++)
4111            Print(" %d",r->typ[j].data.am.weights[l-r->typ[j].data.am.start]);
4112      l=r->typ[j].data.am.end+1;
4113      int ll=r->typ[j].data.am.weights[l-r->typ[j].data.am.start];
4114      PrintS(" m:");
4115      for(int lll=l+1;lll<l+ll+1;lll++)
4116            Print(" %d",r->typ[j].data.am.weights[lll-r->typ[j].data.am.start]);
4117    }
4118    else
4119    {
4120      Print("  place %d",r->typ[j].data.dp.place);
4121
4122      if (r->typ[j].ord_typ!=ro_syzcomp  && r->typ[j].ord_typ!=ro_syz)
4123      {
4124        Print("  start %d",r->typ[j].data.dp.start);
4125        Print("  end %d",r->typ[j].data.dp.end);
4126        if ((r->typ[j].ord_typ==ro_wp)
4127        || (r->typ[j].ord_typ==ro_wp_neg))
4128        {
4129          PrintS(" w:");
4130          for(int l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
4131            Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
4132        }
4133        else if (r->typ[j].ord_typ==ro_wp64)
4134        {
4135          PrintS(" w64:");
4136          int l;
4137          for(l=r->typ[j].data.wp64.start;l<=r->typ[j].data.wp64.end;l++)
4138            Print(" %ld",(long)(((int64*)r->typ[j].data.wp64.weights64)+l-r->typ[j].data.wp64.start));
4139          }
4140        }
4141    }
4142    PrintLn();
4143  }
4144  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
4145  Print("OrdSize:%d\n",r->OrdSize);
4146  PrintS("--------------------\n");
4147  for(j=0;j<r->ExpL_Size;j++)
4148  {
4149    Print("L[%d]: ",j);
4150    if (j< r->CmpL_Size)
4151      Print("ordsgn %ld ", r->ordsgn[j]);
4152    else
4153      PrintS("no comp ");
4154    i=1;
4155    for(;i<=r->N;i++)
4156    {
4157      if( (r->VarOffset[i] & 0xffffff) == j )
4158      {  Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
4159                                         r->VarOffset[i] >>24 ); }
4160    }
4161    if( r->pCompIndex==j ) PrintS("v0; ");
4162    for(i=0;i<r->OrdSize;i++)
4163    {
4164      if (r->typ[i].data.dp.place == j)
4165      {
4166        Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
4167          r->typ[i].data.dp.start, r->typ[i].data.dp.end);
4168      }
4169    }
4170
4171    if (j==r->pOrdIndex)
4172      PrintS("pOrdIndex\n");
4173    else
4174      PrintLn();
4175  }
4176  Print("LexOrder:%d, MixedOrder:%d\n",r->LexOrder, r->MixedOrder);
4177
4178  Print("NegWeightL_Size: %d, NegWeightL_Offset: ", r->NegWeightL_Size);
4179  if (r->NegWeightL_Offset==NULL) PrintS(" NULL");
4180  else
4181    for(j = 0; j < r->NegWeightL_Size; j++)
4182      Print("  [%d]: %d ", j, r->NegWeightL_Offset[j]);
4183  PrintLn();
4184
4185  // p_Procs stuff
4186  p_Procs_s proc_names;
4187  const char* field;
4188  const char* length;
4189  const char* ord;
4190  p_Debug_GetProcNames(r, &proc_names); // changes p_Procs!!!
4191  p_Debug_GetSpecNames(r, field, length, ord);
4192
4193  Print("p_Spec  : %s, %s, %s\n", field, length, ord);
4194  PrintS("p_Procs :\n");
4195  for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
4196  {
4197    Print(" %s,\n", ((char**) &proc_names)[i]);
4198  }
4199
4200  {
4201      PrintLn();
4202      Print("pFDeg   : ");
4203#define pFDeg_CASE(A) if(r->pFDeg == A) PrintS( "" #A "" )
4204      pFDeg_CASE(p_Totaldegree); else
4205      pFDeg_CASE(p_WFirstTotalDegree); else
4206      pFDeg_CASE(p_WTotaldegree); else
4207      pFDeg_CASE(p_Deg); else
4208#undef pFDeg_CASE
4209      Print("(%p)", r->pFDeg); // default case
4210
4211    PrintLn();
4212    Print("pLDeg   : (%p)", r->pLDeg);
4213    PrintLn();
4214  }
4215  Print("pSetm:");
4216  void p_Setm_Dummy(poly p, const ring r);
4217  void p_Setm_TotalDegree(poly p, const ring r);
4218  void p_Setm_WFirstTotalDegree(poly p, const ring r);
4219  void p_Setm_General(poly p, const ring r);
4220  if (r->p_Setm==p_Setm_General) PrintS("p_Setm_General\n");
4221  else if (r->p_Setm==p_Setm_Dummy) PrintS("p_Setm_Dummy\n");
4222  else if (r->p_Setm==p_Setm_TotalDegree) PrintS("p_Setm_Totaldegree\n");
4223  else if (r->p_Setm==p_Setm_WFirstTotalDegree) PrintS("p_Setm_WFirstTotalDegree\n");
4224  else Print("%p\n",r->p_Setm);
4225}
4226
4227void p_DebugPrint(poly p, const ring r)
4228{
4229  int i,j;
4230  p_Write(p,r);
4231  j=2;
4232  while(p!=NULL)
4233  {
4234    Print("\nexp[0..%d]\n",r->ExpL_Size-1);
4235    for(i=0;i<r->ExpL_Size;i++)
4236      Print("%ld ",p->exp[i]);
4237    PrintLn();
4238    Print("v0:%ld ",p_GetComp(p, r));
4239    for(i=1;i<=r->N;i++) Print(" v%d:%ld",i,p_GetExp(p,i, r));
4240    PrintLn();
4241    pIter(p);
4242    j--;
4243    if (j==0) { PrintS("...\n"); break; }
4244  }
4245}
4246
4247#endif // RDEBUG
4248
4249/// debug-print monomial poly/vector p, assuming that it lives in the ring R
4250static inline void m_DebugPrint(const poly p, const ring R)
4251{
4252  Print("\nexp[0..%d]\n", R->ExpL_Size - 1);
4253  for(int i = 0; i < R->ExpL_Size; i++)
4254    Print("%09lx ", p->exp[i]);
4255  PrintLn();
4256  Print("v0:%9ld ", p_GetComp(p, R));
4257  for(int i = 1; i <= R->N; i++) Print(" v%d:%5ld",i, p_GetExp(p, i, R));
4258  PrintLn();
4259}
4260
4261
4262#ifndef NDEBUG
4263/// debug-print at most nTerms (2 by default) terms from poly/vector p,
4264/// assuming that lt(p) lives in lmRing and tail(p) lives in tailRing.
4265void p_DebugPrint(const poly p, const ring lmRing, const ring tailRing, const int nTerms)
4266{
4267  assume( nTerms >= 0 );
4268  if( p != NULL )
4269  {
4270    assume( p != NULL );
4271
4272    p_Write(p, lmRing, tailRing);
4273
4274    if( (p != NULL) && (nTerms > 0) )
4275    {
4276      assume( p != NULL );
4277      assume( nTerms > 0 );
4278
4279      // debug pring leading term
4280      m_DebugPrint(p, lmRing);
4281
4282      poly q = pNext(p); // q = tail(p)
4283
4284      // debug pring tail (at most nTerms-1 terms from it)
4285      for(int j = nTerms - 1; (q !=NULL) && (j > 0); pIter(q), --j)
4286        m_DebugPrint(q, tailRing);
4287
4288      if (q != NULL)
4289        PrintS("...\n");
4290    }
4291  }
4292  else
4293    PrintS("0\n");
4294}
4295#endif
4296
4297
4298//    F = system("ISUpdateComponents", F, V, MIN );
4299//    // replace gen(i) -> gen(MIN + V[i-MIN]) for all i > MIN in all terms from F!
4300void pISUpdateComponents(ideal F, const intvec *const V, const int MIN, const ring r )
4301{
4302  assume( V != NULL );
4303  assume( MIN >= 0 );
4304
4305  if( F == NULL )
4306    return;
4307
4308  for( int j = (F->ncols*F->nrows) - 1; j >= 0; j-- )
4309  {
4310#ifdef PDEBUG
4311    Print("F[%d]:", j);
4312    p_DebugPrint(F->m[j], r, r, 0);
4313#endif
4314
4315    for( poly p = F->m[j]; p != NULL; pIter(p) )
4316    {
4317      int c = p_GetComp(p, r);
4318
4319      if( c > MIN )
4320      {
4321#ifdef PDEBUG
4322        Print("gen[%d] -> gen(%d)\n", c, MIN + (*V)[ c - MIN - 1 ]);
4323#endif
4324
4325        p_SetComp( p, MIN + (*V)[ c - MIN - 1 ], r );
4326      }
4327    }
4328#ifdef PDEBUG
4329    Print("new F[%d]:", j);
4330    p_Test(F->m[j], r);
4331    p_DebugPrint(F->m[j], r, r, 0);
4332#endif
4333  }
4334
4335}
4336
4337
4338
4339
4340/*2
4341* asssume that rComplete was called with r
4342* assume that the first block ist ringorder_S
4343* change the block to reflect the sequence given by appending v
4344*/
4345static inline void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
4346{
4347  assume(r->typ[1].ord_typ == ro_syzcomp);
4348
4349  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
4350  r->typ[1].data.syzcomp.Components = currComponents;
4351}
4352
4353static inline void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
4354{
4355  assume(r->typ[1].ord_typ == ro_syzcomp);
4356
4357  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
4358  *currComponents =   r->typ[1].data.syzcomp.Components;
4359}
4360#ifdef PDEBUG
4361static inline void rDBChangeSComps(int* currComponents,
4362                     long* currShiftedComponents,
4363                     int length,
4364                     ring r)
4365{
4366  assume(r->typ[1].ord_typ == ro_syzcomp);
4367
4368  r->typ[1].data.syzcomp.length = length;
4369  rNChangeSComps( currComponents, currShiftedComponents, r);
4370}
4371static inline void rDBGetSComps(int** currComponents,
4372                 long** currShiftedComponents,
4373                 int *length,
4374                 ring r)
4375{
4376  assume(r->typ[1].ord_typ == ro_syzcomp);
4377
4378  *length = r->typ[1].data.syzcomp.length;
4379  rNGetSComps( currComponents, currShiftedComponents, r);
4380}
4381#endif
4382
4383void rChangeSComps(int* currComponents, long* currShiftedComponents, int length, ring r)
4384{
4385#ifdef PDEBUG
4386   rDBChangeSComps(currComponents, currShiftedComponents, length, r);
4387#else
4388   rNChangeSComps(currComponents, currShiftedComponents, r);
4389#endif
4390}
4391
4392void rGetSComps(int** currComponents, long** currShiftedComponents, int *length, ring r)
4393{
4394#ifdef PDEBUG
4395   rDBGetSComps(currComponents, currShiftedComponents, length, r);
4396#else
4397   rNGetSComps(currComponents, currShiftedComponents, r);
4398#endif
4399}
4400
4401
4402/////////////////////////////////////////////////////////////////////////////
4403//
4404// The following routines all take as input a ring r, and return R
4405// where R has a certain property. R might be equal r in which case r
4406// had already this property
4407//
4408ring rAssure_SyzComp(const ring r, BOOLEAN complete)
4409{
4410  if ( r->order[0] == ringorder_s ) return r;
4411
4412  if ( r->order[0] == ringorder_IS )
4413  {
4414#ifndef NDEBUG
4415    WarnS("rAssure_SyzComp: input ring has an IS-ordering!");
4416#endif
4417//    return r;
4418  }
4419  ring res=rCopy0(r, FALSE, FALSE);
4420  int i=rBlocks(r);
4421  int j;
4422
4423  res->order=(int *)omAlloc((i+1)*sizeof(int));
4424  res->block0=(int *)omAlloc0((i+1)*sizeof(int));
4425  res->block1=(int *)omAlloc0((i+1)*sizeof(int));
4426  int ** wvhdl =(int **)omAlloc0((i+1)*sizeof(int**));
4427  for(j=i;j>0;j--)
4428  {
4429    res->order[j]=r->order[j-1];
4430    res->block0[j]=r->block0[j-1];
4431    res->block1[j]=r->block1[j-1];
4432    if (r->wvhdl[j-1] != NULL)
4433    {
4434      wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
4435    }
4436  }
4437  res->order[0]=ringorder_s;
4438
4439  res->wvhdl = wvhdl;
4440
4441  if (complete)
4442  {
4443    rComplete(res, 1);
4444
4445#ifdef HAVE_PLURAL
4446    if (rIsPluralRing(r))
4447    {
4448      if ( nc_rComplete(r, res, false) ) // no qideal!
4449      {
4450#ifndef NDEBUG
4451        WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4452#endif
4453      }
4454    }
4455    assume(rIsPluralRing(r) == rIsPluralRing(res));
4456#endif
4457
4458
4459#ifdef HAVE_PLURAL
4460    ring old_ring = r;
4461#endif
4462
4463    if (r->qideal!=NULL)
4464    {
4465      res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4466
4467      assume(id_RankFreeModule(res->qideal, res) == 0);
4468
4469#ifdef HAVE_PLURAL
4470      if( rIsPluralRing(res) )
4471        if( nc_SetupQuotient(res, r, true) )
4472        {
4473//          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4474        }
4475
4476#endif
4477      assume(id_RankFreeModule(res->qideal, res) == 0);
4478    }
4479
4480#ifdef HAVE_PLURAL
4481    assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4482    assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4483    assume(rIsSCA(res) == rIsSCA(old_ring));
4484    assume(ncRingType(res) == ncRingType(old_ring));
4485#endif
4486  }
4487
4488  return res;
4489}
4490
4491ring rAssure_TDeg(ring r, int start_var, int end_var, int &pos)
4492{
4493  int i;
4494  if (r->typ!=NULL)
4495  {
4496    for(i=r->OrdSize-1;i>=0;i--)
4497    {
4498      if ((r->typ[i].ord_typ==ro_dp)
4499      && (r->typ[i].data.dp.start==start_var)
4500      && (r->typ[i].data.dp.end==end_var))
4501      {
4502        pos=r->typ[i].data.dp.place;
4503        //printf("no change, pos=%d\n",pos);
4504        return r;
4505      }
4506    }
4507  }
4508
4509#ifdef HAVE_PLURAL
4510  nc_struct* save=r->GetNC();
4511  r->GetNC()=NULL;
4512#endif
4513  ring res=rCopy(r);
4514
4515  i=rBlocks(r);
4516  int j;
4517
4518  res->ExpL_Size=r->ExpL_Size+1; // one word more in each monom
4519  res->PolyBin=omGetSpecBin(POLYSIZE + (res->ExpL_Size)*sizeof(long));
4520  omFree((ADDRESS)res->ordsgn);
4521  res->ordsgn=(long *)omAlloc0(res->ExpL_Size*sizeof(long));
4522  for(j=0;j<r->CmpL_Size;j++)
4523  {
4524    res->ordsgn[j] = r->ordsgn[j];
4525  }
4526  res->OrdSize=r->OrdSize+1;   // one block more for pSetm
4527  if (r->typ!=NULL)
4528    omFree((ADDRESS)res->typ);
4529  res->typ=(sro_ord*)omAlloc0(res->OrdSize*sizeof(sro_ord));
4530  if (r->typ!=NULL)
4531    memcpy(res->typ,r->typ,r->OrdSize*sizeof(sro_ord));
4532  // the additional block for pSetm: total degree at the last word
4533  // but not included in the compare part
4534  res->typ[res->OrdSize-1].ord_typ=ro_dp;
4535  res->typ[res->OrdSize-1].data.dp.start=start_var;
4536  res->typ[res->OrdSize-1].data.dp.end=end_var;
4537  res->typ[res->OrdSize-1].data.dp.place=res->ExpL_Size-1;
4538  pos=res->ExpL_Size-1;
4539  //if ((start_var==1) && (end_var==res->N)) res->pOrdIndex=pos;
4540  extern void p_Setm_General(poly p, ring r);
4541  res->p_Setm=p_Setm_General;
4542  // ----------------------------
4543  omFree((ADDRESS)res->p_Procs);
4544  res->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
4545
4546  p_ProcsSet(res, res->p_Procs);
4547  if (res->qideal!=NULL) id_Delete(&res->qideal,res);
4548#ifdef HAVE_PLURAL
4549  r->GetNC()=save;
4550  if (rIsPluralRing(r))
4551  {
4552    if ( nc_rComplete(r, res, false) ) // no qideal!
4553    {
4554#ifndef NDEBUG
4555      WarnS("error in nc_rComplete");
4556#endif
4557      // just go on..
4558    }
4559  }
4560#endif
4561  if (r->qideal!=NULL)
4562  {
4563     res->qideal=idrCopyR_NoSort(r->qideal,r, res);
4564#ifdef HAVE_PLURAL
4565     if (rIsPluralRing(res))
4566     {
4567//       nc_SetupQuotient(res, currRing);
4568       nc_SetupQuotient(res, r); // ?
4569     }
4570     assume((res->qideal==NULL) == (r->qideal==NULL));
4571#endif
4572  }
4573
4574#ifdef HAVE_PLURAL
4575  assume(rIsPluralRing(res) == rIsPluralRing(r));
4576  assume(rIsSCA(res) == rIsSCA(r));
4577  assume(ncRingType(res) == ncRingType(r));
4578#endif
4579
4580  return res;
4581}
4582
4583ring rAssure_HasComp(const ring r)
4584{
4585  int last_block;
4586  int i=0;
4587  do
4588  {
4589     if (r->order[i] == ringorder_c ||
4590        r->order[i] == ringorder_C) return r;
4591     if (r->order[i] == 0)
4592        break;
4593     i++;
4594  } while (1);
4595  //WarnS("re-creating ring with comps");
4596  last_block=i-1;
4597
4598  ring new_r = rCopy0(r, FALSE, FALSE);
4599  i+=2;
4600  new_r->wvhdl=(int **)omAlloc0(i * sizeof(int *));
4601  new_r->order   = (int *) omAlloc0(i * sizeof(int));
4602  new_r->block0   = (int *) omAlloc0(i * sizeof(int));
4603  new_r->block1   = (int *) omAlloc0(i * sizeof(int));
4604  memcpy(new_r->order,r->order,(i-1) * sizeof(int));
4605  memcpy(new_r->block0,r->block0,(i-1) * sizeof(int));
4606  memcpy(new_r->block1,r->block1,(i-1) * sizeof(int));
4607  for (int j=0; j<=last_block; j++)
4608  {
4609    if (r->wvhdl[j]!=NULL)
4610    {
4611      new_r->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
4612    }
4613  }
4614  last_block++;
4615  new_r->order[last_block]=ringorder_C;
4616  //new_r->block0[last_block]=0;
4617  //new_r->block1[last_block]=0;
4618  //new_r->wvhdl[last_block]=NULL;
4619
4620  rComplete(new_r, 1);
4621
4622#ifdef HAVE_PLURAL
4623  if (rIsPluralRing(r))
4624  {
4625    if ( nc_rComplete(r, new_r, false) ) // no qideal!
4626    {
4627#ifndef NDEBUG
4628      WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4629#endif
4630    }
4631  }
4632  assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4633#endif
4634
4635  return new_r;
4636}
4637
4638ring rAssure_CompLastBlock(ring r, BOOLEAN complete)
4639{
4640  int last_block = rBlocks(r) - 2;
4641  if (r->order[last_block] != ringorder_c &&
4642      r->order[last_block] != ringorder_C)
4643  {
4644    int c_pos = 0;
4645    int i;
4646
4647    for (i=0; i< last_block; i++)
4648    {
4649      if (r->order[i] == ringorder_c || r->order[i] == ringorder_C)
4650      {
4651        c_pos = i;
4652        break;
4653      }
4654    }
4655    if (c_pos != -1)
4656    {
4657      ring new_r = rCopy0(r, FALSE, TRUE);
4658      for (i=c_pos+1; i<=last_block; i++)
4659      {
4660        new_r->order[i-1] = new_r->order[i];
4661        new_r->block0[i-1] = new_r->block0[i];
4662        new_r->block1[i-1] = new_r->block1[i];
4663        new_r->wvhdl[i-1] = new_r->wvhdl[i];
4664      }
4665      new_r->order[last_block] = r->order[c_pos];
4666      new_r->block0[last_block] = r->block0[c_pos];
4667      new_r->block1[last_block] = r->block1[c_pos];
4668      new_r->wvhdl[last_block] = r->wvhdl[c_pos];
4669      if (complete)
4670      {
4671        rComplete(new_r, 1);
4672
4673#ifdef HAVE_PLURAL
4674        if (rIsPluralRing(r))
4675        {
4676          if ( nc_rComplete(r, new_r, false) ) // no qideal!
4677          {
4678#ifndef NDEBUG
4679            WarnS("error in nc_rComplete");   // cleanup?//      rDelete(res);//      return r;      // just go on..
4680#endif
4681          }
4682        }
4683        assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4684#endif
4685      }
4686      return new_r;
4687    }
4688  }
4689  return r;
4690}
4691
4692// Moves _c or _C ordering to the last place AND adds _s on the 1st place
4693ring rAssure_SyzComp_CompLastBlock(const ring r, BOOLEAN)
4694{
4695  rTest(r);
4696
4697  ring new_r_1 = rAssure_CompLastBlock(r, FALSE); // due to this FALSE - no completion!
4698  ring new_r = rAssure_SyzComp(new_r_1, FALSE); // new_r_1 is used only here!!!
4699
4700  if (new_r == r)
4701     return r;
4702
4703  ring old_r = r;
4704  if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
4705
4706   rComplete(new_r, 1);
4707#ifdef HAVE_PLURAL
4708   if (rIsPluralRing(old_r))
4709   {
4710       if ( nc_rComplete(old_r, new_r, false) ) // no qideal!
4711       {
4712# ifndef NDEBUG
4713          WarnS("error in nc_rComplete"); // cleanup?      rDelete(res);       return r;  // just go on...?
4714# endif
4715       }
4716   }
4717#endif
4718
4719///?    rChangeCurrRing(new_r);
4720   if (old_r->qideal != NULL)
4721   {
4722      new_r->qideal = idrCopyR(old_r->qideal, old_r, new_r);
4723      //currQuotient = new_r->qideal;
4724   }
4725
4726#ifdef HAVE_PLURAL
4727   if( rIsPluralRing(old_r) )
4728     if( nc_SetupQuotient(new_r, old_r, true) )
4729       {
4730#ifndef NDEBUG
4731          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4732#endif
4733       }
4734#endif
4735
4736#ifdef HAVE_PLURAL
4737   assume((new_r->qideal==NULL) == (old_r->qideal==NULL));
4738   assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4739   assume(rIsSCA(new_r) == rIsSCA(old_r));
4740   assume(ncRingType(new_r) == ncRingType(old_r));
4741#endif
4742
4743   rTest(new_r);
4744   rTest(old_r);
4745   return new_r;
4746}
4747
4748// use this for global orderings consisting of two blocks
4749static ring rAssure_Global(rRingOrder_t b1, rRingOrder_t b2, const ring r)
4750{
4751  int r_blocks = rBlocks(r);
4752
4753  assume(b1 == ringorder_c || b1 == ringorder_C ||
4754         b2 == ringorder_c || b2 == ringorder_C ||
4755         b2 == ringorder_S);
4756  if ((r_blocks == 3) &&
4757      (r->order[0] == b1) &&
4758      (r->order[1] == b2) &&
4759      (r->order[2] == 0))
4760    return r;
4761  ring res = rCopy0(r, TRUE, FALSE);
4762  res->order = (int*)omAlloc0(3*sizeof(int));
4763  res->block0 = (int*)omAlloc0(3*sizeof(int));
4764  res->block1 = (int*)omAlloc0(3*sizeof(int));
4765  res->wvhdl = (int**)omAlloc0(3*sizeof(int*));
4766  res->order[0] = b1;
4767  res->order[1] = b2;
4768  if (b1 == ringorder_c || b1 == ringorder_C)
4769  {
4770    res->block0[1] = 1;
4771    res->block1[1] = r->N;
4772  }
4773  else
4774  {
4775    res->block0[0] = 1;
4776    res->block1[0] = r->N;
4777  }
4778  // HANNES: This sould be set in rComplete
4779  res->OrdSgn = 1;
4780  rComplete(res, 1);
4781#ifdef HAVE_PLURAL
4782  if (rIsPluralRing(r))
4783  {
4784    if ( nc_rComplete(r, res, false) ) // no qideal!
4785    {
4786#ifndef NDEBUG
4787      WarnS("error in nc_rComplete");
4788#endif
4789    }
4790  }
4791#endif
4792//  rChangeCurrRing(res);
4793  return res;
4794}
4795
4796ring rAssure_InducedSchreyerOrdering(const ring r, BOOLEAN complete = TRUE, int sgn = 1)
4797{ // TODO: ???? Add leading Syz-comp ordering here...????
4798
4799#if MYTEST
4800    Print("rAssure_InducedSchreyerOrdering(r, complete = %d, sgn = %d): r: \n", complete, sgn);
4801    rWrite(r);
4802#ifdef RDEBUG
4803    rDebugPrint(r);
4804#endif
4805    PrintLn();
4806#endif
4807  assume((sgn == 1) || (sgn == -1));
4808
4809  ring res=rCopy0(r, FALSE, FALSE); // No qideal & ordering copy.
4810
4811  int n = rBlocks(r); // Including trailing zero!
4812
4813  // Create 2 more blocks for prefix/suffix:
4814  res->order=(int *)omAlloc0((n+2)*sizeof(int)); // 0  ..  n+1
4815  res->block0=(int *)omAlloc0((n+2)*sizeof(int));
4816  res->block1=(int *)omAlloc0((n+2)*sizeof(int));
4817  int ** wvhdl =(int **)omAlloc0((n+2)*sizeof(int**));
4818
4819  // Encapsulate all existing blocks between induced Schreyer ordering markers: prefix and suffix!
4820  // Note that prefix and suffix have the same ringorder marker and only differ in block[] parameters!
4821
4822  // new 1st block
4823  int j = 0;
4824  res->order[j] = ringorder_IS; // Prefix
4825  res->block0[j] = res->block1[j] = 0;
4826  // wvhdl[j] = NULL;
4827  j++;
4828
4829  for(int i = 0; (i <= n) && (r->order[i] != 0); i++, j++) // i = [0 .. n-1] <- non-zero old blocks
4830  {
4831    res->order [j] = r->order [i];
4832    res->block0[j] = r->block0[i];
4833    res->block1[j] = r->block1[i];
4834
4835    if (r->wvhdl[i] != NULL)
4836    {
4837      wvhdl[j] = (int*) omMemDup(r->wvhdl[i]);
4838    } // else wvhdl[j] = NULL;
4839  }
4840
4841  // new last block
4842  res->order [j] = ringorder_IS; // Suffix
4843  res->block0[j] = res->block1[j] = sgn; // Sign of v[o]: 1 for C, -1 for c
4844  // wvhdl[j] = NULL;
4845  j++;
4846
4847  // res->order [j] = 0; // The End!
4848  res->wvhdl = wvhdl;
4849
4850  // j == the last zero block now!
4851  assume(j == (n+1));
4852  assume(res->order[0]==ringorder_IS);
4853  assume(res->order[j-1]==ringorder_IS);
4854  assume(res->order[j]==0);
4855
4856
4857  if (complete)
4858  {
4859    rComplete(res, 1);
4860
4861#ifdef HAVE_PLURAL
4862    if (rIsPluralRing(r))
4863    {
4864      if ( nc_rComplete(r, res, false) ) // no qideal!
4865      {
4866#ifndef NDEBUG
4867        WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4868#endif
4869      }
4870    }
4871    assume(rIsPluralRing(r) == rIsPluralRing(res));
4872#endif
4873
4874
4875#ifdef HAVE_PLURAL
4876    ring old_ring = r;
4877#endif
4878
4879    if (r->qideal!=NULL)
4880    {
4881      res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4882
4883      assume(id_RankFreeModule(res->qideal, res) == 0);
4884
4885#ifdef HAVE_PLURAL
4886      if( rIsPluralRing(res) )
4887        if( nc_SetupQuotient(res, r, true) )
4888        {
4889//          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4890        }
4891
4892#endif
4893      assume(id_RankFreeModule(res->qideal, res) == 0);
4894    }
4895
4896#ifdef HAVE_PLURAL
4897    assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4898    assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4899    assume(rIsSCA(res) == rIsSCA(old_ring));
4900    assume(ncRingType(res) == ncRingType(old_ring));
4901#endif
4902  }
4903
4904  return res;
4905}
4906
4907ring rAssure_dp_S(const ring r)
4908{
4909  return rAssure_Global(ringorder_dp, ringorder_S, r);
4910}
4911
4912ring rAssure_dp_C(const ring r)
4913{
4914  return rAssure_Global(ringorder_dp, ringorder_C, r);
4915}
4916
4917ring rAssure_C_dp(const ring r)
4918{
4919  return rAssure_Global(ringorder_C, ringorder_dp, r);
4920}
4921
4922
4923
4924/// Finds p^th IS ordering, and returns its position in r->typ[]
4925/// returns -1 if something went wrong!
4926/// p - starts with 0!
4927int rGetISPos(const int p, const ring r)
4928{
4929  // Put the reference set F into the ring -ordering -recor
4930#if MYTEST
4931  Print("rIsIS(p: %d)\nF:", p);
4932  PrintLn();
4933#endif
4934
4935  if (r->typ==NULL)
4936  {
4937//    dReportError("'rIsIS:' Error: wrong ring! (typ == NULL)");
4938    return -1;
4939  }
4940
4941  int j = p; // Which IS record to use...
4942  for( int pos = 0; pos < r->OrdSize; pos++ )
4943    if( r->typ[pos].ord_typ == ro_is)
4944      if( j-- == 0 )
4945        return pos;
4946
4947  return -1;
4948}
4949
4950
4951
4952
4953
4954
4955/// Changes r by setting induced ordering parameters: limit and reference leading terms
4956/// F belong to r, we will DO a copy!
4957/// We will use it AS IS!
4958/// returns true is everything was allright!
4959BOOLEAN rSetISReference(const ring r, const ideal F, const int i, const int p)
4960{
4961  // Put the reference set F into the ring -ordering -recor
4962
4963  if (r->typ==NULL)
4964  {
4965    dReportError("Error: WRONG USE of rSetISReference: wrong ring! (typ == NULL)");
4966    return FALSE;
4967  }
4968
4969
4970  int pos = rGetISPos(p, r);
4971
4972  if( pos == -1 )
4973  {
4974    dReportError("Error: WRONG USE of rSetISReference: specified ordering block was not found!!!" );
4975    return FALSE;
4976  }
4977
4978#if MYTEST
4979  if( i != r->typ[pos].data.is.limit )
4980    Print("Changing record on pos: %d\nOld limit: %d --->> New Limit: %d\n", pos, r->typ[pos].data.is.limit, i);
4981#endif
4982
4983  const ideal FF = idrHeadR(F, r, r); // id_Copy(F, r); // ???
4984
4985
4986  if( r->typ[pos].data.is.F != NULL)
4987  {
4988#if MYTEST
4989    PrintS("Deleting old reference set F... \n");        // idShow(r->typ[pos].data.is.F, r);         PrintLn();
4990#endif
4991    id_Delete(&r->typ[pos].data.is.F, r);
4992    r->typ[pos].data.is.F = NULL;
4993  }
4994
4995  assume(r->typ[pos].data.is.F == NULL);
4996
4997  r->typ[pos].data.is.F = FF; // F is owened by ring now! TODO: delete at the end!
4998
4999  r->typ[pos].data.is.limit = i; // First induced component
5000
5001#if MYTEST
5002  PrintS("New reference set FF : \n");        idShow(FF, r, r, 1);         PrintLn();
5003#endif
5004
5005  return TRUE;
5006}
5007
5008#ifdef PDEBUG
5009int pDBsyzComp=0;
5010#endif
5011
5012
5013void rSetSyzComp(int k, const ring r)
5014{
5015  if(k < 0)
5016  {
5017    dReportError("rSetSyzComp with negative limit!");
5018    return;
5019  }
5020
5021  assume( k >= 0 );
5022  if (TEST_OPT_PROT) Print("{%d}", k);
5023  if ((r->typ!=NULL) && (r->typ[0].ord_typ==ro_syz))
5024  {
5025    if( k == r->typ[0].data.syz.limit )
5026      return; // nothing to do
5027
5028    int i;
5029    if (r->typ[0].data.syz.limit == 0)
5030    {
5031      r->typ[0].data.syz.syz_index = (int*) omAlloc0((k+1)*sizeof(int));
5032      r->typ[0].data.syz.syz_index[0] = 0;
5033      r->typ[0].data.syz.curr_index = 1;
5034    }
5035    else
5036    {
5037      r->typ[0].data.syz.syz_index = (int*)
5038        omReallocSize(r->typ[0].data.syz.syz_index,
5039                (r->typ[0].data.syz.limit+1)*sizeof(int),
5040                (k+1)*sizeof(int));
5041    }
5042    for (i=r->typ[0].data.syz.limit + 1; i<= k; i++)
5043    {
5044      r->typ[0].data.syz.syz_index[i] =
5045        r->typ[0].data.syz.curr_index;
5046    }
5047    if(k < r->typ[0].data.syz.limit) // ?
5048    {
5049#ifndef NDEBUG
5050      Warn("rSetSyzComp called with smaller limit (%d) as before (%d)", k, r->typ[0].data.syz.limit);
5051#endif
5052      r->typ[0].data.syz.curr_index = 1 + r->typ[0].data.syz.syz_index[k];
5053    }
5054
5055
5056    r->typ[0].data.syz.limit = k;
5057    r->typ[0].data.syz.curr_index++;
5058  }
5059  else if(
5060            (r->typ!=NULL) &&
5061            (r->typ[0].ord_typ==ro_isTemp)
5062           )
5063  {
5064//      (r->typ[currRing->typ[0].data.isTemp.suffixpos].data.is.limit == k)
5065#ifndef NDEBUG
5066    Warn("rSetSyzComp(%d) in an IS ring! Be careful!", k);
5067#endif
5068  }
5069  else
5070  if ((r->order[0]!=ringorder_c) && (k!=0)) // ???
5071  {
5072    dReportError("syzcomp in incompatible ring");
5073  }
5074#ifdef PDEBUG
5075  extern int pDBsyzComp;
5076  pDBsyzComp=k;
5077#endif
5078}
5079
5080// return the max-comonent wchich has syzIndex i
5081int rGetMaxSyzComp(int i, const ring r)
5082{
5083  if ((r->typ!=NULL) && (r->typ[0].ord_typ==ro_syz) &&
5084      r->typ[0].data.syz.limit > 0 && i > 0)
5085  {
5086    assume(i <= r->typ[0].data.syz.limit);
5087    int j;
5088    for (j=0; j<r->typ[0].data.syz.limit; j++)
5089    {
5090      if (r->typ[0].data.syz.syz_index[j] == i  &&
5091          r->typ[0].data.syz.syz_index[j+1] != i)
5092      {
5093        assume(r->typ[0].data.syz.syz_index[j+1] == i+1);
5094        return j;
5095      }
5096    }
5097    return r->typ[0].data.syz.limit;
5098  }
5099  else
5100  {
5101    return 0;
5102  }
5103}
5104
5105BOOLEAN rRing_is_Homog(ring r)
5106{
5107  if (r == NULL) return FALSE;
5108  int i, j, nb = rBlocks(r);
5109  for (i=0; i<nb; i++)
5110  {
5111    if (r->wvhdl[i] != NULL)
5112    {
5113      int length = r->block1[i] - r->block0[i];
5114      int* wvhdl = r->wvhdl[i];
5115      if (r->order[i] == ringorder_M) length *= length;
5116      assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
5117
5118      for (j=0; j< length; j++)
5119      {
5120        if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
5121      }
5122    }
5123  }
5124  return TRUE;
5125}
5126
5127BOOLEAN rRing_has_CompLastBlock(ring r)
5128{
5129  assume(r != NULL);
5130  int lb = rBlocks(r) - 2;
5131  return (r->order[lb] == ringorder_c || r->order[lb] == ringorder_C);
5132}
5133
5134n_coeffType rFieldType(ring r)
5135{
5136  return (r->cf->type);
5137  if (rField_is_Zp(r))     return n_Zp;
5138  if (rField_is_Q(r))      return n_Q;
5139  if (rField_is_R(r))      return n_R;
5140  if (rField_is_GF(r))     return n_GF;
5141  if (rField_is_long_R(r)) return n_long_R;
5142  if (rField_is_Zp_a(r))   return getCoeffType(r->cf);
5143  if (rField_is_Q_a(r))    return getCoeffType(r->cf);
5144  if (rField_is_long_C(r)) return n_long_C;
5145  #ifdef HAVE_RINGS
5146   if (rField_is_Ring_Z(r)) return n_Z;
5147   if (rField_is_Ring_ModN(r)) return n_Zn;
5148   if (rField_is_Ring_PtoM(r)) return n_Znm;
5149   if (rField_is_Ring_2toM(r)) return  n_Z2m;
5150  #endif
5151
5152  return n_unknown;
5153}
5154
5155int64 * rGetWeightVec(ring r)
5156{
5157  assume(r!=NULL);
5158  assume(r->OrdSize>0);
5159  int i=0;
5160  while((r->typ[i].ord_typ!=ro_wp64) && (r->typ[i].ord_typ>0)) i++;
5161  assume(r->typ[i].ord_typ==ro_wp64);
5162  return (int64*)(r->typ[i].data.wp64.weights64);
5163}
5164
5165void rSetWeightVec(ring r, int64 *wv)
5166{
5167  assume(r!=NULL);
5168  assume(r->OrdSize>0);
5169  assume(r->typ[0].ord_typ==ro_wp64);
5170  memcpy(r->typ[0].data.wp64.weights64,wv,r->N*sizeof(int64));
5171}
5172
5173#include <ctype.h>
5174
5175static int rRealloc1(ring r, int size, int pos)
5176{
5177  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size+1)*sizeof(int));
5178  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size+1)*sizeof(int));
5179  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size+1)*sizeof(int));
5180  r->wvhdl=(int **)omReallocSize(r->wvhdl,size*sizeof(int *), (size+1)*sizeof(int *));
5181  for(int k=size; k>pos; k--) r->wvhdl[k]=r->wvhdl[k-1];
5182  r->order[size]=0;
5183  size++;
5184  return size;
5185}
5186#if 0 // currently unused
5187static int rReallocM1(ring r, int size, int pos)
5188{
5189  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size-1)*sizeof(int));
5190  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size-1)*sizeof(int));
5191  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size-1)*sizeof(int));
5192  r->wvhdl=(int **)omReallocSize(r->wvhdl,size*sizeof(int *), (size-1)*sizeof(int *));
5193  for(int k=pos+1; k<size; k++) r->wvhdl[k]=r->wvhdl[k+1];
5194  size--;
5195  return size;
5196}
5197#endif
5198static void rOppWeight(int *w, int l)
5199{
5200  int i2=(l+1)/2;
5201  for(int j=0; j<=i2; j++)
5202  {
5203    int t=w[j];
5204    w[j]=w[l-j];
5205    w[l-j]=t;
5206  }
5207}
5208
5209#define rOppVar(R,I) (rVar(R)+1-I)
5210
5211ring rOpposite(ring src)
5212  /* creates an opposite algebra of R */
5213  /* that is R^opp, where f (*^opp) g = g*f  */
5214  /* treats the case of qring */
5215{
5216  if (src == NULL) return(NULL);
5217
5218#ifdef RDEBUG
5219  rTest(src);
5220#endif
5221
5222  //rChangeCurrRing(src);
5223
5224#ifdef RDEBUG
5225  rTest(src);
5226//  rWrite(src);
5227//  rDebugPrint(src);
5228#endif
5229
5230
5231  ring r = rCopy0(src,FALSE); /* qideal will be deleted later on!!! */
5232
5233  // change vars v1..vN -> vN..v1
5234  int i;
5235  int i2 = (rVar(r)-1)/2;
5236  for(i=i2; i>=0; i--)
5237  {
5238    // index: 0..N-1
5239    //Print("ex var names: %d <-> %d\n",i,rOppVar(r,i));
5240    // exchange names
5241    char *p;
5242    p = r->names[rVar(r)-1-i];
5243    r->names[rVar(r)-1-i] = r->names[i];
5244    r->names[i] = p;
5245  }
5246//  i2=(rVar(r)+1)/2;
5247//  for(int i=i2; i>0; i--)
5248//  {
5249//    // index: 1..N
5250//    //Print("ex var places: %d <-> %d\n",i,rVar(r)+1-i);
5251//    // exchange VarOffset
5252//    int t;
5253//    t=r->VarOffset[i];
5254//    r->VarOffset[i]=r->VarOffset[rOppVar(r,i)];
5255//    r->VarOffset[rOppVar(r,i)]=t;
5256//  }
5257  // change names:
5258  for (i=rVar(r)-1; i>=0; i--)
5259  {
5260    char *p=r->names[i];
5261    if(isupper(*p)) *p = tolower(*p);
5262    else            *p = toupper(*p);
5263  }
5264  // change ordering: listing
5265  // change ordering: compare
5266//  for(i=0; i<r->OrdSize; i++)
5267//  {
5268//    int t,tt;
5269//    switch(r->typ[i].ord_typ)
5270//    {
5271//      case ro_dp:
5272//      //
5273//        t=r->typ[i].data.dp.start;
5274//        r->typ[i].data.dp.start=rOppVar(r,r->typ[i].data.dp.end);
5275//        r->typ[i].data.dp.end=rOppVar(r,t);
5276//        break;
5277//      case ro_wp:
5278//      case ro_wp_neg:
5279//      {
5280//        t=r->typ[i].data.wp.start;
5281//        r->typ[i].data.wp.start=rOppVar(r,r->typ[i].data.wp.end);
5282//        r->typ[i].data.wp.end=rOppVar(r,t);
5283//        // invert r->typ[i].data.wp.weights
5284//        rOppWeight(r->typ[i].data.wp.weights,
5285//                   r->typ[i].data.wp.end-r->typ[i].data.wp.start);
5286//        break;
5287//      }
5288//      //case ro_wp64:
5289//      case ro_syzcomp:
5290//      case ro_syz:
5291//         WerrorS("not implemented in rOpposite");
5292//         // should not happen
5293//         break;
5294//
5295//      case ro_cp:
5296//        t=r->typ[i].data.cp.start;
5297//        r->typ[i].data.cp.start=rOppVar(r,r->typ[i].data.cp.end);
5298//        r->typ[i].data.cp.end=rOppVar(r,t);
5299//        break;
5300//      case ro_none:
5301//      default:
5302//       Werror("unknown type in rOpposite(%d)",r->typ[i].ord_typ);
5303//       break;
5304//    }
5305//  }
5306  // Change order/block structures (needed for rPrint, rAdd etc.)
5307  int j=0;
5308  int l=rBlocks(src);
5309  for(i=0; src->order[i]!=0; i++)
5310  {
5311    switch (src->order[i])
5312    {
5313      case ringorder_c: /* c-> c */
5314      case ringorder_C: /* C-> C */
5315      case ringorder_no /*=0*/: /* end-of-block */
5316        r->order[j]=src->order[i];
5317        j++; break;
5318      case ringorder_lp: /* lp -> rp */
5319        r->order[j]=ringorder_rp;
5320        r->block0[j]=rOppVar(r, src->block1[i]);
5321        r->block1[j]=rOppVar(r, src->block0[i]);
5322        break;
5323      case ringorder_rp: /* rp -> lp */
5324        r->order[j]=ringorder_lp;
5325        r->block0[j]=rOppVar(r, src->block1[i]);
5326        r->block1[j]=rOppVar(r, src->block0[i]);
5327        break;
5328      case ringorder_dp: /* dp -> a(1..1),ls */
5329      {
5330        l=rRealloc1(r,l,j);
5331        r->order[j]=ringorder_a;
5332        r->block0[j]=rOppVar(r, src->block1[i]);
5333        r->block1[j]=rOppVar(r, src->block0[i]);
5334        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
5335        for(int k=r->block0[j]; k<=r->block1[j]; k++)
5336          r->wvhdl[j][k-r->block0[j]]=1;
5337        j++;
5338        r->order[j]=ringorder_ls;
5339        r->block0[j]=rOppVar(r, src->block1[i]);
5340        r->block1[j]=rOppVar(r, src->block0[i]);
5341        j++;
5342        break;
5343      }
5344      case ringorder_Dp: /* Dp -> a(1..1),rp */
5345      {
5346        l=rRealloc1(r,l,j);
5347        r->order[j]=ringorder_a;
5348        r->block0[j]=rOppVar(r, src->block1[i]);
5349        r->block1[j]=rOppVar(r, src->block0[i]);
5350        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
5351        for(int k=r->block0[j]; k<=r->block1[j]; k++)
5352          r->wvhdl[j][k-r->block0[j]]=1;
5353        j++;
5354        r->order[j]=ringorder_rp;
5355        r->block0[j]=rOppVar(r, src->block1[i]);
5356        r->block1[j]=rOppVar(r, src->block0[i]);
5357        j++;
5358        break;
5359      }
5360      case ringorder_wp: /* wp -> a(...),ls */
5361      {
5362        l=rRealloc1(r,l,j);
5363        r->order[j]=ringorder_a;
5364        r->block0[j]=rOppVar(r, src->block1[i]);
5365        r->block1[j]=rOppVar(r, src->block0[i]);
5366        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=NULL;
5367        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5368        j++;
5369        r->order[j]=ringorder_ls;
5370        r->block0[j]=rOppVar(r, src->block1[i]);
5371        r->block1[j]=rOppVar(r, src->block0[i]);
5372        j++;
5373        break;
5374      }
5375      case ringorder_Wp: /* Wp -> a(...),rp */
5376      {
5377        l=rRealloc1(r,l,j);
5378        r->order[j]=ringorder_a;
5379        r->block0[j]=rOppVar(r, src->block1[i]);
5380        r->block1[j]=rOppVar(r, src->block0[i]);
5381        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=NULL;
5382        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5383        j++;
5384        r->order[j]=ringorder_rp;
5385        r->block0[j]=rOppVar(r, src->block1[i]);
5386        r->block1[j]=rOppVar(r, src->block0[i]);
5387        j++;
5388        break;
5389      }
5390      case ringorder_M: /* M -> M */
5391      {
5392        r->order[j]=ringorder_M;
5393        r->block0[j]=rOppVar(r, src->block1[i]);
5394        r->block1[j]=rOppVar(r, src->block0[i]);
5395        int n=r->block1[j]-r->block0[j];
5396        /* M is a (n+1)x(n+1) matrix */
5397        for (int nn=0; nn<=n; nn++)
5398        {
5399          rOppWeight(&(r->wvhdl[j][nn*(n+1)]), n /*r->block1[j]-r->block0[j]*/);
5400        }
5401        j++;
5402        break;
5403      }
5404      case ringorder_a: /*  a(...),ls -> wp/dp */
5405      {
5406        r->block0[j]=rOppVar(r, src->block1[i]);
5407        r->block1[j]=rOppVar(r, src->block0[i]);
5408        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5409        if (src->order[i+1]==ringorder_ls)
5410        {
5411          r->order[j]=ringorder_wp;
5412          i++;
5413          //l=rReallocM1(r,l,j);
5414        }
5415        else
5416        {
5417          r->order[j]=ringorder_a;
5418        }
5419        j++;
5420        break;
5421      }
5422      // not yet done:
5423      case ringorder_ls:
5424      case ringorder_rs:
5425      case ringorder_ds:
5426      case ringorder_Ds:
5427      case ringorder_ws:
5428      case ringorder_Ws:
5429      // should not occur:
5430      case ringorder_S:
5431      case ringorder_IS:
5432      case ringorder_s:
5433      case ringorder_aa:
5434      case ringorder_L:
5435      case ringorder_unspec:
5436        Werror("order %s not (yet) supported", rSimpleOrdStr(src->order[i]));
5437        break;
5438    }
5439  }
5440  rComplete(r);
5441
5442
5443#ifdef RDEBUG
5444  rTest(r);
5445#endif
5446
5447  //rChangeCurrRing(r);
5448
5449#ifdef RDEBUG
5450  rTest(r);
5451//  rWrite(r);
5452//  rDebugPrint(r);
5453#endif
5454
5455
5456#ifdef HAVE_PLURAL
5457  // now, we initialize a non-comm structure on r
5458  if (rIsPluralRing(src))
5459  {
5460//    assume( currRing == r);
5461
5462    int *perm       = (int *)omAlloc0((rVar(r)+1)*sizeof(int));
5463    int *par_perm   = NULL;
5464    nMapFunc nMap   = n_SetMap(src->cf,r->cf);
5465    int ni,nj;
5466    for(i=1; i<=r->N; i++)
5467    {
5468      perm[i] = rOppVar(r,i);
5469    }
5470
5471    matrix C = mpNew(rVar(r),rVar(r));
5472    matrix D = mpNew(rVar(r),rVar(r));
5473
5474    for (i=1; i< rVar(r); i++)
5475    {
5476      for (j=i+1; j<=rVar(r); j++)
5477      {
5478        ni = r->N +1 - i;
5479        nj = r->N +1 - j; /* i<j ==>   nj < ni */
5480
5481        assume(MATELEM(src->GetNC()->C,i,j) != NULL);
5482        MATELEM(C,nj,ni) = p_PermPoly(MATELEM(src->GetNC()->C,i,j),perm,src,r, nMap,par_perm,rPar(src));
5483
5484        if(MATELEM(src->GetNC()->D,i,j) != NULL)
5485          MATELEM(D,nj,ni) = p_PermPoly(MATELEM(src->GetNC()->D,i,j),perm,src,r, nMap,par_perm,rPar(src));
5486      }
5487    }
5488
5489    id_Test((ideal)C, r);
5490    id_Test((ideal)D, r);
5491
5492    if (nc_CallPlural(C, D, NULL, NULL, r, false, false, true, r)) // no qring setup!
5493      WarnS("Error initializing non-commutative multiplication!");
5494
5495#ifdef RDEBUG
5496    rTest(r);
5497//    rWrite(r);
5498//    rDebugPrint(r);
5499#endif
5500
5501    assume( r->GetNC()->IsSkewConstant == src->GetNC()->IsSkewConstant);
5502
5503    omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
5504  }
5505#endif /* HAVE_PLURAL */
5506
5507  /* now oppose the qideal for qrings */
5508  if (src->qideal != NULL)
5509  {
5510    id_Delete(&(r->qideal), r);
5511
5512#ifdef HAVE_PLURAL
5513    r->qideal = idOppose(src, src->qideal, r); // into the currRing: r
5514#else
5515    r->qideal = id_Copy(src->qideal, r); // ?
5516#endif
5517
5518#ifdef HAVE_PLURAL
5519    if( rIsPluralRing(r) )
5520    {
5521      nc_SetupQuotient(r);
5522#ifdef RDEBUG
5523      rTest(r);
5524//      rWrite(r);
5525//      rDebugPrint(r);
5526#endif
5527    }
5528#endif
5529  }
5530#ifdef HAVE_PLURAL
5531  if( rIsPluralRing(r) )
5532    assume( ncRingType(r) == ncRingType(src) );
5533#endif
5534  rTest(r);
5535
5536  return r;
5537}
5538
5539ring rEnvelope(ring R)
5540  /* creates an enveloping algebra of R */
5541  /* that is R^e = R \tensor_K R^opp */
5542{
5543  ring Ropp = rOpposite(R);
5544  ring Renv = NULL;
5545  int stat = rSum(R, Ropp, Renv); /* takes care of qideals */
5546  if ( stat <=0 )
5547    WarnS("Error in rEnvelope at rSum");
5548  rTest(Renv);
5549  return Renv;
5550}
5551
5552#ifdef HAVE_PLURAL
5553BOOLEAN nc_rComplete(const ring src, ring dest, bool bSetupQuotient)
5554/* returns TRUE is there were errors */
5555/* dest is actualy equals src with the different ordering */
5556/* we map src->nc correctly to dest->src */
5557/* to be executed after rComplete, before rChangeCurrRing */
5558{
5559// NOTE: Originally used only by idElimination to transfer NC structure to dest
5560// ring created by dirty hack (without nc_CallPlural)
5561  rTest(src);
5562
5563  assume(!rIsPluralRing(dest)); // destination must be a newly constructed commutative ring
5564
5565  if (!rIsPluralRing(src))
5566  {
5567    return FALSE;
5568  }
5569
5570  const int N = dest->N;
5571
5572  assume(src->N == N);
5573
5574//  ring save = currRing;
5575
5576//  if (dest != save)
5577//    rChangeCurrRing(dest);
5578
5579  const ring srcBase = src;
5580
5581  assume( n_SetMap(srcBase->cf,dest->cf) == n_SetMap(dest->cf,dest->cf) ); // currRing is important here!
5582
5583  matrix C = mpNew(N,N); // ring independent
5584  matrix D = mpNew(N,N);
5585
5586  matrix C0 = src->GetNC()->C;
5587  matrix D0 = src->GetNC()->D;
5588
5589  // map C and D into dest
5590  for (int i = 1; i < N; i++)
5591  {
5592    for (int j = i + 1; j <= N; j++)
5593    {
5594      const number n = n_Copy(p_GetCoeff(MATELEM(C0,i,j), srcBase), srcBase->cf); // src, mapping for coeffs into currRing = dest!
5595      const poly   p = p_NSet(n, dest);
5596      MATELEM(C,i,j) = p;
5597      if (MATELEM(D0,i,j) != NULL)
5598        MATELEM(D,i,j) = prCopyR(MATELEM(D0,i,j), srcBase, dest); // ?
5599    }
5600  }
5601  /* One must test C and D _only_ in r->GetNC()->basering!!! not in r!!! */
5602
5603  id_Test((ideal)C, dest);
5604  id_Test((ideal)D, dest);
5605
5606  if (nc_CallPlural(C, D, NULL, NULL, dest, bSetupQuotient, false, true, dest)) // also takes care about quotient ideal
5607  {
5608    //WarnS("Error transferring non-commutative structure");
5609    // error message should be in the interpreter interface
5610
5611    mp_Delete(&C, dest);
5612    mp_Delete(&D, dest);
5613
5614//    if (currRing != save)
5615//       rChangeCurrRing(save);
5616
5617    return TRUE;
5618  }
5619
5620//  mp_Delete(&C, dest); // used by nc_CallPlural!
5621//  mp_Delete(&D, dest);
5622
5623//  if (dest != save)
5624//    rChangeCurrRing(save);
5625
5626  assume(rIsPluralRing(dest));
5627  return FALSE;
5628}
5629#endif
5630
5631void rModify_a_to_A(ring r)
5632// to be called BEFORE rComplete:
5633// changes every Block with a(...) to A(...)
5634{
5635   int i=0;
5636   int j;
5637   while(r->order[i]!=0)
5638   {
5639      if (r->order[i]==ringorder_a)
5640      {
5641        r->order[i]=ringorder_a64;
5642        int *w=r->wvhdl[i];
5643        int64 *w64=(int64 *)omAlloc((r->block1[i]-r->block0[i]+1)*sizeof(int64));
5644        for(j=r->block1[i]-r->block0[i];j>=0;j--)
5645                w64[j]=(int64)w[j];
5646        r->wvhdl[i]=(int*)w64;
5647        omFreeSize(w,(r->block1[i]-r->block0[i]+1)*sizeof(int));
5648      }
5649      i++;
5650   }
5651}
5652
5653
5654poly rGetVar(const int varIndex, const ring r)
5655{
5656    poly p = p_ISet(1, r);
5657    p_SetExp(p, varIndex, 1, r);
5658    p_Setm(p, r);
5659    return p;
5660}
5661
5662
5663/// TODO: rewrite somehow...
5664int n_IsParam(const number m, const ring r)
5665{
5666  assume(r != NULL);
5667  const coeffs C = r->cf;
5668  assume(C != NULL);
5669
5670  assume( nCoeff_is_Extension(C) );
5671
5672  const n_coeffType _filed_type = getCoeffType(C);
5673
5674  if( _filed_type == n_algExt )
5675    return naIsParam(m, C);
5676
5677  if( _filed_type == n_transExt )
5678    return ntIsParam(m, C);
5679
5680  Werror("n_IsParam: IsParam is not to be used for (coeff_type = %d)",getCoeffType(C));
5681
5682  return 0;
5683}
5684
Note: See TracBrowser for help on using the repository browser.