source: git/kernel/ring.cc @ a830d2b

spielwiese
Last change on this file since a830d2b was a830d2b, checked in by Hans Schönemann <hannes@…>, 20 years ago
* hannes: made aux functions extern available git-svn-id: file:///usr/local/Singular/svn/trunk@6963 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 79.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.3 2003-12-10 16:56:54 Singular Exp $ */
5
6/*
7* ABSTRACT - the interpreter related ring operations
8*/
9
10/* includes */
11#include <math.h>
12#include "mod2.h"
13#include "structs.h"
14#include "omalloc.h"
15#include "polys.h"
16#include "numbers.h"
17#include "febase.h"
18#include "ipconv.h"
19#include "intvec.h"
20#include "longalg.h"
21#include "ffields.h"
22#include "ideals.h"
23#include "ring.h"
24#include "prCopy.h"
25#include "../Singular/ipshell.h"
26#include "p_Procs.h"
27#ifdef HAVE_PLURAL
28#include "gring.h"
29#include "matpol.h"
30#endif
31
32#define BITS_PER_LONG 8*SIZEOF_LONG
33
34static const char * const ringorder_name[] =
35{
36  " ?", //ringorder_no = 0,
37  "a", //ringorder_a,
38  "c", //ringorder_c,
39  "C", //ringorder_C,
40  "M", //ringorder_M,
41  "S", //ringorder_S,
42  "s", //ringorder_s,
43  "lp", //ringorder_lp,
44  "dp", //ringorder_dp,
45  "rp", //ringorder_rp,
46  "Dp", //ringorder_Dp,
47  "wp", //ringorder_wp,
48  "Wp", //ringorder_Wp,
49  "ls", //ringorder_ls,
50  "ds", //ringorder_ds,
51  "Ds", //ringorder_Ds,
52  "ws", //ringorder_ws,
53  "Ws", //ringorder_Ws,
54  "L", //ringorder_L,
55  "aa", //ringorder_aa
56  " _" //ringorder_unspec
57};
58
59const char * rSimpleOrdStr(int ord)
60{
61  return ringorder_name[ord];
62}
63
64// unconditionally deletes fields in r
65void rDelete(ring r);
66// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
67static void rSetVarL(ring r);
68// get r->divmask depending on bits per exponent
69static unsigned long rGetDivMask(int bits);
70// right-adjust r->VarOffset
71static void rRightAdjustVarOffset(ring r);
72static void rOptimizeLDeg(ring r);
73
74/*0 implementation*/
75//BOOLEAN rField_is_R(ring r=currRing)
76//{
77//  if (r->ch== -1)
78//  {
79//    if (r->float_len==(short)0) return TRUE;
80//  }
81//  return FALSE;
82//}
83
84// internally changes the gloabl ring and resets the relevant
85// global variables:
86// complete == FALSE : only delete operations are enabled
87// complete == TRUE  : full reset of all variables
88void rChangeCurrRing(ring r)
89{
90  /*------------ set global ring vars --------------------------------*/
91  currRing = r;
92  currQuotient=NULL;
93  if (r != NULL)
94  {
95    rTest(r);
96    /*------------ set global ring vars --------------------------------*/
97    currQuotient=r->qideal;
98
99    /*------------ global variables related to coefficients ------------*/
100    nSetChar(r);
101
102    /*------------ global variables related to polys -------------------*/
103    pSetGlobals(r);
104  }
105}
106
107
108ring rDefault(int ch, int N, char **n)
109{
110  ring r=(ring) omAlloc0Bin(sip_sring_bin);
111  r->ch    = ch;
112  r->N     = N;
113  /*r->P     = 0; Alloc0 */
114  /*names*/
115  r->names = (char **) omAlloc0(N * sizeof(char_ptr));
116  int i;
117  for(i=0;i<N;i++)
118  {
119    r->names[i]  = omStrDup(n[i]);
120  }
121  /*weights: entries for 2 blocks: NULL*/
122  r->wvhdl = (int **)omAlloc0(2 * sizeof(int_ptr));
123  /*order: lp,0*/
124  r->order = (int *) omAlloc(2* sizeof(int *));
125  r->block0 = (int *)omAlloc0(2 * sizeof(int *));
126  r->block1 = (int *)omAlloc0(2 * sizeof(int *));
127  /* ringorder dp for the first block: var 1..N */
128  r->order[0]  = ringorder_lp;
129  r->block0[0] = 1;
130  r->block1[0] = N;
131  /* the last block: everything is 0 */
132  r->order[1]  = 0;
133  /*polynomial ring*/
134  r->OrdSgn    = 1;
135
136  /* complete ring intializations */
137  rComplete(r);
138  return r;
139}
140
141///////////////////////////////////////////////////////////////////////////
142//
143// rInit: define a new ring from sleftv's
144//
145
146/////////////////////////////
147// Auxillary functions
148//
149
150// check intvec, describing the ordering
151BOOLEAN rCheckIV(intvec *iv)
152{
153  if ((iv->length()!=2)&&(iv->length()!=3))
154  {
155    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
156    return TRUE;
157  }
158  return FALSE;
159}
160
161int rTypeOfMatrixOrder(intvec * order)
162{
163  int i=0,j,typ=1;
164  int sz = (int)sqrt((double)(order->length()-2));
165
166  while ((i<sz) && (typ==1))
167  {
168    j=0;
169    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
170    if (j>=sz)
171    {
172      typ = 0;
173      WerrorS("Matrix order not complete");
174    }
175    else if ((*order)[j*sz+i+2]<0)
176      typ = -1;
177    else
178      i++;
179  }
180  return typ;
181}
182
183// set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv
184BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R);
185
186// get array of strings from list of sleftv's
187BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p);
188
189
190/*2
191 * set a new ring from the data:
192 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
193 */
194
195int r_IsRingVar(char *n, ring r)
196{
197  if ((r!=NULL) && (r->names!=NULL))
198  {
199    for (int i=0; i<r->N; i++)
200    {
201      if (r->names[i]==NULL) return -1;
202      if (strcmp(n,r->names[i]) == 0) return (int)i;
203    }
204  }
205  return -1;
206}
207
208
209void rWrite(ring r)
210{
211  if ((r==NULL)||(r->order==NULL))
212    return; /*to avoid printing after errors....*/
213
214  int nblocks=rBlocks(r);
215
216  // omCheckAddrSize(r,sizeof(ip_sring));
217  omCheckAddrSize(r->order,nblocks*sizeof(int));
218  omCheckAddrSize(r->block0,nblocks*sizeof(int));
219  omCheckAddrSize(r->block1,nblocks*sizeof(int));
220  omCheckAddrSize(r->wvhdl,nblocks*sizeof(int_ptr));
221  omCheckAddrSize(r->names,r->N*sizeof(char_ptr));
222
223  nblocks--;
224
225
226  if (rField_is_GF(r))
227  {
228    Print("//   # ground field : %d\n",rInternalChar(r));
229    Print("//   primitive element : %s\n", r->parameter[0]);
230    if (r==currRing)
231    {
232      StringSetS("//   minpoly        : ");
233      nfShowMipo();PrintS(StringAppendS("\n"));
234    }
235  }
236  else
237  {
238    PrintS("//   characteristic : ");
239    if ( rField_is_R(r) )             PrintS("0 (real)\n");  /* R */
240    else if ( rField_is_long_R(r) )
241      Print("0 (real:%d digits, additional %d digits)\n",
242             r->float_len,r->float_len2);  /* long R */
243    else if ( rField_is_long_C(r) )
244      Print("0 (complex:%d digits, additional %d digits)\n",
245             r->float_len, r->float_len2);  /* long C */
246    else
247      Print ("%d\n",rChar(r)); /* Fp(a) */
248    if (r->parameter!=NULL)
249    {
250      Print ("//   %d parameter    : ",rPar(r));
251      char **sp=r->parameter;
252      int nop=0;
253      while (nop<rPar(r))
254      {
255        PrintS(*sp);
256        PrintS(" ");
257        sp++; nop++;
258      }
259      PrintS("\n//   minpoly        : ");
260      if ( rField_is_long_C(r) )
261      {
262        // i^2+1:
263        Print("(%s^2+1)\n",r->parameter[0]);
264      }
265      else if (r->minpoly==NULL)
266      {
267        PrintS("0\n");
268      }
269      else if (r==currRing)
270      {
271        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
272      }
273      else
274      {
275        PrintS("...\n");
276      }
277    }
278  }
279  Print("//   number of vars : %d",r->N);
280
281  //for (nblocks=0; r->order[nblocks]; nblocks++);
282  nblocks=rBlocks(r)-1;
283
284  for (int l=0, nlen=0 ; l<nblocks; l++)
285  {
286    int i;
287    Print("\n//        block %3d : ",l+1);
288
289    Print("ordering %s", rSimpleOrdStr(r->order[l]));
290
291    if ((r->order[l] >= ringorder_lp)
292    ||(r->order[l] == ringorder_M)
293    ||(r->order[l] == ringorder_a)
294    ||(r->order[l] == ringorder_aa))
295    {
296      PrintS("\n//                  : names    ");
297      for (i = r->block0[l]-1; i<r->block1[l]; i++)
298      {
299        nlen = strlen(r->names[i]);
300        Print("%s ",r->names[i]);
301      }
302    }
303#ifndef NDEBUG
304    else if (r->order[l] == ringorder_s)
305    {
306      Print("  syzcomp at %d",r->typ[l].data.syz.limit);
307    }
308#endif
309
310    if (r->wvhdl[l]!=NULL)
311    {
312      for (int j= 0;
313           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
314           j+=i)
315      {
316        PrintS("\n//                  : weights  ");
317        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
318        {
319          Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
320        }
321        if (r->order[l]!=ringorder_M) break;
322      }
323    }
324  }
325#ifdef HAVE_PLURAL
326  if ((r->nc!=NULL) && (r==currRing))
327  {
328    poly pl=NULL;
329    int nl;
330    PrintS("\n//   noncommutative relations:");
331    //    Print("\n//   noncommutative relations (type %d):",(int)r->nc->type);
332    for (int i = 1; i<r->N; i++)
333    {
334      for (int j = i+1; j<=r->N; j++)
335      {
336        nl=nIsOne(p_GetCoeff(MATELEM(r->nc->C,i,j),r));
337        if ((MATELEM(r->nc->D,i,j)!=NULL)||(!nl))
338        {
339          Print("\n//    %s%s=",r->names[j-1],r->names[i-1]);
340          pl=MATELEM(r->nc->MT[UPMATELEM(i,j,r->N)],1,1);
341          pWrite0(pl);
342        }
343      }
344    }
345#ifdef PDEBUG
346    Print("\n//   noncommutative type:%d",r->nc->type);
347    Print("\n//   is skew constant:%d",r->nc->IsSkewConstant);
348#endif
349  }
350#endif
351  if (r->qideal!=NULL)
352  {
353    PrintS("\n// quotient ring from ideal");
354    if (r==currRing)
355    {
356      PrintLn();
357      iiWriteMatrix((matrix)r->qideal,"_",1);
358    }
359    else PrintS(" ...");
360  }
361}
362
363void rDelete(ring r)
364{
365  int i, j;
366
367  if (r == NULL) return;
368
369  rUnComplete(r);
370  // delete order stuff
371  if (r->order != NULL)
372  {
373    i=rBlocks(r);
374    assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
375    // delete order
376    omFreeSize((ADDRESS)r->order,i*sizeof(int));
377    omFreeSize((ADDRESS)r->block0,i*sizeof(int));
378    omFreeSize((ADDRESS)r->block1,i*sizeof(int));
379    // delete weights
380    for (j=0; j<i; j++)
381    {
382      if (r->wvhdl[j]!=NULL)
383        omFree(r->wvhdl[j]);
384    }
385    omFreeSize((ADDRESS)r->wvhdl,i*sizeof(short *));
386  }
387  else
388  {
389    assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
390  }
391
392  // delete varnames
393  if(r->names!=NULL)
394  {
395    for (i=0; i<r->N; i++)
396    {
397      if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
398    }
399    omFreeSize((ADDRESS)r->names,r->N*sizeof(char_ptr));
400  }
401
402  // delete parameter
403  if (r->parameter!=NULL)
404  {
405    char **s=r->parameter;
406    j = 0;
407    while (j < rPar(r))
408    {
409      if (*s != NULL) omFree((ADDRESS)*s);
410      s++;
411      j++;
412    }
413    omFreeSize((ADDRESS)r->parameter,rPar(r)*sizeof(char_ptr));
414  }
415  omFreeBin(r, ip_sring_bin);
416}
417
418int rOrderName(char * ordername)
419{
420  int order=ringorder_unspec;
421  while (order!= 0)
422  {
423    if (strcmp(ordername,rSimpleOrdStr(order))==0)
424      break;
425    order--;
426  }
427  if (order==0) Werror("wrong ring order `%s`",ordername);
428  omFree((ADDRESS)ordername);
429  return order;
430}
431
432char * rOrdStr(ring r)
433{
434  int nblocks,l,i;
435
436  for (nblocks=0; r->order[nblocks]; nblocks++);
437  nblocks--;
438
439  StringSetS("");
440  for (l=0; ; l++)
441  {
442    StringAppend((char *)rSimpleOrdStr(r->order[l]));
443    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
444    {
445      if (r->wvhdl[l]!=NULL)
446      {
447        StringAppendS("(");
448        for (int j= 0;
449             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
450             j+=i+1)
451        {
452          char c=',';
453          for (i = 0; i<r->block1[l]-r->block0[l]; i++)
454          {
455            StringAppend("%d," ,r->wvhdl[l][i+j]);
456          }
457          if (r->order[l]!=ringorder_M)
458          {
459            StringAppend("%d)" ,r->wvhdl[l][i+j]);
460            break;
461          }
462          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
463            c=')';
464          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
465        }
466      }
467      else
468        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
469    }
470    if (l==nblocks) return omStrDup(StringAppendS(""));
471    StringAppendS(",");
472  }
473}
474
475char * rVarStr(ring r)
476{
477  int i;
478  int l=2;
479  char *s;
480
481  for (i=0; i<r->N; i++)
482  {
483    l+=strlen(r->names[i])+1;
484  }
485  s=(char *)omAlloc(l);
486  s[0]='\0';
487  for (i=0; i<r->N-1; i++)
488  {
489    strcat(s,r->names[i]);
490    strcat(s,",");
491  }
492  strcat(s,r->names[i]);
493  return s;
494}
495
496char * rCharStr(ring r)
497{
498  char *s;
499  int i;
500
501  if (r->parameter==NULL)
502  {
503    i=r->ch;
504    if(i==-1)
505      s=omStrDup("real");                    /* R */
506    else
507    {
508      s=(char *)omAlloc(6);
509      sprintf(s,"%d",i);                   /* Q, Z/p */
510    }
511    return s;
512  }
513  int l=0;
514  for(i=0; i<rPar(r);i++)
515  {
516    l+=(strlen(r->parameter[i])+1);
517  }
518  s=(char *)omAlloc(l+6);
519  s[0]='\0';
520  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
521  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
522  else
523  {
524    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq  */
525    return s;
526  }
527  char tt[2];
528  tt[0]=',';
529  tt[1]='\0';
530  for(i=0; i<rPar(r);i++)
531  {
532    strcat(s,tt);
533    strcat(s,r->parameter[i]);
534  }
535  return s;
536}
537
538char * rParStr(ring r)
539{
540  if (r->parameter==NULL) return omStrDup("");
541
542  int i;
543  int l=2;
544
545  for (i=0; i<rPar(r); i++)
546  {
547    l+=strlen(r->parameter[i])+1;
548  }
549  char *s=(char *)omAlloc(l);
550  s[0]='\0';
551  for (i=0; i<rPar(r)-1; i++)
552  {
553    strcat(s,r->parameter[i]);
554    strcat(s,",");
555  }
556  strcat(s,r->parameter[i]);
557  return s;
558}
559
560char * rString(ring r)
561{
562  char *ch=rCharStr(r);
563  char *var=rVarStr(r);
564  char *ord=rOrdStr(r);
565  char *res=(char *)omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
566  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
567  omFree((ADDRESS)ch);
568  omFree((ADDRESS)var);
569  omFree((ADDRESS)ord);
570  return res;
571}
572
573int  rIsExtension(ring r)
574{
575  return (r->parameter!=NULL); /* R, Q, Fp: FALSE */
576}
577
578int  rIsExtension()
579{
580  return rIsExtension( currRing );
581}
582
583int rChar(ring r)
584{
585  if (rField_is_numeric(r))
586    return 0;
587  if (!rIsExtension(r)) /* Q, Fp */
588    return r->ch;
589  if (rField_is_Zp_a(r))  /* Fp(a)  */
590    return -r->ch;
591  if (rField_is_Q_a(r))   /* Q(a)  */
592    return 0;
593  /*else*/               /* GF(p,n) */
594  {
595    if ((r->ch & 1)==0) return 2;
596    int i=3;
597    while ((r->ch % i)!=0) i+=2;
598    return i;
599  }
600}
601
602/*2
603 *returns -1 for not compatible, (sum is undefined)
604 *         0 for equal, (and sum)
605 *         1 for compatible (and sum)
606 */
607int rSum(ring r1, ring r2, ring &sum)
608{
609  if (r1==r2)
610  {
611    sum=r1;
612    r1->ref++;
613    return 0;
614  }
615  ring save=currRing;
616  ip_sring tmpR;
617  memset(&tmpR,0,sizeof(tmpR));
618  /* check coeff. field =====================================================*/
619  if (rInternalChar(r1)==rInternalChar(r2))
620  {
621    tmpR.ch=rInternalChar(r1);
622    if (rField_is_Q(r1)||rField_is_Zp(r1)||rField_is_GF(r1)) /*Q, Z/p, GF(p,n)*/
623    {
624      if (r1->parameter!=NULL)
625      {
626        if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
627        {
628          tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
629          tmpR.parameter[0]=omStrDup(r1->parameter[0]);
630          tmpR.P=1;
631        }
632        else
633        {
634          WerrorS("GF(p,n)+GF(p,n)");
635          return -1;
636        }
637      }
638    }
639    else if ((r1->ch==1)||(r1->ch<-1)) /* Q(a),Z/p(a) */
640    {
641      if (r1->minpoly!=NULL)
642      {
643        if (r2->minpoly!=NULL)
644        {
645          // HANNES: TODO: delete nSetChar
646          rChangeCurrRing(r1);
647          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
648              && n_Equal(r1->minpoly,r2->minpoly, r1))
649          {
650            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
651            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
652            tmpR.minpoly=n_Copy(r1->minpoly, r1);
653            tmpR.P=1;
654            // HANNES: TODO: delete nSetChar
655            rChangeCurrRing(save);
656          }
657          else
658          {
659            // HANNES: TODO: delete nSetChar
660            rChangeCurrRing(save);
661            WerrorS("different minpolys");
662            return -1;
663          }
664        }
665        else
666        {
667          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
668              && (rPar(r2)==1))
669          {
670            tmpR.parameter=(char **)omAlloc0Bin(char_ptr_bin);
671            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
672            tmpR.P=1;
673            tmpR.minpoly=n_Copy(r1->minpoly, r1);
674          }
675          else
676          {
677            WerrorS("different parameters and minpoly!=0");
678            return -1;
679          }
680        }
681      }
682      else /* r1->minpoly==NULL */
683      {
684        if (r2->minpoly!=NULL)
685        {
686          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
687              && (rPar(r1)==1))
688          {
689            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
690            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
691            tmpR.P=1;
692            tmpR.minpoly=n_Copy(r2->minpoly, r2);
693          }
694          else
695          {
696            WerrorS("different parameters and minpoly!=0");
697            return -1;
698          }
699        }
700        else
701        {
702          int len=rPar(r1)+rPar(r2);
703          tmpR.parameter=(char **)omAlloc(len*sizeof(char_ptr));
704          int i;
705          for (i=0;i<rPar(r1);i++)
706          {
707            tmpR.parameter[i]=omStrDup(r1->parameter[i]);
708          }
709          int j,l;
710          for(j=0;j<rPar(r2);j++)
711          {
712            for(l=0;l<i;l++)
713            {
714              if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
715                break;
716            }
717            if (l==i)
718            {
719              tmpR.parameter[i]=omStrDup(r2->parameter[j]);
720              i++;
721            }
722          }
723          if (i!=len)
724          {
725            omReallocSize(tmpR.parameter,len*sizeof(char_ptr),i*sizeof(char_ptr));
726          }
727        }
728      }
729    }
730  }
731  else /* r1->ch!=r2->ch */
732  {
733    if (r1->ch<-1) /* Z/p(a) */
734    {
735      if ((r2->ch==0) /* Q */
736          || (r2->ch==-r1->ch)) /* Z/p */
737      {
738        tmpR.ch=rInternalChar(r1);
739        tmpR.parameter=(char **)omAlloc(rPar(r1)*sizeof(char_ptr));
740        tmpR.P=rPar(r1);
741        memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char_ptr));
742        if (r1->minpoly!=NULL)
743        {
744          tmpR.minpoly=n_Copy(r1->minpoly, r1);
745        }
746      }
747      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
748      {
749        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
750        return -1;
751      }
752    }
753    else if (r1->ch==-1) /* R */
754    {
755      WerrorS("R+..");
756      return -1;
757    }
758    else if (r1->ch==0) /* Q */
759    {
760      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
761      {
762        tmpR.ch=rInternalChar(r2);
763        tmpR.P=rPar(r2);
764        tmpR.parameter=(char **)omAlloc(rPar(r2)*sizeof(char_ptr));
765        memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char_ptr));
766        if (r2->minpoly!=NULL)
767        {
768          tmpR.minpoly=n_Copy(r2->minpoly, r2);
769        }
770      }
771      else if (r2->ch>1) /* Z/p,GF(p,n) */
772      {
773        tmpR.ch=r2->ch;
774        if (r2->parameter!=NULL)
775        {
776          tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
777          tmpR.P=1;
778          tmpR.parameter[0]=omStrDup(r2->parameter[0]);
779        }
780      }
781      else
782      {
783        WerrorS("Q+R");
784        return -1; /* R */
785      }
786    }
787    else if (r1->ch==1) /* Q(a) */
788    {
789      if (r2->ch==0) /* Q */
790      {
791        tmpR.ch=rInternalChar(r1);
792        tmpR.P=rPar(r1);
793        tmpR.parameter=(char **)omAlloc0(rPar(r1)*sizeof(char_ptr));
794        int i;
795        for(i=0;i<rPar(r1);i++)
796        {
797          tmpR.parameter[i]=omStrDup(r1->parameter[i]);
798        }
799        if (r1->minpoly!=NULL)
800        {
801          tmpR.minpoly=n_Copy(r1->minpoly, r1);
802        }
803      }
804      else  /* R, Z/p,GF(p,n) */
805      {
806        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
807        return -1;
808      }
809    }
810    else /* r1->ch >=2 , Z/p */
811    {
812      if (r2->ch==0) /* Q */
813      {
814        tmpR.ch=r1->ch;
815      }
816      else if (r2->ch==-r1->ch) /* Z/p(a) */
817      {
818        tmpR.ch=rInternalChar(r2);
819        tmpR.P=rPar(r2);
820        tmpR.parameter=(char **)omAlloc(rPar(r2)*sizeof(char_ptr));
821        int i;
822        for(i=0;i<rPar(r2);i++)
823        {
824          tmpR.parameter[i]=omStrDup(r2->parameter[i]);
825        }
826        if (r2->minpoly!=NULL)
827        {
828          tmpR.minpoly=n_Copy(r2->minpoly, r2);
829        }
830      }
831      else
832      {
833        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
834        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
835      }
836    }
837  }
838  /* variable names ========================================================*/
839  int i,j,k;
840  int l=r1->N+r2->N;
841  char **names=(char **)omAlloc0(l*sizeof(char_ptr));
842  k=0;
843
844  // collect all varnames from r1, except those which are parameters
845  // of r2, or those which are the empty string
846  for (i=0;i<r1->N;i++)
847  {
848    BOOLEAN b=TRUE;
849
850    if (*(r1->names[i]) == '\0')
851      b = FALSE;
852    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
853    {
854      for(j=0;j<rPar(r2);j++)
855      {
856        if (strcmp(r1->names[i],r2->parameter[j])==0)
857        {
858          b=FALSE;
859          break;
860        }
861      }
862    }
863
864    if (b)
865    {
866      //Print("name : %d: %s\n",k,r1->names[i]);
867      names[k]=omStrDup(r1->names[i]);
868      k++;
869    }
870    //else
871    //  Print("no name (par1) %s\n",r1->names[i]);
872  }
873  // Add variables from r2, except those which are parameters of r1
874  // those which are empty strings, and those which equal a var of r1
875  for(i=0;i<r2->N;i++)
876  {
877    BOOLEAN b=TRUE;
878
879    if (*(r2->names[i]) == '\0')
880      b = FALSE;
881    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
882    {
883      for(j=0;j<rPar(r1);j++)
884      {
885        if (strcmp(r2->names[i],r1->parameter[j])==0)
886        {
887          b=FALSE;
888          break;
889        }
890      }
891    }
892
893    if (b)
894    {
895      for(j=0;j<r1->N;j++)
896      {
897        if (strcmp(r1->names[j],r2->names[i])==0)
898        {
899          b=FALSE;
900          break;
901        }
902      }
903      if (b)
904      {
905        //Print("name : %d : %s\n",k,r2->names[i]);
906        names[k]=omStrDup(r2->names[i]);
907        k++;
908      }
909      //else
910      //  Print("no name (var): %s\n",r2->names[i]);
911    }
912    //else
913    //  Print("no name (par): %s\n",r2->names[i]);
914  }
915  // check whether we found any vars at all
916  if (k == 0)
917  {
918    names[k]=omStrDup("");
919    k=1;
920  }
921  tmpR.N=k;
922  tmpR.names=names;
923  /* ordering *======================================================== */
924  tmpR.OrdSgn=1;
925  if ((r1->order[0]==ringorder_unspec)
926      && (r2->order[0]==ringorder_unspec))
927  {
928    tmpR.order=(int*)omAlloc(3*sizeof(int));
929    tmpR.block0=(int*)omAlloc(3*sizeof(int));
930    tmpR.block1=(int*)omAlloc(3*sizeof(int));
931    tmpR.wvhdl=(int**)omAlloc0(3*sizeof(int_ptr));
932    tmpR.order[0]=ringorder_unspec;
933    tmpR.order[1]=ringorder_C;
934    tmpR.order[2]=0;
935    tmpR.block0[0]=1;
936    tmpR.block1[0]=tmpR.N;
937  }
938  else if (l==k) /* r3=r1+r2 */
939  {
940    int b;
941    ring rb;
942    if (r1->order[0]==ringorder_unspec)
943    {
944      /* extend order of r2 to r3 */
945      b=rBlocks(r2);
946      rb=r2;
947      tmpR.OrdSgn=r2->OrdSgn;
948    }
949    else if (r2->order[0]==ringorder_unspec)
950    {
951      /* extend order of r1 to r3 */
952      b=rBlocks(r1);
953      rb=r1;
954      tmpR.OrdSgn=r1->OrdSgn;
955    }
956    else
957    {
958      b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
959      rb=NULL;
960    }
961    tmpR.order=(int*)omAlloc0(b*sizeof(int));
962    tmpR.block0=(int*)omAlloc0(b*sizeof(int));
963    tmpR.block1=(int*)omAlloc0(b*sizeof(int));
964    tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int_ptr));
965    /* weights not implemented yet ...*/
966    if (rb!=NULL)
967    {
968      for (i=0;i<b;i++)
969      {
970        tmpR.order[i]=rb->order[i];
971        tmpR.block0[i]=rb->block0[i];
972        tmpR.block1[i]=rb->block1[i];
973        if (rb->wvhdl[i]!=NULL)
974          WarnS("rSum: weights not implemented");
975      }
976      tmpR.block0[0]=1;
977    }
978    else /* ring sum for complete rings */
979    {
980      for (i=0;r1->order[i]!=0;i++)
981      {
982        tmpR.order[i]=r1->order[i];
983        tmpR.block0[i]=r1->block0[i];
984        tmpR.block1[i]=r1->block1[i];
985        if (r1->wvhdl[i]!=NULL)
986          tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
987      }
988      j=i;
989      i--;
990      if ((r1->order[i]==ringorder_c)
991          ||(r1->order[i]==ringorder_C))
992      {
993        j--;
994        tmpR.order[b-2]=r1->order[i];
995      }
996      for (i=0;r2->order[i]!=0;i++)
997      {
998        if ((r2->order[i]!=ringorder_c)
999            &&(r2->order[i]!=ringorder_C))
1000        {
1001          tmpR.order[j]=r2->order[i];
1002          tmpR.block0[j]=r2->block0[i]+r1->N;
1003          tmpR.block1[j]=r2->block1[i]+r1->N;
1004          if (r2->wvhdl[i]!=NULL)
1005          {
1006            tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1007          }
1008          j++;
1009        }
1010      }
1011      if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1012        tmpR.OrdSgn=-1;
1013    }
1014  }
1015  else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1016    /* copy r1, because we have the variables from r1 */
1017  {
1018    int b=rBlocks(r1);
1019
1020    tmpR.order=(int*)omAlloc0(b*sizeof(int));
1021    tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1022    tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1023    tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int_ptr));
1024    /* weights not implemented yet ...*/
1025    for (i=0;i<b;i++)
1026    {
1027      tmpR.order[i]=r1->order[i];
1028      tmpR.block0[i]=r1->block0[i];
1029      tmpR.block1[i]=r1->block1[i];
1030      if (r1->wvhdl[i]!=NULL)
1031      {
1032        tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1033      }
1034    }
1035    tmpR.OrdSgn=r1->OrdSgn;
1036  }
1037  else
1038  {
1039    for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1040    omFreeSize((ADDRESS)names,tmpR.N*sizeof(char_ptr));
1041    Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1042    return -1;
1043  }
1044  sum=(ring)omAllocBin(ip_sring_bin);
1045  memcpy(sum,&tmpR,sizeof(ip_sring));
1046  rComplete(sum);
1047  return 1;
1048}
1049/*2
1050 * create a copy of the ring r, which must be equivalent to currRing
1051 * used for qring definition,..
1052 * (i.e.: normal rings: same nCopy as currRing;
1053 *        qring:        same nCopy, same idCopy as currRing)
1054 * DOES NOT CALL rComplete
1055 */
1056static ring rCopy0(ring r, BOOLEAN copy_qideal = TRUE,
1057                   BOOLEAN copy_ordering = TRUE)
1058{
1059  if (r == NULL) return NULL;
1060  int i,j;
1061  ring res=(ring)omAllocBin(ip_sring_bin);
1062
1063  memcpy4(res,r,sizeof(ip_sring));
1064  res->VarOffset = NULL;
1065  res->ref=0;
1066  if (r->algring!=NULL)
1067    r->algring->ref++;
1068  if (r->parameter!=NULL)
1069  {
1070    res->minpoly=nCopy(r->minpoly);
1071    int l=rPar(r);
1072    res->parameter=(char **)omAlloc(l*sizeof(char_ptr));
1073    int i;
1074    for(i=0;i<rPar(r);i++)
1075    {
1076      res->parameter[i]=omStrDup(r->parameter[i]);
1077    }
1078  }
1079  if (copy_ordering == TRUE)
1080  {
1081    i=rBlocks(r);
1082    res->wvhdl   = (int **)omAlloc(i * sizeof(int_ptr));
1083    res->order   = (int *) omAlloc(i * sizeof(int));
1084    res->block0  = (int *) omAlloc(i * sizeof(int));
1085    res->block1  = (int *) omAlloc(i * sizeof(int));
1086    for (j=0; j<i; j++)
1087    {
1088      if (r->wvhdl[j]!=NULL)
1089      {
1090        res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1091      }
1092      else
1093        res->wvhdl[j]=NULL;
1094    }
1095    memcpy4(res->order,r->order,i * sizeof(int));
1096    memcpy4(res->block0,r->block0,i * sizeof(int));
1097    memcpy4(res->block1,r->block1,i * sizeof(int));
1098  }
1099  else
1100  {
1101    res->wvhdl = NULL;
1102    res->order = NULL;
1103    res->block0 = NULL;
1104    res->block1 = NULL;
1105  }
1106
1107  res->names   = (char **)omAlloc0(r->N * sizeof(char_ptr));
1108  for (i=0; i<res->N; i++)
1109  {
1110    res->names[i] = omStrDup(r->names[i]);
1111  }
1112  res->idroot = NULL;
1113  if (r->qideal!=NULL)
1114  {
1115    if (copy_qideal) res->qideal= idrCopyR_NoSort(r->qideal, r);
1116    else res->qideal = NULL;
1117  }
1118#ifdef HAVE_PLURAL
1119  if (rIsPluralRing(r))
1120  {
1121    res->nc->ref++;
1122  }
1123#endif
1124  return res;
1125}
1126
1127/*2
1128 * create a copy of the ring r, which must be equivalent to currRing
1129 * used for qring definition,..
1130 * (i.e.: normal rings: same nCopy as currRing;
1131 *        qring:        same nCopy, same idCopy as currRing)
1132 */
1133ring rCopy(ring r)
1134{
1135  if (r == NULL) return NULL;
1136  ring res=rCopy0(r);
1137  rComplete(res, 1);
1138  return res;
1139}
1140
1141// returns TRUE, if r1 equals r2 FALSE, otherwise Equality is
1142// determined componentwise, if qr == 1, then qrideal equality is
1143// tested, as well
1144BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1145{
1146  int i, j;
1147
1148  if (r1 == r2) return 1;
1149
1150  if (r1 == NULL || r2 == NULL) return 0;
1151
1152  if ((rInternalChar(r1) != rInternalChar(r2))
1153  || (r1->float_len != r2->float_len)
1154  || (r1->float_len2 != r2->float_len2)
1155  || (r1->N != r2->N)
1156  || (r1->OrdSgn != r2->OrdSgn)
1157  || (rPar(r1) != rPar(r2)))
1158    return 0;
1159
1160  for (i=0; i<r1->N; i++)
1161  {
1162    if (r1->names[i] != NULL && r2->names[i] != NULL)
1163    {
1164      if (strcmp(r1->names[i], r2->names[i])) return 0;
1165    }
1166    else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1167    {
1168      return 0;
1169    }
1170  }
1171
1172  i=0;
1173  while (r1->order[i] != 0)
1174  {
1175    if (r2->order[i] == 0) return 0;
1176    if ((r1->order[i] != r2->order[i]) ||
1177        (r1->block0[i] != r2->block0[i]) || (r2->block0[i] != r1->block0[i]))
1178      return 0;
1179    if (r1->wvhdl[i] != NULL)
1180    {
1181      if (r2->wvhdl[i] == NULL)
1182        return 0;
1183      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1184        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1185          return 0;
1186    }
1187    else if (r2->wvhdl[i] != NULL) return 0;
1188    i++;
1189  }
1190
1191  for (i=0; i<rPar(r1);i++)
1192  {
1193      if (strcmp(r1->parameter[i], r2->parameter[i])!=0)
1194        return 0;
1195  }
1196
1197  if (r1->minpoly != NULL)
1198  {
1199    if (r2->minpoly == NULL) return 0;
1200    if (currRing == r1 || currRing == r2)
1201    {
1202      if (! nEqual(r1->minpoly, r2->minpoly)) return 0;
1203    }
1204  }
1205  else if (r2->minpoly != NULL) return 0;
1206
1207  if (qr)
1208  {
1209    if (r1->qideal != NULL)
1210    {
1211      ideal id1 = r1->qideal, id2 = r2->qideal;
1212      int i, n;
1213      poly *m1, *m2;
1214
1215      if (id2 == NULL) return 0;
1216      if ((n = IDELEMS(id1)) != IDELEMS(id2)) return 0;
1217
1218      if (currRing == r1 || currRing == r2)
1219      {
1220        m1 = id1->m;
1221        m2 = id2->m;
1222        for (i=0; i<n; i++)
1223          if (! pEqualPolys(m1[i],m2[i])) return 0;
1224      }
1225    }
1226    else if (r2->qideal != NULL) return 0;
1227  }
1228
1229  return 1;
1230}
1231
1232rOrderType_t rGetOrderType(ring r)
1233{
1234  // check for simple ordering
1235  if (rHasSimpleOrder(r))
1236  {
1237    if ((r->order[1] == ringorder_c) || (r->order[1] == ringorder_C))
1238    {
1239      switch(r->order[0])
1240      {
1241          case ringorder_dp:
1242          case ringorder_wp:
1243          case ringorder_ds:
1244          case ringorder_ws:
1245          case ringorder_ls:
1246          case ringorder_unspec:
1247            if (r->order[1] == ringorder_C ||  r->order[0] == ringorder_unspec)
1248              return rOrderType_ExpComp;
1249            return rOrderType_Exp;
1250
1251          default:
1252            assume(r->order[0] == ringorder_lp ||
1253                   r->order[0] == ringorder_rp ||
1254                   r->order[0] == ringorder_Dp ||
1255                   r->order[0] == ringorder_Wp ||
1256                   r->order[0] == ringorder_Ds ||
1257                   r->order[0] == ringorder_Ws);
1258
1259            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1260            return rOrderType_Exp;
1261      }
1262    }
1263    else
1264    {
1265      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1266      return rOrderType_CompExp;
1267    }
1268  }
1269  else
1270    return rOrderType_General;
1271}
1272
1273BOOLEAN rHasSimpleOrder(ring r)
1274{
1275  if (r->order[0] == ringorder_unspec) return TRUE;
1276  int blocks = rBlocks(r) - 1;
1277  assume(blocks >= 1);
1278  if (blocks == 1) return TRUE;
1279  if (blocks > 2)  return FALSE;
1280  if (r->order[0] != ringorder_c && r->order[0] != ringorder_C &&
1281      r->order[1] != ringorder_c && r->order[1] != ringorder_C)
1282    return FALSE;
1283  if (r->order[1] == ringorder_M || r->order[0] == ringorder_M)
1284    return FALSE;
1285  return TRUE;
1286}
1287
1288// returns TRUE, if simple lp or ls ordering
1289BOOLEAN rHasSimpleLexOrder(ring r)
1290{
1291  return rHasSimpleOrder(r) &&
1292    (r->order[0] == ringorder_ls ||
1293     r->order[0] == ringorder_lp ||
1294     r->order[1] == ringorder_ls ||
1295     r->order[1] == ringorder_lp);
1296}
1297
1298BOOLEAN rOrder_is_DegOrdering(rRingOrder_t order)
1299{
1300  switch(order)
1301  {
1302      case ringorder_dp:
1303      case ringorder_Dp:
1304      case ringorder_ds:
1305      case ringorder_Ds:
1306      case ringorder_Ws:
1307      case ringorder_Wp:
1308      case ringorder_ws:
1309      case ringorder_wp:
1310        return TRUE;
1311
1312      default:
1313        return FALSE;
1314  }
1315}
1316
1317BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1318{
1319  switch(order)
1320  {
1321      case ringorder_Ws:
1322      case ringorder_Wp:
1323      case ringorder_ws:
1324      case ringorder_wp:
1325        return TRUE;
1326
1327      default:
1328        return FALSE;
1329  }
1330}
1331
1332BOOLEAN rHasSimpleOrderAA(ring r)
1333{
1334  int blocks = rBlocks(r) - 1;
1335  if (blocks > 3 || blocks < 2) return FALSE;
1336  if (blocks == 3)
1337  {
1338    return ((r->order[0] == ringorder_aa && r->order[1] != ringorder_M &&
1339             (r->order[2] == ringorder_c || r->order[2] == ringorder_C)) ||
1340            ((r->order[0] == ringorder_c || r->order[0] == ringorder_C) &&
1341             r->order[1] == ringorder_aa && r->order[2] != ringorder_M));
1342  }
1343  else
1344  {
1345    return (r->order[0] == ringorder_aa && r->order[1] != ringorder_M);
1346  }
1347}
1348
1349// return TRUE if p_SetComp requires p_Setm
1350BOOLEAN rOrd_SetCompRequiresSetm(ring r)
1351{
1352  if (r->typ != NULL)
1353  {
1354    int pos;
1355    for (pos=0;pos<r->OrdSize;pos++)
1356    {
1357      sro_ord* o=&(r->typ[pos]);
1358      if (o->ord_typ == ro_syzcomp || o->ord_typ == ro_syz) return TRUE;
1359    }
1360  }
1361  return FALSE;
1362}
1363
1364// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
1365BOOLEAN rOrd_is_Totaldegree_Ordering(ring r)
1366{
1367  // Hmm.... what about Syz orderings?
1368  return (r->N > 1 &&
1369          ((rHasSimpleOrder(r) &&
1370           (rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) ||
1371            rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) ||
1372           (rHasSimpleOrderAA(r) &&
1373            (rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) ||
1374             rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
1375}
1376
1377// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
1378BOOLEAN rOrd_is_WeightedDegree_Ordering(ring r =currRing)
1379{
1380  // Hmm.... what about Syz orderings?
1381  return (r->N > 1 &&
1382          rHasSimpleOrder(r) &&
1383          (rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) ||
1384           rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
1385}
1386
1387BOOLEAN rIsPolyVar(int v, ring r)
1388{
1389  int  i=0;
1390  while(r->order[i]!=0)
1391  {
1392    if((r->block0[i]<=v)
1393    && (r->block1[i]>=v))
1394    {
1395      switch(r->order[i])
1396      {
1397        case ringorder_a:
1398          return (r->wvhdl[i][v-r->block0[i]]>0);
1399        case ringorder_M:
1400          return 2; /*don't know*/
1401        case ringorder_lp:
1402        case ringorder_rp:
1403        case ringorder_dp:
1404        case ringorder_Dp:
1405        case ringorder_wp:
1406        case ringorder_Wp:
1407          return TRUE;
1408        case ringorder_ls:
1409        case ringorder_ds:
1410        case ringorder_Ds:
1411        case ringorder_ws:
1412        case ringorder_Ws:
1413          return FALSE;
1414        default:
1415          break;
1416      }
1417    }
1418    i++;
1419  }
1420  return 3; /* could not find var v*/
1421}
1422
1423#ifdef RDEBUG
1424// This should eventually become a full-fledge ring check, like pTest
1425BOOLEAN rDBTest(ring r, char* fn, int l)
1426{
1427  int i,j;
1428
1429  if (r == NULL)
1430  {
1431    dReportError("Null ring in %s:%d", fn, l);
1432    return FALSE;
1433  }
1434
1435
1436  if (r->N == 0) return TRUE;
1437
1438//  omCheckAddrSize(r,sizeof(ip_sring));
1439#if OM_CHECK > 0
1440  i=rBlocks(r);
1441  omCheckAddrSize(r->order,i*sizeof(int));
1442  omCheckAddrSize(r->block0,i*sizeof(int));
1443  omCheckAddrSize(r->block1,i*sizeof(int));
1444  omCheckAddrSize(r->wvhdl,i*sizeof(int *));
1445  for (j=0;j<i; j++)
1446  {
1447    if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
1448  }
1449#endif
1450  if (r->VarOffset == NULL)
1451  {
1452    dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
1453    return FALSE;
1454  }
1455  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
1456
1457  if ((r->OrdSize==0)!=(r->typ==NULL))
1458  {
1459    dReportError("mismatch OrdSize and typ-pointer in %s:%d");
1460    return FALSE;
1461  }
1462  omcheckAddrSize(r->typ,r->OrdSize*sizeof(*(r->typ)));
1463  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(*(r->VarOffset)));
1464  // test assumptions:
1465  for(i=0;i<=r->N;i++)
1466  {
1467    if(r->typ!=NULL)
1468    {
1469      for(j=0;j<r->OrdSize;j++)
1470      {
1471        if (r->typ[j].ord_typ==ro_cp)
1472        {
1473          if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
1474            dReportError("ordrec %d conflicts with var %d",j,i);
1475        }
1476        else
1477          if ((r->typ[j].ord_typ!=ro_syzcomp)
1478          && (r->VarOffset[i] == r->typ[j].data.dp.place))
1479            dReportError("ordrec %d conflicts with var %d",j,i);
1480      }
1481    }
1482    int tmp;
1483      tmp=r->VarOffset[i] & 0xffffff;
1484      #if SIZEOF_LONG == 8
1485        if ((r->VarOffset[i] >> 24) >63)
1486      #else
1487        if ((r->VarOffset[i] >> 24) >31)
1488      #endif
1489          dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
1490      if (i > 0 && ((tmp<0) ||(tmp>r->ExpL_Size-1)))
1491      {
1492        dReportError("varoffset out of range for var %d: %d",i,tmp);
1493      }
1494  }
1495  if(r->typ!=NULL)
1496  {
1497    for(j=0;j<r->OrdSize;j++)
1498    {
1499      if ((r->typ[j].ord_typ==ro_dp)
1500      || (r->typ[j].ord_typ==ro_wp)
1501      || (r->typ[j].ord_typ==ro_wp_neg))
1502      {
1503        if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
1504          dReportError("in ordrec %d: start(%d) > end(%d)",j,
1505            r->typ[j].data.dp.start, r->typ[j].data.dp.end);
1506        if ((r->typ[j].data.dp.start < 1)
1507        || (r->typ[j].data.dp.end > r->N))
1508          dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
1509            r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
1510      }
1511    }
1512  }
1513  //assume(r->cf!=NULL);
1514
1515  return TRUE;
1516}
1517#endif
1518
1519static void rO_Align(int &place, int &bitplace)
1520{
1521  // increment place to the next aligned one
1522  // (count as Exponent_t,align as longs)
1523  if (bitplace!=BITS_PER_LONG)
1524  {
1525    place++;
1526    bitplace=BITS_PER_LONG;
1527  }
1528}
1529
1530static void rO_TDegree(int &place, int &bitplace, int start, int end,
1531    long *o, sro_ord &ord_struct)
1532{
1533  // degree (aligned) of variables v_start..v_end, ordsgn 1
1534  rO_Align(place,bitplace);
1535  ord_struct.ord_typ=ro_dp;
1536  ord_struct.data.dp.start=start;
1537  ord_struct.data.dp.end=end;
1538  ord_struct.data.dp.place=place;
1539  o[place]=1;
1540  place++;
1541  rO_Align(place,bitplace);
1542}
1543
1544static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
1545    long *o, sro_ord &ord_struct)
1546{
1547  // degree (aligned) of variables v_start..v_end, ordsgn -1
1548  rO_Align(place,bitplace);
1549  ord_struct.ord_typ=ro_dp;
1550  ord_struct.data.dp.start=start;
1551  ord_struct.data.dp.end=end;
1552  ord_struct.data.dp.place=place;
1553  o[place]=-1;
1554  place++;
1555  rO_Align(place,bitplace);
1556}
1557
1558static void rO_WDegree(int &place, int &bitplace, int start, int end,
1559    long *o, sro_ord &ord_struct, int *weights)
1560{
1561  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
1562  rO_Align(place,bitplace);
1563  ord_struct.ord_typ=ro_wp;
1564  ord_struct.data.wp.start=start;
1565  ord_struct.data.wp.end=end;
1566  ord_struct.data.wp.place=place;
1567  ord_struct.data.wp.weights=weights;
1568  o[place]=1;
1569  place++;
1570  rO_Align(place,bitplace);
1571  int i;
1572  for(i=start;i<=end;i++)
1573  {
1574    if(weights[i-start]<0)
1575    {
1576      ord_struct.ord_typ=ro_wp_neg;
1577      break;
1578    }
1579  }
1580}
1581
1582static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
1583    long *o, sro_ord &ord_struct, int *weights)
1584{
1585  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
1586  rO_Align(place,bitplace);
1587  ord_struct.ord_typ=ro_wp;
1588  ord_struct.data.wp.start=start;
1589  ord_struct.data.wp.end=end;
1590  ord_struct.data.wp.place=place;
1591  ord_struct.data.wp.weights=weights;
1592  o[place]=-1;
1593  place++;
1594  rO_Align(place,bitplace);
1595  int i;
1596  for(i=start;i<=end;i++)
1597  {
1598    if(weights[i-start]<0)
1599    {
1600      ord_struct.ord_typ=ro_wp_neg;
1601      break;
1602    }
1603  }
1604}
1605
1606static void rO_LexVars(int &place, int &bitplace, int start, int end,
1607  int &prev_ord, long *o,int *v, int bits, int opt_var)
1608{
1609  // a block of variables v_start..v_end with lex order, ordsgn 1
1610  int k;
1611  int incr=1;
1612  if(prev_ord==-1) rO_Align(place,bitplace);
1613
1614  if (start>end)
1615  {
1616    incr=-1;
1617  }
1618  for(k=start;;k+=incr)
1619  {
1620    bitplace-=bits;
1621    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
1622    o[place]=1;
1623    v[k]= place | (bitplace << 24);
1624    if (k==end) break;
1625  }
1626  prev_ord=1;
1627  if (opt_var!= -1)
1628  {
1629    assume((opt_var == end+1) ||(opt_var == end-1));
1630    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
1631    int save_bitplace=bitplace;
1632    bitplace-=bits;
1633    if (bitplace < 0)
1634    {
1635      bitplace=save_bitplace;
1636      return;
1637    }
1638    // there is enough space for the optional var
1639    v[opt_var]=place | (bitplace << 24);
1640  }
1641}
1642
1643static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
1644  int &prev_ord, long *o,int *v, int bits, int opt_var)
1645{
1646  // a block of variables v_start..v_end with lex order, ordsgn -1
1647  int k;
1648  int incr=1;
1649  if(prev_ord==1) rO_Align(place,bitplace);
1650
1651  if (start>end)
1652  {
1653    incr=-1;
1654  }
1655  for(k=start;;k+=incr)
1656  {
1657    bitplace-=bits;
1658    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
1659    o[place]=-1;
1660    v[k]=place | (bitplace << 24);
1661    if (k==end) break;
1662  }
1663  prev_ord=-1;
1664//  #if 0
1665  if (opt_var!= -1)
1666  {
1667    assume((opt_var == end+1) ||(opt_var == end-1));
1668    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
1669    int save_bitplace=bitplace;
1670    bitplace-=bits;
1671    if (bitplace < 0)
1672    {
1673      bitplace=save_bitplace;
1674      return;
1675    }
1676    // there is enough space for the optional var
1677    v[opt_var]=place | (bitplace << 24);
1678  }
1679//  #endif
1680}
1681
1682static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
1683    long *o, sro_ord &ord_struct)
1684{
1685  // ordering is derived from component number
1686  rO_Align(place,bitplace);
1687  ord_struct.ord_typ=ro_syzcomp;
1688  ord_struct.data.syzcomp.place=place;
1689  ord_struct.data.syzcomp.Components=NULL;
1690  ord_struct.data.syzcomp.ShiftedComponents=NULL;
1691  o[place]=1;
1692  prev_ord=1;
1693  place++;
1694  rO_Align(place,bitplace);
1695}
1696
1697static void rO_Syz(int &place, int &bitplace, int &prev_ord,
1698    long *o, sro_ord &ord_struct)
1699{
1700  // ordering is derived from component number
1701  // let's reserve one Exponent_t for it
1702  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
1703    rO_Align(place,bitplace);
1704  ord_struct.ord_typ=ro_syz;
1705  ord_struct.data.syz.place=place;
1706  ord_struct.data.syz.limit=0;
1707  ord_struct.data.syz.syz_index = NULL;
1708  ord_struct.data.syz.curr_index = 1;
1709  o[place]= -1;
1710  prev_ord=-1;
1711  place++;
1712}
1713
1714static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
1715{
1716  if (bitmask == 0)
1717  {
1718    bits=16; bitmask=0xffff;
1719  }
1720  else if (bitmask <= 1)
1721  {
1722    bits=1; bitmask = 1;
1723  }
1724  else if (bitmask <= 3)
1725  {
1726    bits=2; bitmask = 3;
1727  }
1728  else if (bitmask <= 7)
1729  {
1730    bits=3; bitmask=7;
1731  }
1732  else if (bitmask <= 0xf)
1733  {
1734    bits=4; bitmask=0xf;
1735  }
1736  else if (bitmask <= 0x1f)
1737  {
1738    bits=5; bitmask=0x1f;
1739  }
1740  else if (bitmask <= 0x3f)
1741  {
1742    bits=6; bitmask=0x3f;
1743  }
1744#if SIZEOF_LONG == 8
1745  else if (bitmask <= 0x7f)
1746  {
1747    bits=7; bitmask=0x7f; /* 64 bit longs only */
1748  }
1749#endif
1750  else if (bitmask <= 0xff)
1751  {
1752    bits=8; bitmask=0xff;
1753  }
1754#if SIZEOF_LONG == 8
1755  else if (bitmask <= 0x1ff)
1756  {
1757    bits=9; bitmask=0x1ff; /* 64 bit longs only */
1758  }
1759#endif
1760  else if (bitmask <= 0x3ff)
1761  {
1762    bits=10; bitmask=0x3ff;
1763  }
1764#if SIZEOF_LONG == 8
1765  else if (bitmask <= 0xfff)
1766  {
1767    bits=12; bitmask=0xfff; /* 64 bit longs only */
1768  }
1769#endif
1770  else if (bitmask <= 0xffff)
1771  {
1772    bits=16; bitmask=0xffff;
1773  }
1774#if SIZEOF_LONG == 8
1775  else if (bitmask <= 0xfffff)
1776  {
1777    bits=20; bitmask=0xfffff; /* 64 bit longs only */
1778  }
1779  else if (bitmask <= 0xffffffff)
1780  {
1781    bits=32; bitmask=0xffffffff;
1782  }
1783  else
1784  {
1785    bits=64; bitmask=0xffffffffffffffff;
1786  }
1787#else
1788  else
1789  {
1790    bits=32; bitmask=0xffffffff;
1791  }
1792#endif
1793  return bitmask;
1794}
1795
1796/*2
1797* optimize rGetExpSize for a block of N variables, exp <=bitmask
1798*/
1799static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
1800{
1801  bitmask =rGetExpSize(bitmask, bits);
1802  int vars_per_long=BIT_SIZEOF_LONG/bits;
1803  int bits1;
1804  loop
1805  {
1806    if (bits == BIT_SIZEOF_LONG)
1807    {
1808      bits =  BIT_SIZEOF_LONG - 1;
1809      return LONG_MAX;
1810    }
1811    unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
1812    int vars_per_long1=BIT_SIZEOF_LONG/bits1;
1813    if ((((N+vars_per_long-1)/vars_per_long) ==
1814         ((N+vars_per_long1-1)/vars_per_long1)))
1815    {
1816      vars_per_long=vars_per_long1;
1817      bits=bits1;
1818      bitmask=bitmask1;
1819    }
1820    else
1821    {
1822      return bitmask; /* and bits */
1823    }
1824  }
1825}
1826
1827/*2
1828 * create a copy of the ring r, which must be equivalent to currRing
1829 * used for std computations
1830 * may share data structures with currRing
1831 * DOES CALL rComplete
1832 */
1833ring rModifyRing(ring r, BOOLEAN omit_degree,
1834                         BOOLEAN omit_comp,
1835                         unsigned long exp_limit)
1836{
1837  assume (r != NULL );
1838  assume (exp_limit > 1);
1839  BOOLEAN need_other_ring;
1840  BOOLEAN omitted_degree = FALSE;
1841  int bits;
1842
1843  exp_limit=rGetExpSize(exp_limit, bits, r->N);
1844  need_other_ring = (exp_limit != r->bitmask);
1845
1846  int nblocks=rBlocks(r);
1847  int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
1848  int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
1849  int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
1850  int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
1851
1852  int i=0;
1853  int j=0; /*  i index in r, j index in res */
1854  loop
1855  {
1856    BOOLEAN copy_block_index=TRUE;
1857    int r_ord=r->order[i];
1858    if (r->block0[i]==r->block1[i])
1859    {
1860      switch(r_ord)
1861      {
1862        case ringorder_wp:
1863        case ringorder_dp:
1864        case ringorder_Wp:
1865        case ringorder_Dp:
1866          r_ord=ringorder_lp;
1867          break;
1868        case ringorder_Ws:
1869        case ringorder_Ds:
1870        case ringorder_ws:
1871        case ringorder_ds:
1872          r_ord=ringorder_ls;
1873          break;
1874        default:
1875          break;
1876      }
1877    }
1878    switch(r_ord)
1879    {
1880      case ringorder_C:
1881      case ringorder_c:
1882        if (!omit_comp)
1883        {
1884          order[j]=r_ord; /*r->order[i]*/;
1885        }
1886        else
1887        {
1888          j--;
1889          need_other_ring=TRUE;
1890          omit_comp=FALSE;
1891          copy_block_index=FALSE;
1892        }
1893        break;
1894      case ringorder_wp:
1895      case ringorder_dp:
1896      case ringorder_ws:
1897      case ringorder_ds:
1898        if(!omit_degree)
1899        {
1900          order[j]=r_ord; /*r->order[i]*/;
1901        }
1902        else
1903        {
1904          order[j]=ringorder_rp;
1905          need_other_ring=TRUE;
1906          omit_degree=FALSE;
1907          omitted_degree = TRUE;
1908        }
1909        break;
1910      case ringorder_Wp:
1911      case ringorder_Dp:
1912      case ringorder_Ws:
1913      case ringorder_Ds:
1914        if(!omit_degree)
1915        {
1916          order[j]=r_ord; /*r->order[i];*/
1917        }
1918        else
1919        {
1920          order[j]=ringorder_lp;
1921          need_other_ring=TRUE;
1922          omit_degree=FALSE;
1923          omitted_degree = TRUE;
1924        }
1925        break;
1926      default:
1927        order[j]=r_ord; /*r->order[i];*/
1928        break;
1929    }
1930    if (copy_block_index)
1931    {
1932      block0[j]=r->block0[i];
1933      block1[j]=r->block1[i];
1934      wvhdl[j]=r->wvhdl[i];
1935    }
1936    i++;j++;
1937    // order[j]=ringorder_no; //  done by omAlloc0
1938    if (i==nblocks) break;
1939  }
1940  if(!need_other_ring)
1941  {
1942    omFreeSize(order,(nblocks+1)*sizeof(int));
1943    omFreeSize(block0,(nblocks+1)*sizeof(int));
1944    omFreeSize(block1,(nblocks+1)*sizeof(int));
1945    omFreeSize(wvhdl,(nblocks+1)*sizeof(int_ptr));
1946    return r;
1947  }
1948  ring res=(ring)omAlloc0Bin(ip_sring_bin);
1949  *res = *r;
1950  // res->qideal, res->idroot ???
1951  res->wvhdl=wvhdl;
1952  res->order=order;
1953  res->block0=block0;
1954  res->block1=block1;
1955  res->bitmask=exp_limit;
1956  int tmpref=r->cf->ref;
1957  rComplete(res, 1);
1958  r->cf->ref=tmpref;
1959
1960  // adjust res->pFDeg: if it was changed globally, then
1961  // it must also be changed for new ring
1962  if (r->pFDegOrig != res->pFDegOrig &&
1963           rOrd_is_WeightedDegree_Ordering(r))
1964  {
1965    // still might need adjustment for weighted orderings
1966    // and omit_degree
1967    res->firstwv = r->firstwv;
1968    res->firstBlockEnds = r->firstBlockEnds;
1969    res->pFDeg = res->pFDegOrig = pWFirstTotalDegree;
1970  }
1971  if (omitted_degree)
1972    res->pLDeg = res->pLDegOrig = r->pLDegOrig;
1973
1974  rOptimizeLDeg(res);
1975
1976  // set syzcomp
1977  if (res->typ != NULL && res->typ[0].ord_typ == ro_syz)
1978  {
1979    res->typ[0] = r->typ[0];
1980    if (r->typ[0].data.syz.limit > 0)
1981    {
1982      res->typ[0].data.syz.syz_index
1983        = (int*) omAlloc((r->typ[0].data.syz.limit +1)*sizeof(int));
1984      memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
1985             (r->typ[0].data.syz.limit +1)*sizeof(int));
1986    }
1987  }
1988  return res;
1989}
1990
1991// construct Wp,C ring
1992ring rModifyRing_Wp(ring r, int* weights)
1993{
1994  ring res=(ring)omAlloc0Bin(ip_sring_bin);
1995  *res = *r;
1996  /*weights: entries for 3 blocks: NULL*/
1997  res->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1998  /*order: dp,C,0*/
1999  res->order = (int *) omAlloc(3 * sizeof(int *));
2000  res->block0 = (int *)omAlloc0(3 * sizeof(int *));
2001  res->block1 = (int *)omAlloc0(3 * sizeof(int *));
2002  /* ringorder dp for the first block: var 1..3 */
2003  res->order[0]  = ringorder_Wp;
2004  res->block0[0] = 1;
2005  res->block1[0] = r->N;
2006  res->wvhdl[0] = weights;
2007  /* ringorder C for the second block: no vars */
2008  res->order[1]  = ringorder_C;
2009  /* the last block: everything is 0 */
2010  res->order[2]  = 0;
2011  /*polynomial ring*/
2012  res->OrdSgn    = 1;
2013
2014  int tmpref=r->cf->ref;
2015  rComplete(res, 1);
2016  r->cf->ref=tmpref;
2017  return res;
2018}
2019
2020// construct lp ring with r->N variables, r->names vars....
2021ring rModifyRing_Simple(ring r, BOOLEAN ommit_degree, BOOLEAN ommit_comp, unsigned long exp_limit, BOOLEAN &simple)
2022{
2023  simple=TRUE;
2024  if (!rHasSimpleOrder(r))
2025  {
2026    simple=FALSE; // sorting needed
2027    assume (r != NULL );
2028    assume (exp_limit > 1);
2029    BOOLEAN omitted_degree = FALSE;
2030    int bits;
2031
2032    exp_limit=rGetExpSize(exp_limit, bits, r->N);
2033
2034    int nblocks=1+(ommit_comp!=0);
2035    int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2036    int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2037    int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2038    int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
2039
2040    order[0]=ringorder_lp;
2041    block0[0]=1;
2042    block1[0]=r->N;
2043    if (!ommit_comp)
2044    {
2045      order[1]=ringorder_C;
2046    }
2047    ring res=(ring)omAlloc0Bin(ip_sring_bin);
2048    *res = *r;
2049    // res->qideal, res->idroot ???
2050    res->wvhdl=wvhdl;
2051    res->order=order;
2052    res->block0=block0;
2053    res->block1=block1;
2054    res->bitmask=exp_limit;
2055    int tmpref=r->cf->ref;
2056    rComplete(res, 1);
2057    r->cf->ref=tmpref;
2058
2059    rOptimizeLDeg(res);
2060
2061    return res;
2062  }
2063  return rModifyRing(r, ommit_degree, ommit_comp, exp_limit);
2064}
2065
2066void rKillModifiedRing_Simple(ring r)
2067{
2068  rKillModifiedRing(r);
2069}
2070
2071
2072void rKillModifiedRing(ring r)
2073{
2074  rUnComplete(r);
2075  omFree(r->order);
2076  omFree(r->block0);
2077  omFree(r->block1);
2078  omFree(r->wvhdl);
2079  omFreeBin(r,ip_sring_bin);
2080}
2081
2082void rKillModified_Wp_Ring(ring r)
2083{
2084  rUnComplete(r);
2085  omFree(r->order);
2086  omFree(r->block0);
2087  omFree(r->block1);
2088  omFree(r->wvhdl[0]);
2089  omFree(r->wvhdl);
2090  omFreeBin(r,ip_sring_bin);
2091}
2092
2093static void rSetOutParams(ring r)
2094{
2095  r->VectorOut = (r->order[0] == ringorder_c);
2096  r->ShortOut = TRUE;
2097#ifdef HAVE_TCL
2098  if (tcllmode)
2099  {
2100    r->ShortOut = FALSE;
2101  }
2102  else
2103#endif
2104  {
2105    int i;
2106    if ((r->parameter!=NULL) && (r->ch<2))
2107    {
2108      for (i=0;i<rPar(r);i++)
2109      {
2110        if(strlen(r->parameter[i])>1)
2111        {
2112          r->ShortOut=FALSE;
2113          break;
2114        }
2115      }
2116    }
2117    if (r->ShortOut)
2118    {
2119      // Hmm... sometimes (e.g., from maGetPreimage) new variables
2120      // are intorduced, but their names are never set
2121      // hence, we do the following awkward trick
2122      int N = omSizeWOfAddr(r->names);
2123      if (r->N < N) N = r->N;
2124
2125      for (i=(N-1);i>=0;i--)
2126      {
2127        if(r->names[i] != NULL && strlen(r->names[i])>1)
2128        {
2129          r->ShortOut=FALSE;
2130          break;
2131        }
2132      }
2133    }
2134  }
2135  r->CanShortOut = r->ShortOut;
2136}
2137
2138/*2
2139* sets pMixedOrder and pComponentOrder for orderings with more than one block
2140* block of variables (ip is the block number, o_r the number of the ordering)
2141* o is the position of the orderingering in r
2142*/
2143static void rHighSet(ring r, int o_r, int o)
2144{
2145  switch(o_r)
2146  {
2147    case ringorder_lp:
2148    case ringorder_dp:
2149    case ringorder_Dp:
2150    case ringorder_wp:
2151    case ringorder_Wp:
2152    case ringorder_rp:
2153    case ringorder_a:
2154    case ringorder_aa:
2155      if (r->OrdSgn==-1) r->MixedOrder=TRUE;
2156      break;
2157    case ringorder_ls:
2158    case ringorder_ds:
2159    case ringorder_Ds:
2160    case ringorder_s:
2161      break;
2162    case ringorder_ws:
2163    case ringorder_Ws:
2164      if (r->wvhdl[o]!=NULL)
2165      {
2166        int i;
2167        for(i=r->block1[o]-r->block0[o];i>=0;i--)
2168          if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
2169      }
2170      break;
2171    case ringorder_c:
2172      r->ComponentOrder=1;
2173      break;
2174    case ringorder_C:
2175    case ringorder_S:
2176      r->ComponentOrder=-1;
2177      break;
2178    case ringorder_M:
2179      r->MixedOrder=TRUE;
2180      break;
2181    default:
2182      dReportError("wrong internal ordering:%d at %s, l:%d\n",o_r,__FILE__,__LINE__);
2183  }
2184}
2185
2186static void rSetFirstWv(ring r, int i, int* order, int* block1, int** wvhdl)
2187{
2188  // cheat for ringorder_aa
2189  if (order[i] == ringorder_aa)
2190    i++;
2191  if(block1[i]!=r->N) r->LexOrder=TRUE;
2192  r->firstBlockEnds=block1[i];
2193  r->firstwv = wvhdl[i];
2194  if ((order[i]== ringorder_ws) || (order[i]==ringorder_Ws))
2195  {
2196    int j;
2197    for(j=block1[i]-r->block0[i];j>=0;j--)
2198      if (r->firstwv[j]<0) { r->MixedOrder=TRUE; break; }
2199  }
2200}
2201
2202static void rOptimizeLDeg(ring r)
2203{
2204  if (r->pFDeg == pDeg)
2205  {
2206    if (r->pLDeg == pLDeg1)
2207      r->pLDeg = pLDeg1_Deg;
2208    if (r->pLDeg == pLDeg1c)
2209      r->pLDeg = pLDeg1c_Deg;
2210  }
2211  else if (r->pFDeg == pTotaldegree)
2212  {
2213    if (r->pLDeg == pLDeg1)
2214      r->pLDeg = pLDeg1_Totaldegree;
2215    if (r->pLDeg == pLDeg1c)
2216      r->pLDeg = pLDeg1c_Totaldegree;
2217  }
2218  else if (r->pFDeg == pWFirstTotalDegree)
2219  {
2220    if (r->pLDeg == pLDeg1)
2221      r->pLDeg = pLDeg1_WFirstTotalDegree;
2222    if (r->pLDeg == pLDeg1c)
2223      r->pLDeg = pLDeg1c_WFirstTotalDegree;
2224  }
2225}
2226
2227// set pFDeg, pLDeg, MixOrder, ComponentOrder, etc
2228static void rSetDegStuff(ring r)
2229{
2230  int* order = r->order;
2231  int* block0 = r->block0;
2232  int* block1 = r->block1;
2233  int** wvhdl = r->wvhdl;
2234
2235  if (order[0]==ringorder_S ||order[0]==ringorder_s)
2236  {
2237    order++;
2238    block0++;
2239    block1++;
2240    wvhdl++;
2241  }
2242  r->LexOrder = FALSE;
2243  r->MixedOrder = FALSE;
2244  r->ComponentOrder = 1;
2245  r->pFDeg = pTotaldegree;
2246  r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
2247
2248  /*======== ordering type is (_,c) =========================*/
2249  if ((order[0]==ringorder_unspec) || (order[1] == 0)
2250      ||(
2251    ((order[1]==ringorder_c)||(order[1]==ringorder_C)
2252     ||(order[1]==ringorder_S)
2253     ||(order[1]==ringorder_s))
2254    && (order[0]!=ringorder_M)
2255    && (order[2]==0))
2256    )
2257  {
2258    if ((order[0]!=ringorder_unspec)
2259    && ((order[1]==ringorder_C)||(order[1]==ringorder_S)||
2260        (order[1]==ringorder_s)))
2261      r->ComponentOrder=-1;
2262    if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
2263    if ((order[0] == ringorder_lp) || (order[0] == ringorder_ls) || order[0] == ringorder_rp)
2264    {
2265      r->LexOrder=TRUE;
2266      r->pLDeg = pLDeg1c;
2267    }
2268    if (order[0] == ringorder_wp || order[0] == ringorder_Wp ||
2269        order[0] == ringorder_ws || order[0] == ringorder_Ws)
2270      r->pFDeg = pWFirstTotalDegree;
2271    r->firstBlockEnds=block1[0];
2272    r->firstwv = wvhdl[0];
2273  }
2274  /*======== ordering type is (c,_) =========================*/
2275  else if (((order[0]==ringorder_c)
2276            ||(order[0]==ringorder_C)
2277            ||(order[0]==ringorder_S)
2278            ||(order[0]==ringorder_s))
2279  && (order[1]!=ringorder_M)
2280  &&  (order[2]==0))
2281  {
2282    if ((order[0]==ringorder_C)||(order[0]==ringorder_S)||
2283        order[0]==ringorder_s)
2284      r->ComponentOrder=-1;
2285    if ((order[1] == ringorder_lp) || (order[1] == ringorder_ls) || order[1] == ringorder_rp)
2286    {
2287      r->LexOrder=TRUE;
2288      r->pLDeg = pLDeg1c;
2289    }
2290    r->firstBlockEnds=block1[1];
2291    r->firstwv = wvhdl[1];
2292    if (order[1] == ringorder_wp || order[1] == ringorder_Wp ||
2293        order[1] == ringorder_ws || order[1] == ringorder_Ws)
2294      r->pFDeg = pWFirstTotalDegree;
2295  }
2296  /*------- more than one block ----------------------*/
2297  else
2298  {
2299    if ((r->VectorOut)||(order[0]==ringorder_C)||(order[0]==ringorder_S)||(order[0]==ringorder_s))
2300    {
2301      rSetFirstWv(r, 1, order, block1, wvhdl);
2302    }
2303    else
2304      rSetFirstWv(r, 0, order, block1, wvhdl);
2305
2306    /*the number of orderings:*/
2307    int i = 0;
2308    while (order[++i] != 0);
2309    do
2310    {
2311      i--;
2312      rHighSet(r, order[i],i);
2313    }
2314    while (i != 0);
2315
2316    if ((order[0]!=ringorder_c)
2317        && (order[0]!=ringorder_C)
2318        && (order[0]!=ringorder_S)
2319        && (order[0]!=ringorder_s))
2320    {
2321      r->pLDeg = pLDeg1c;
2322    }
2323    else
2324    {
2325      r->pLDeg = pLDeg1;
2326    }
2327    r->pFDeg = pWTotaldegree; // may be improved: pTotaldegree for lp/dp/ls/.. blocks
2328  }
2329  if (rOrd_is_Totaldegree_Ordering(r) || rOrd_is_WeightedDegree_Ordering(r))
2330    r->pFDeg = pDeg;
2331
2332  r->pFDegOrig = r->pFDeg;
2333  r->pLDegOrig = r->pLDeg;
2334  rOptimizeLDeg(r);
2335}
2336
2337/*2
2338* set NegWeightL_Size, NegWeightL_Offset
2339*/
2340static void rSetNegWeight(ring r)
2341{
2342  int i,l;
2343  if (r->typ!=NULL)
2344  {
2345    l=0;
2346    for(i=0;i<r->OrdSize;i++)
2347    {
2348      if(r->typ[i].ord_typ==ro_wp_neg) l++;
2349    }
2350    if (l>0)
2351    {
2352      r->NegWeightL_Size=l;
2353      r->NegWeightL_Offset=(int *) omAlloc(l*sizeof(int));
2354      l=0;
2355      for(i=0;i<r->OrdSize;i++)
2356      {
2357        if(r->typ[i].ord_typ==ro_wp_neg)
2358        {
2359          r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
2360          l++;
2361        }
2362      }
2363      return;
2364    }
2365  }
2366  r->NegWeightL_Size = 0;
2367  r->NegWeightL_Offset = NULL;
2368}
2369
2370static void rSetOption(ring r)
2371{
2372  // set redthrough
2373  if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
2374    r->options |= Sy_bit(OPT_REDTHROUGH);
2375  else
2376    r->options &= ~Sy_bit(OPT_REDTHROUGH);
2377
2378  // set intStrategy
2379  if (rField_is_Extension(r) || rField_is_Q(r))
2380    r->options |= Sy_bit(OPT_INTSTRATEGY);
2381  else
2382    r->options &= ~Sy_bit(OPT_INTSTRATEGY);
2383
2384  // set redTail
2385  if (r->LexOrder || r->OrdSgn == -1 || rField_is_Extension(r))
2386    r->options &= ~Sy_bit(OPT_REDTAIL);
2387  else
2388    r->options |= Sy_bit(OPT_REDTAIL);
2389}
2390
2391BOOLEAN rComplete(ring r, int force)
2392{
2393  if (r->VarOffset!=NULL && force == 0) return FALSE;
2394  nInitChar(r);
2395  rSetOutParams(r);
2396  int n=rBlocks(r)-1;
2397  int i;
2398  int bits;
2399  r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
2400  r->BitsPerExp = bits;
2401  r->ExpPerLong = BIT_SIZEOF_LONG / bits;
2402  r->divmask=rGetDivMask(bits);
2403
2404  // will be used for ordsgn:
2405  long *tmp_ordsgn=(long *)omAlloc0(2*(n+r->N)*sizeof(long));
2406  // will be used for VarOffset:
2407  int *v=(int *)omAlloc((r->N+1)*sizeof(int));
2408  for(i=r->N; i>=0 ; i--)
2409  {
2410    v[i]=-1;
2411  }
2412  sro_ord *tmp_typ=(sro_ord *)omAlloc0(2*(n+r->N)*sizeof(sro_ord));
2413  int typ_i=0;
2414  int prev_ordsgn=0;
2415
2416  // fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
2417  int j=0;
2418  int j_bits=BITS_PER_LONG;
2419  BOOLEAN need_to_add_comp=FALSE;
2420  for(i=0;i<n;i++)
2421  {
2422    tmp_typ[typ_i].order_index=i;
2423    switch (r->order[i])
2424    {
2425      case ringorder_a:
2426      case ringorder_aa:
2427        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2428                   r->wvhdl[i]);
2429        typ_i++;
2430        break;
2431
2432      case ringorder_c:
2433        rO_Align(j, j_bits);
2434        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2435        break;
2436
2437      case ringorder_C:
2438        rO_Align(j, j_bits);
2439        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2440        break;
2441
2442      case ringorder_M:
2443        {
2444          int k,l;
2445          k=r->block1[i]-r->block0[i]+1; // number of vars
2446          for(l=0;l<k;l++)
2447          {
2448            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2449                       tmp_typ[typ_i],
2450                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
2451            typ_i++;
2452          }
2453          break;
2454        }
2455
2456      case ringorder_lp:
2457        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2458                   tmp_ordsgn,v,bits, -1);
2459        break;
2460
2461      case ringorder_ls:
2462        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2463                       tmp_ordsgn,v, bits, -1);
2464        break;
2465
2466      case ringorder_rp:
2467        rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
2468                       tmp_ordsgn,v, bits, -1);
2469        break;
2470
2471      case ringorder_dp:
2472        if (r->block0[i]==r->block1[i])
2473        {
2474          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
2475                     tmp_ordsgn,v, bits, -1);
2476        }
2477        else
2478        {
2479          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2480                     tmp_typ[typ_i]);
2481          typ_i++;
2482          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2483                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
2484        }
2485        break;
2486
2487      case ringorder_Dp:
2488        if (r->block0[i]==r->block1[i])
2489        {
2490          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
2491                     tmp_ordsgn,v, bits, -1);
2492        }
2493        else
2494        {
2495          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2496                     tmp_typ[typ_i]);
2497          typ_i++;
2498          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2499                     tmp_ordsgn,v, bits, r->block1[i]);
2500        }
2501        break;
2502
2503      case ringorder_ds:
2504        if (r->block0[i]==r->block1[i])
2505        {
2506          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
2507                         tmp_ordsgn,v,bits, -1);
2508        }
2509        else
2510        {
2511          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2512                         tmp_typ[typ_i]);
2513          typ_i++;
2514          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2515                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
2516        }
2517        break;
2518
2519      case ringorder_Ds:
2520        if (r->block0[i]==r->block1[i])
2521        {
2522          rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
2523                         tmp_ordsgn,v, bits, -1);
2524        }
2525        else
2526        {
2527          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2528                         tmp_typ[typ_i]);
2529          typ_i++;
2530          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2531                     tmp_ordsgn,v, bits, r->block1[i]);
2532        }
2533        break;
2534
2535      case ringorder_wp:
2536        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2537                   tmp_typ[typ_i], r->wvhdl[i]);
2538        typ_i++;
2539        if (r->block1[i]!=r->block0[i])
2540        {
2541          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2542                         tmp_ordsgn, v,bits, r->block0[i]);
2543        }
2544        break;
2545
2546      case ringorder_Wp:
2547        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2548                   tmp_typ[typ_i], r->wvhdl[i]);
2549        typ_i++;
2550        if (r->block1[i]!=r->block0[i])
2551        {
2552          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2553                     tmp_ordsgn,v, bits, r->block1[i]);
2554        }
2555        break;
2556
2557      case ringorder_ws:
2558        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2559                       tmp_typ[typ_i], r->wvhdl[i]);
2560        typ_i++;
2561        if (r->block1[i]!=r->block0[i])
2562        {
2563          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2564                         tmp_ordsgn, v,bits, r->block0[i]);
2565        }
2566        break;
2567
2568      case ringorder_Ws:
2569        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2570                       tmp_typ[typ_i], r->wvhdl[i]);
2571        typ_i++;
2572        if (r->block1[i]!=r->block0[i])
2573        {
2574          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2575                     tmp_ordsgn,v, bits, r->block1[i]);
2576        }
2577        break;
2578
2579      case ringorder_S:
2580        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2581        need_to_add_comp=TRUE;
2582        typ_i++;
2583        break;
2584
2585      case ringorder_s:
2586        rO_Syz(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2587        need_to_add_comp=TRUE;
2588        typ_i++;
2589        break;
2590
2591      case ringorder_unspec:
2592      case ringorder_no:
2593      default:
2594        dReportError("undef. ringorder used\n");
2595        break;
2596    }
2597  }
2598
2599  int j0=j; // save j
2600  int j_bits0=j_bits; // save jbits
2601  rO_Align(j,j_bits);
2602  r->CmpL_Size = j;
2603
2604  j_bits=j_bits0; j=j0;
2605
2606  // fill in some empty slots with variables not already covered
2607  // v0 is special, is therefore normally already covered
2608  // now we do have rings without comp...
2609  if((need_to_add_comp) && (v[0]== -1))
2610  {
2611    if (prev_ordsgn==1)
2612    {
2613      rO_Align(j, j_bits);
2614      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2615    }
2616    else
2617    {
2618      rO_Align(j, j_bits);
2619      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2620    }
2621  }
2622  // the variables
2623  for(i=1 ; i<r->N+1 ; i++)
2624  {
2625    if(v[i]==(-1))
2626    {
2627      if (prev_ordsgn==1)
2628      {
2629        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
2630      }
2631      else
2632      {
2633        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
2634      }
2635    }
2636  }
2637
2638  rO_Align(j,j_bits);
2639  // ----------------------------
2640  // finished with constructing the monomial, computing sizes:
2641
2642  r->ExpL_Size=j;
2643  r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
2644  assume(r->PolyBin != NULL);
2645
2646  // ----------------------------
2647  // indices and ordsgn vector for comparison
2648  //
2649  // r->pCompHighIndex already set
2650  r->ordsgn=(long *)omAlloc0(r->ExpL_Size*sizeof(long));
2651
2652  for(j=0;j<r->CmpL_Size;j++)
2653  {
2654    r->ordsgn[j] = tmp_ordsgn[j];
2655  }
2656
2657  omFreeSize((ADDRESS)tmp_ordsgn,(2*(n+r->N)*sizeof(long)));
2658
2659  // ----------------------------
2660  // description of orderings for setm:
2661  //
2662  r->OrdSize=typ_i;
2663  if (typ_i==0) r->typ=NULL;
2664  else
2665  {
2666    r->typ=(sro_ord*)omAlloc(typ_i*sizeof(sro_ord));
2667    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
2668  }
2669  omFreeSize((ADDRESS)tmp_typ,(2*(n+r->N)*sizeof(sro_ord)));
2670
2671  // ----------------------------
2672  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
2673  r->VarOffset=v;
2674
2675  // ----------------------------
2676  // other indicies
2677  r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
2678  i=0; // position
2679  j=0; // index in r->typ
2680  if (i==r->pCompIndex) i++;
2681  while ((j < r->OrdSize)
2682         && ((r->typ[j].ord_typ==ro_syzcomp) ||
2683             (r->typ[j].ord_typ==ro_syz) ||
2684             (r->order[r->typ[j].order_index] == ringorder_aa)))
2685  {
2686    i++; j++;
2687  }
2688  if (i==r->pCompIndex) i++;
2689  r->pOrdIndex=i;
2690
2691  // ----------------------------
2692  rSetDegStuff(r);
2693  rSetOption(r);
2694  // ----------------------------
2695  // r->p_Setm
2696  r->p_Setm = p_GetSetmProc(r);
2697
2698  // ----------------------------
2699  // set VarL_*
2700  rSetVarL(r);
2701
2702  //  ----------------------------
2703  // right-adjust VarOffset
2704  rRightAdjustVarOffset(r);
2705
2706  // ----------------------------
2707  // set NegWeightL*
2708  rSetNegWeight(r);
2709
2710  // ----------------------------
2711  // p_Procs: call AFTER NegWeightL
2712  r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
2713  p_ProcsSet(r, r->p_Procs);
2714
2715  return FALSE;
2716}
2717
2718void rUnComplete(ring r)
2719{
2720  if (r == NULL) return;
2721  if (r->VarOffset != NULL)
2722  {
2723    if (r->PolyBin != NULL)
2724      omUnGetSpecBin(&(r->PolyBin));
2725
2726    omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
2727    if (r->order != NULL)
2728    {
2729      if (r->order[0] == ringorder_s && r->typ[0].data.syz.limit > 0)
2730      {
2731        omFreeSize(r->typ[0].data.syz.syz_index,
2732             (r->typ[0].data.syz.limit +1)*sizeof(int));
2733      }
2734    }
2735    if (r->OrdSize!=0 && r->typ != NULL)
2736    {
2737      omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord));
2738    }
2739    if (r->ordsgn != NULL && r->CmpL_Size != 0)
2740      omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
2741    if (r->p_Procs != NULL)
2742      omFreeSize(r->p_Procs, sizeof(p_Procs_s));
2743    omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
2744  }
2745  if (r->NegWeightL_Offset!=NULL)
2746  {
2747    omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
2748    r->NegWeightL_Offset=NULL;
2749  }
2750}
2751
2752// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
2753static void rSetVarL(ring r)
2754{
2755  int  min = INT_MAX, min_j = -1;
2756  int* VarL_Number = (int*) omAlloc0(r->ExpL_Size*sizeof(int));
2757
2758  int i,j;
2759
2760  // count how often a var long is occupied by an exponent
2761  for (i=1; i<=r->N; i++)
2762  {
2763    VarL_Number[r->VarOffset[i] & 0xffffff]++;
2764  }
2765
2766  // determine how many and min
2767  for (i=0, j=0; i<r->ExpL_Size; i++)
2768  {
2769    if (VarL_Number[i] != 0)
2770    {
2771      if (min > VarL_Number[i])
2772      {
2773        min = VarL_Number[i];
2774        min_j = j;
2775      }
2776      j++;
2777    }
2778  }
2779
2780  r->VarL_Size = j;
2781  r->VarL_Offset = (int*) omAlloc(r->VarL_Size*sizeof(int));
2782  r->VarL_LowIndex = 0;
2783
2784  // set VarL_Offset
2785  for (i=0, j=0; i<r->ExpL_Size; i++)
2786  {
2787    if (VarL_Number[i] != 0)
2788    {
2789      r->VarL_Offset[j] = i;
2790      if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
2791        r->VarL_LowIndex = -1;
2792      j++;
2793    }
2794  }
2795  if (r->VarL_LowIndex >= 0)
2796    r->VarL_LowIndex = r->VarL_Offset[0];
2797
2798  r->MinExpPerLong = min;
2799  if (min_j != 0)
2800  {
2801    j = r->VarL_Offset[min_j];
2802    r->VarL_Offset[min_j] = r->VarL_Offset[0];
2803    r->VarL_Offset[0] = j;
2804  }
2805  omFree(VarL_Number);
2806}
2807
2808static void rRightAdjustVarOffset(ring r)
2809{
2810  int* shifts = (int*) omAlloc(r->ExpL_Size*sizeof(int));
2811  int i;
2812  // initialize shifts
2813  for (i=0;i<r->ExpL_Size;i++)
2814    shifts[i] = BIT_SIZEOF_LONG;
2815
2816  // find minimal bit in each long var
2817  for (i=1;i<=r->N;i++)
2818  {
2819    if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
2820      shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
2821  }
2822  // reset r->VarOffset
2823  for (i=1;i<=r->N;i++)
2824  {
2825    if (shifts[r->VarOffset[i] & 0xffffff] != 0)
2826      r->VarOffset[i]
2827        = (r->VarOffset[i] & 0xffffff) |
2828        (((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
2829  }
2830  omFree(shifts);
2831}
2832
2833// get r->divmask depending on bits per exponent
2834static unsigned long rGetDivMask(int bits)
2835{
2836  unsigned long divmask = 1;
2837  int i = bits;
2838
2839  while (i < BIT_SIZEOF_LONG)
2840  {
2841    divmask |= (((unsigned long) 1) << (unsigned long) i);
2842    i += bits;
2843  }
2844  return divmask;
2845}
2846
2847#ifdef RDEBUG
2848void rDebugPrint(ring r)
2849{
2850  if (r==NULL)
2851  {
2852    PrintS("NULL ?\n");
2853    return;
2854  }
2855  char *TYP[]={"ro_dp","ro_wp","ro_wp_neg","ro_cp",
2856               "ro_syzcomp", "ro_syz", "ro_none"};
2857  int i,j;
2858
2859  Print("ExpL_Size:%d ",r->ExpL_Size);
2860  Print("CmpL_Size:%d ",r->CmpL_Size);
2861  Print("VarL_Size:%d\n",r->VarL_Size);
2862  Print("bitmask=0x%x (expbound=%d) \n",r->bitmask, r->bitmask);
2863  Print("BitsPerExp=%d ExpPerLong=%d MinExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->MinExpPerLong, r->VarL_Offset[0]);
2864  PrintS("varoffset:\n");
2865  if (r->VarOffset==NULL) PrintS(" NULL\n");
2866  else
2867    for(j=0;j<=r->N;j++)
2868      Print("  v%d at e-pos %d, bit %d\n",
2869            j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
2870  Print("divmask=%p\n", r->divmask);
2871  PrintS("ordsgn:\n");
2872  for(j=0;j<r->CmpL_Size;j++)
2873    Print("  ordsgn %d at pos %d\n",r->ordsgn[j],j);
2874  Print("OrdSgn:%d\n",r->OrdSgn);
2875  PrintS("ordrec:\n");
2876  for(j=0;j<r->OrdSize;j++)
2877  {
2878    Print("  typ %s",TYP[r->typ[j].ord_typ]);
2879    Print("  place %d",r->typ[j].data.dp.place);
2880    if (r->typ[j].ord_typ!=ro_syzcomp)
2881    {
2882      Print("  start %d",r->typ[j].data.dp.start);
2883      Print("  end %d",r->typ[j].data.dp.end);
2884      if (r->typ[j].ord_typ==ro_wp)
2885      {
2886        Print(" w:");
2887        int l;
2888        for(l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
2889          Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
2890      }
2891    }
2892    PrintLn();
2893  }
2894  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
2895  Print("OrdSize:%d\n",r->OrdSize);
2896  PrintS("--------------------\n");
2897  for(j=0;j<r->ExpL_Size;j++)
2898  {
2899    Print("L[%d]: ",j);
2900    if (j< r->CmpL_Size)
2901      Print("ordsgn %d ", r->ordsgn[j]);
2902    else
2903      PrintS("no comp ");
2904    i=1;
2905    for(;i<=r->N;i++)
2906    {
2907      if( (r->VarOffset[i] & 0xffffff) == j )
2908      {  Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
2909                                         r->VarOffset[i] >>24 ); }
2910    }
2911    if( r->pCompIndex==j ) PrintS("v0; ");
2912    for(i=0;i<r->OrdSize;i++)
2913    {
2914      if (r->typ[i].data.dp.place == j)
2915      {
2916        Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
2917          r->typ[i].data.dp.start, r->typ[i].data.dp.end);
2918      }
2919    }
2920
2921    if (j==r->pOrdIndex)
2922      PrintS("pOrdIndex\n");
2923    else
2924      PrintLn();
2925  }
2926
2927  // p_Procs stuff
2928  p_Procs_s proc_names;
2929  char* field;
2930  char* length;
2931  char* ord;
2932  p_Debug_GetProcNames(r, &proc_names);
2933  p_Debug_GetSpecNames(r, field, length, ord);
2934
2935  Print("p_Spec  : %s, %s, %s\n", field, length, ord);
2936  PrintS("p_Procs :\n");
2937  for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
2938  {
2939    Print(" %s,\n", ((char**) &proc_names)[i]);
2940  }
2941}
2942
2943void pDebugPrintR(poly p, ring r)
2944{
2945  int i,j;
2946  pWrite(p);
2947  j=2;
2948  while(p!=NULL)
2949  {
2950    Print("\nexp[0..%d]\n",r->ExpL_Size-1);
2951    for(i=0;i<r->ExpL_Size;i++)
2952      Print("%d ",p->exp[i]);
2953    PrintLn();
2954    Print("v0:%d ",p_GetComp(p, r));
2955    for(i=1;i<=r->N;i++) Print(" v%d:%d",i,p_GetExp(p,i, r));
2956    PrintLn();
2957    pIter(p);
2958    j--;
2959    if (j==0) { PrintS("...\n"); break; }
2960  }
2961}
2962
2963void pDebugPrint(poly p)
2964{
2965  pDebugPrintR(p, currRing);
2966}
2967#endif // RDEBUG
2968
2969
2970/*2
2971* asssume that rComplete was called with r
2972* assume that the first block ist ringorder_S
2973* change the block to reflect the sequence given by appending v
2974*/
2975
2976#ifdef PDEBUG
2977void rDBChangeSComps(int* currComponents,
2978                     long* currShiftedComponents,
2979                     int length,
2980                     ring r)
2981{
2982  r->typ[1].data.syzcomp.length = length;
2983  rNChangeSComps( currComponents, currShiftedComponents, r);
2984}
2985void rDBGetSComps(int** currComponents,
2986                 long** currShiftedComponents,
2987                 int *length,
2988                 ring r)
2989{
2990  *length = r->typ[1].data.syzcomp.length;
2991  rNGetSComps( currComponents, currShiftedComponents, r);
2992}
2993#endif
2994
2995void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
2996{
2997  assume(r->order[1]==ringorder_S);
2998
2999  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
3000  r->typ[1].data.syzcomp.Components = currComponents;
3001}
3002
3003void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
3004{
3005  assume(r->order[1]==ringorder_S);
3006
3007  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
3008  *currComponents =   r->typ[1].data.syzcomp.Components;
3009}
3010
3011/////////////////////////////////////////////////////////////////////////////
3012//
3013// The following routines all take as input a ring r, and return R
3014// where R has a certain property. P might be equal r in which case r
3015// had already this property
3016//
3017// Without argument, these functions work on currRing and change it,
3018// if necessary
3019
3020// for the time being, this is still here
3021static ring rAssure_SyzComp(ring r, BOOLEAN complete = TRUE);
3022
3023ring rCurrRingAssure_SyzComp()
3024{
3025  ring r = rAssure_SyzComp(currRing);
3026  if (r != currRing)
3027  {
3028    ring old_ring = currRing;
3029    rChangeCurrRing(r);
3030    if (old_ring->qideal != NULL)
3031    {
3032      r->qideal = idrCopyR_NoSort(old_ring->qideal, old_ring);
3033      assume(idRankFreeModule(r->qideal) == 0);
3034      currQuotient = r->qideal;
3035    }
3036  }
3037  return r;
3038}
3039
3040static ring rAssure_SyzComp(ring r, BOOLEAN complete)
3041{
3042  if (r->order[0] == ringorder_s) return r;
3043  ring res=rCopy0(r, FALSE, FALSE);
3044  int i=rBlocks(r);
3045  int j;
3046
3047  res->order=(int *)omAlloc0((i+1)*sizeof(int));
3048  for(j=i;j>0;j--) res->order[j]=r->order[j-1];
3049  res->order[0]=ringorder_s;
3050
3051  res->block0=(int *)omAlloc0((i+1)*sizeof(int));
3052  for(j=i;j>0;j--) res->block0[j]=r->block0[j-1];
3053
3054  res->block1=(int *)omAlloc0((i+1)*sizeof(int));
3055  for(j=i;j>0;j--) res->block1[j]=r->block1[j-1];
3056
3057  int ** wvhdl =(int **)omAlloc0((i+1)*sizeof(int**));
3058  for(j=i;j>0;j--)
3059  {
3060    if (r->wvhdl[j-1] != NULL)
3061    {
3062      wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
3063    }
3064  }
3065  res->wvhdl = wvhdl;
3066
3067  if (complete) rComplete(res, 1);
3068  return res;
3069}
3070
3071static ring rAssure_CompLastBlock(ring r, BOOLEAN complete = TRUE)
3072{
3073  int last_block = rBlocks(r) - 2;
3074  if (r->order[last_block] != ringorder_c &&
3075      r->order[last_block] != ringorder_C)
3076  {
3077    int c_pos = 0;
3078    int i;
3079
3080    for (i=0; i< last_block; i++)
3081    {
3082      if (r->order[i] == ringorder_c || r->order[i] == ringorder_C)
3083      {
3084        c_pos = i;
3085        break;
3086      }
3087    }
3088    if (c_pos != -1)
3089    {
3090      ring new_r = rCopy0(r, FALSE, TRUE);
3091      for (i=c_pos+1; i<=last_block; i++)
3092      {
3093        new_r->order[i-1] = new_r->order[i];
3094        new_r->block0[i-1] = new_r->block0[i];
3095        new_r->block1[i-1] = new_r->block1[i];
3096        new_r->wvhdl[i-1] = new_r->wvhdl[i];
3097      }
3098      new_r->order[last_block] = r->order[c_pos];
3099      new_r->block0[last_block] = r->block0[c_pos];
3100      new_r->block1[last_block] = r->block1[c_pos];
3101      new_r->wvhdl[last_block] = r->wvhdl[c_pos];
3102      if (complete) rComplete(new_r, 1);
3103      return new_r;
3104    }
3105  }
3106  return r;
3107}
3108
3109ring rCurrRingAssure_CompLastBlock()
3110{
3111  ring new_r = rAssure_CompLastBlock(currRing);
3112  if (currRing != new_r)
3113  {
3114    ring old_r = currRing;
3115    rChangeCurrRing(new_r);
3116    if (old_r->qideal != NULL)
3117    {
3118      new_r->qideal = idrCopyR(old_r->qideal, old_r);
3119      currQuotient = new_r->qideal;
3120    }
3121  }
3122  return new_r;
3123}
3124
3125ring rCurrRingAssure_SyzComp_CompLastBlock()
3126{
3127  ring new_r_1 = rAssure_CompLastBlock(currRing, FALSE);
3128  ring new_r = rAssure_SyzComp(new_r_1, FALSE);
3129
3130  if (new_r != currRing)
3131  {
3132    ring old_r = currRing;
3133    if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
3134    rComplete(new_r, 1);
3135    rChangeCurrRing(new_r);
3136    if (old_r->qideal != NULL)
3137    {
3138      new_r->qideal = idrCopyR(old_r->qideal, old_r);
3139      currQuotient = new_r->qideal;
3140    }
3141    rTest(new_r);
3142    rTest(old_r);
3143  }
3144  return new_r;
3145}
3146
3147// use this for global orderings consisting of two blocks
3148static ring rCurrRingAssure_Global(rRingOrder_t b1, rRingOrder_t b2)
3149{
3150  int r_blocks = rBlocks(currRing);
3151  int i;
3152
3153  assume(b1 == ringorder_c || b1 == ringorder_C ||
3154         b2 == ringorder_c || b2 == ringorder_C ||
3155         b2 == ringorder_S);
3156  if ((r_blocks == 3) &&
3157      (currRing->order[0] == b1) &&
3158      (currRing->order[1] == b2) &&
3159      (currRing->order[2] == 0))
3160    return currRing;
3161  ring res = rCopy0(currRing, TRUE, FALSE);
3162  res->order = (int*)omAlloc0(3*sizeof(int));
3163  res->block0 = (int*)omAlloc0(3*sizeof(int));
3164  res->block1 = (int*)omAlloc0(3*sizeof(int));
3165  res->wvhdl = (int**)omAlloc0(3*sizeof(int*));
3166  res->order[0] = b1;
3167  res->order[1] = b2;
3168  if (b1 == ringorder_c || b1 == ringorder_C)
3169  {
3170    res->block0[1] = 1;
3171    res->block1[1] = currRing->N;
3172  }
3173  else
3174  {
3175    res->block0[0] = 1;
3176    res->block1[0] = currRing->N;
3177  }
3178  // HANNES: This sould be set in rComplete
3179  res->OrdSgn = 1;
3180  rComplete(res, 1);
3181  rChangeCurrRing(res);
3182  return res;
3183}
3184
3185
3186ring rCurrRingAssure_dp_S()
3187{
3188  return rCurrRingAssure_Global(ringorder_dp, ringorder_S);
3189}
3190
3191ring rCurrRingAssure_dp_C()
3192{
3193  return rCurrRingAssure_Global(ringorder_dp, ringorder_C);
3194}
3195
3196ring rCurrRingAssure_C_dp()
3197{
3198  return rCurrRingAssure_Global(ringorder_C, ringorder_dp);
3199}
3200
3201
3202void rSetSyzComp(int k)
3203{
3204  if (TEST_OPT_PROT) Print("{%d}", k);
3205  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz))
3206  {
3207    assume(k > currRing->typ[0].data.syz.limit);
3208    int i;
3209    if (currRing->typ[0].data.syz.limit == 0)
3210    {
3211      currRing->typ[0].data.syz.syz_index = (int*) omAlloc0((k+1)*sizeof(int));
3212      currRing->typ[0].data.syz.syz_index[0] = 0;
3213      currRing->typ[0].data.syz.curr_index = 1;
3214    }
3215    else
3216    {
3217      currRing->typ[0].data.syz.syz_index = (int*)
3218        omReallocSize(currRing->typ[0].data.syz.syz_index,
3219                (currRing->typ[0].data.syz.limit+1)*sizeof(int),
3220                (k+1)*sizeof(int));
3221    }
3222    for (i=currRing->typ[0].data.syz.limit + 1; i<= k; i++)
3223    {
3224      currRing->typ[0].data.syz.syz_index[i] =
3225        currRing->typ[0].data.syz.curr_index;
3226    }
3227    currRing->typ[0].data.syz.limit = k;
3228    currRing->typ[0].data.syz.curr_index++;
3229  }
3230  else if ((currRing->order[0]!=ringorder_c) && (k!=0))
3231  {
3232    dReportError("syzcomp in incompatible ring");
3233  }
3234#ifdef PDEBUG
3235  extern int pDBsyzComp;
3236  pDBsyzComp=k;
3237#endif
3238}
3239
3240// return the max-comonent wchich has syzIndex i
3241int rGetMaxSyzComp(int i)
3242{
3243  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz) &&
3244      currRing->typ[0].data.syz.limit > 0 && i > 0)
3245  {
3246    assume(i <= currRing->typ[0].data.syz.limit);
3247    int j;
3248    for (j=0; j<currRing->typ[0].data.syz.limit; j++)
3249    {
3250      if (currRing->typ[0].data.syz.syz_index[j] == i  &&
3251          currRing->typ[0].data.syz.syz_index[j+1] != i)
3252      {
3253        assume(currRing->typ[0].data.syz.syz_index[j+1] == i+1);
3254        return j;
3255      }
3256    }
3257    return currRing->typ[0].data.syz.limit;
3258  }
3259  else
3260  {
3261    return 0;
3262  }
3263}
3264
3265BOOLEAN rRing_is_Homog(ring r)
3266{
3267  if (r == NULL) return FALSE;
3268  int i, j, nb = rBlocks(r);
3269  for (i=0; i<nb; i++)
3270  {
3271    if (r->wvhdl[i] != NULL)
3272    {
3273      int length = r->block1[i] - r->block0[i];
3274      int* wvhdl = r->wvhdl[i];
3275      if (r->order[i] == ringorder_M) length *= length;
3276      assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
3277
3278      for (j=0; j< length; j++)
3279      {
3280        if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
3281      }
3282    }
3283  }
3284  return TRUE;
3285}
3286
3287BOOLEAN rRing_has_CompLastBlock(ring r)
3288{
3289  assume(r != NULL);
3290  int lb = rBlocks(r) - 2;
3291  return (r->order[lb] == ringorder_c || r->order[lb] == ringorder_C);
3292}
3293
3294n_coeffType rFieldType(ring r)
3295{
3296  if (rField_is_Zp(r))     return n_Zp;
3297  if (rField_is_Q(r))      return n_Q;
3298  if (rField_is_R(r))      return n_R;
3299  if (rField_is_GF(r))     return n_GF;
3300  if (rField_is_long_R(r)) return n_long_R;
3301  if (rField_is_Zp_a(r))   return n_Zp_a;
3302  if (rField_is_Q_a(r))    return n_Q_a;
3303  if (rField_is_long_C(r)) return n_long_C;
3304  return n_unknown;
3305}
3306
3307int * rGetWeightVec(ring r)
3308{
3309  assume(r!=NULL);
3310  assume(r->OrdSize>0);
3311  assume(r->typ[0].ord_typ==ro_wp);
3312  return (r->typ[0].data.wp.weights);
3313}
3314
3315void rSetWeightVec(ring r, int *wv)
3316{
3317  assume(r!=NULL);
3318  assume(r->OrdSize>0);
3319  assume(r->typ[0].ord_typ==ro_wp);
3320  memcpy(r->typ[0].data.wp.weights,wv,r->N*sizeof(int));
3321}
3322
Note: See TracBrowser for help on using the repository browser.