source: git/kernel/ring.cc @ 935bb1b

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