source: git/Singular/ring.cc @ c38d39f

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