source: git/kernel/ring.cc @ dbd824

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