source: git/kernel/ring.cc @ 273fed

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