source: git/kernel/ring.cc @ b1dfaf

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