source: git/kernel/ring.cc @ 59aa94

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