source: git/kernel/ring.cc @ 3580b7

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