source: git/kernel/ring.cc @ c5e0e1

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