source: git/kernel/ring.cc @ 06662e

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