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

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