source: git/libpolys/polys/monomials/ring.cc @ 237b4dd

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