source: git/libpolys/polys/monomials/ring.cc @ 48620a

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