source: git/kernel/ring.cc @ 39e776

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