source: git/Singular/ring.cc @ 416465

spielwiese
Last change on this file since 416465 was 416465, checked in by Olaf Bachmann <obachman@…>, 24 years ago
* bug-fixes from work with Thomas git-svn-id: file:///usr/local/Singular/svn/trunk@3826 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 85.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.82 1999-11-15 17:20:44 obachman 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 "mmemory.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
31#define BITS_PER_LONG 8*SIZEOF_LONG
32
33static const char * const ringorder_name[] =
34{
35  " ?", //ringorder_no = 0,
36  "a", //ringorder_a,
37  "c", //ringorder_c,
38  "C", //ringorder_C,
39  "M", //ringorder_M,
40  "S", //ringorder_S,
41  "s", //ringorder_s,
42  "lp", //ringorder_lp,
43  "dp", //ringorder_dp,
44  "Dp", //ringorder_Dp,
45  "wp", //ringorder_wp,
46  "Wp", //ringorder_Wp,
47  "ls", //ringorder_ls,
48  "ds", //ringorder_ds,
49  "Ds", //ringorder_Ds,
50  "ws", //ringorder_ws,
51  "Ws", //ringorder_Ws,
52  #ifdef HAVE_SHIFTED_EXPONENTS
53  "L", //ringorder_L,
54  #endif
55  " _" //ringorder_unspec
56};
57
58static inline const char * rSimpleOrdStr(int ord)
59{
60  return ringorder_name[ord];
61}
62
63// unconditionally deletes fields in r
64static void rDelete(ring r);
65
66/*0 implementation*/
67//BOOLEAN rField_is_R(ring r=currRing)
68//{
69//  if (r->ch== -1)
70//  {
71//    if (r->ch_flags==(short)0) return TRUE;
72//  }
73//  return FALSE;
74//}
75
76// internally changes the gloabl ring and resets the relevant
77// global variables:
78// complete == FALSE : only delete operations are enabled
79// complete == TRUE  : full reset of all variables
80void rChangeCurrRing(ring r, BOOLEAN complete)
81{
82  rTest(r);
83  /*------------ set global ring vars --------------------------------*/
84  currRing = r;
85  currQuotient=NULL;
86  if (r != NULL)
87  {
88    if (complete)
89    {
90      /*------------ set global ring vars --------------------------------*/
91      currQuotient=r->qideal;
92      /*------------ set redTail, except reset by nSetChar or pSetGlobals */
93      test |= Sy_bit(OPT_REDTAIL);
94    }
95
96    /*------------ global variables related to coefficients ------------*/
97    nSetChar(r, complete);
98
99    /*------------ global variables related to polys -------------------*/
100    pSetGlobals(r, complete);
101
102
103    if (complete)
104    {
105    /*------------ set naMinimalPoly -----------------------------------*/
106      if (r->minpoly!=NULL)
107      {
108        naMinimalPoly=((lnumber)r->minpoly)->z;
109      }
110
111    /*------------ Garbage Collection -----------------------------------*/
112//      mmGarbageCollectHeaps(2);
113    }
114  }
115}
116
117void rSetHdl(idhdl h, BOOLEAN complete)
118{
119  int i;
120  ring rg = NULL;
121  if (h!=NULL)
122  {
123    rg = IDRING(h);
124    mmTestP((ADDRESS)h,sizeof(idrec));
125    mmTestLP((ADDRESS)IDID(h));
126    rTest(rg);
127  }
128  else complete=FALSE;
129
130  // clean up history
131    if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
132        || ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
133    {
134      sLastPrinted.CleanUp();
135      memset(&sLastPrinted,0,sizeof(sleftv));
136    }
137
138   /*------------ change the global ring -----------------------*/
139  rChangeCurrRing(rg,complete);
140  currRingHdl = h;
141
142    /*------------ set pShortOut -----------------------*/
143  if (complete /*&&(h!=NULL)*/)
144  {
145    #ifdef HAVE_TCL
146    if (tclmode)
147    {
148      PrintTCLS('R',IDID(h));
149      pShortOut=(int)FALSE;
150    }
151    else
152    #endif
153    {
154      pShortOut=(int)TRUE;
155      if ((rg->parameter!=NULL) && (rg->ch<2))
156      {
157        for (i=0;i<rPar(rg);i++)
158        {
159          if(strlen(rg->parameter[i])>1)
160          {
161            pShortOut=(int)FALSE;
162            break;
163          }
164        }
165      }
166      if (pShortOut)
167      {
168        for (i=(rg->N-1);i>=0;i--)
169        {
170          if(strlen(rg->names[i])>1)
171          {
172            pShortOut=(int)FALSE;
173            break;
174          }
175        }
176      }
177    }
178  }
179
180}
181
182idhdl rDefault(char *s)
183{
184  idhdl tmp=NULL;
185
186  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
187  if (tmp==NULL) return NULL;
188
189  if (ppNoether!=NULL) pDelete(&ppNoether);
190  if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
191  {
192    sLastPrinted.CleanUp();
193    memset(&sLastPrinted,0,sizeof(sleftv));
194  }
195
196  ring r = IDRING(tmp);
197
198  r->ch    = 32003;
199  r->N     = 3;
200  /*r->P     = 0; Alloc0 in idhdl::set, ipid.cc*/
201  /*names*/
202  r->names = (char **) Alloc(3 * sizeof(char_ptr));
203  r->names[0]  = mstrdup("x");
204  r->names[1]  = mstrdup("y");
205  r->names[2]  = mstrdup("z");
206  /*weights: entries for 3 blocks: NULL*/
207  r->wvhdl = (int **)Alloc0(3 * sizeof(int_ptr));
208  /*order: dp,C,0*/
209  r->order = (int *) Alloc(3 * sizeof(int *));
210  r->block0 = (int *)Alloc0(3 * sizeof(int *));
211  r->block1 = (int *)Alloc0(3 * sizeof(int *));
212  /* ringorder dp for the first block: var 1..3 */
213  r->order[0]  = ringorder_dp;
214  r->block0[0] = 1;
215  r->block1[0] = 3;
216  /* ringorder C for the second block: no vars */
217  r->order[1]  = ringorder_C;
218  /* the last block: everything is 0 */
219  r->order[2]  = 0;
220  /*polynomial ring*/
221  r->OrdSgn    = 1;
222
223  /* complete ring intializations */
224  rComplete(r);
225  rSetHdl(tmp,TRUE);
226  return currRingHdl;
227}
228
229///////////////////////////////////////////////////////////////////////////
230//
231// rInit: define a new ring from sleftv's
232//
233
234/////////////////////////////
235// Auxillary functions
236//
237
238// check intvec, describing the ordering
239static BOOLEAN rCheckIV(intvec *iv)
240{
241  if ((iv->length()!=2)&&(iv->length()!=3))
242  {
243    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
244    return TRUE;
245  }
246  return FALSE;
247}
248
249static int rTypeOfMatrixOrder(intvec * order)
250{
251  int i=0,j,typ=1;
252  int sz = (int)sqrt((double)(order->length()-2));
253
254  while ((i<sz) && (typ==1))
255  {
256    j=0;
257    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
258    if (j>=sz)
259    {
260      typ = 0;
261      WerrorS("Matrix order not complete");
262    }
263    else if ((*order)[j*sz+i+2]<0)
264      typ = -1;
265    else
266      i++;
267  }
268  return typ;
269}
270
271// set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv
272static BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
273{
274  int last = 0, o=0, n = 1, i=0, typ = 1, j;
275  sleftv *sl = ord;
276
277  #ifdef HAVE_SHIFTED_EXPONENTS
278  R->bitmask= ~((unsigned long)0);
279  #endif
280
281  // determine nBlocks
282  while (sl!=NULL)
283  {
284    intvec *iv = (intvec *)(sl->data);
285    if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C)) i++;
286    #ifdef HAVE_SHIFTED_EXPONENTS
287    else if ((*iv)[1]==ringorder_L)
288    {
289      R->bitmask=(*iv)[2];
290      n--;
291    }
292    #endif
293    else if ((*iv)[1]!=ringorder_a) o++;
294    n++;
295    sl=sl->next;
296  }
297  // check whether at least one real ordering
298  if (o==0)
299  {
300    WerrorS("invalid combination of orderings");
301    return TRUE;
302  }
303  // if no c/C ordering is given, increment n
304  if (i==0) n++;
305  else if (i != 1)
306  {
307    // throw error if more than one is given
308    WerrorS("more than one ordering c/C specified");
309    return TRUE;
310  }
311
312  // initialize fields of R
313  R->order=(int *)Alloc0(n*sizeof(int));
314  R->block0=(int *)Alloc0(n*sizeof(int));
315  R->block1=(int *)Alloc0(n*sizeof(int));
316  R->wvhdl=(int**)Alloc0(n*sizeof(int_ptr));
317
318  // init order, so that rBlocks works correctly
319  for (j=0; j < n-1; j++)
320    R->order[j] = (int) ringorder_unspec;
321  // set last _C order, if no c/C order was given
322  if (i == 0) R->order[n-2] = ringorder_C;
323
324  /* init orders */
325  sl=ord;
326  n=-1;
327  while (sl!=NULL)
328  {
329    intvec *iv;
330    iv = (intvec *)(sl->data);
331    #ifdef HAVE_SHIFTED_EXPONENTS
332    if ((*iv)[1]!=ringorder_L)
333    {
334    #endif
335    n++;
336
337    /* the format of an ordering:
338     *  iv[0]: factor
339     *  iv[1]: ordering
340     *  iv[2..end]: weights
341     */
342    R->order[n] = (*iv)[1];
343    switch ((*iv)[1])
344    {
345        case ringorder_ws:
346        case ringorder_Ws:
347          typ=-1;
348        case ringorder_wp:
349        case ringorder_Wp:
350          R->wvhdl[n]=(int*)AllocL((iv->length()-1)*sizeof(int));
351          for (i=2; i<iv->length(); i++)
352            R->wvhdl[n][i-2] = (*iv)[i];
353          R->block0[n] = last+1;
354          last += iv->length()-2;
355          R->block1[n] = last;
356          break;
357        case ringorder_ls:
358        case ringorder_ds:
359        case ringorder_Ds:
360          typ=-1;
361        case ringorder_lp:
362        case ringorder_dp:
363        case ringorder_Dp:
364          R->block0[n] = last+1;
365          if (iv->length() == 3) last+=(*iv)[2];
366          else last += (*iv)[0];
367          R->block1[n] = last;
368          if (rCheckIV(iv)) return TRUE;
369          break;
370        case ringorder_S:
371        case ringorder_c:
372        case ringorder_C:
373          if (rCheckIV(iv)) return TRUE;
374          break;
375        case ringorder_a:
376          R->block0[n] = last+1;
377          R->block1[n] = last + iv->length() - 2;
378          R->wvhdl[n] = (int*)AllocL((iv->length()-1)*sizeof(int));
379          for (i=2; i<iv->length(); i++)
380          {
381            R->wvhdl[n][i-2]=(*iv)[i];
382            if ((*iv)[i]<0) typ=-1;
383          }
384          break;
385        case ringorder_M:
386        {
387          int Mtyp=rTypeOfMatrixOrder(iv);
388          if (Mtyp==0) return TRUE;
389          if (Mtyp==-1) typ = -1;
390
391          R->wvhdl[n] =( int *)AllocL((iv->length()-1)*sizeof(int));
392          for (i=2; i<iv->length();i++)
393            R->wvhdl[n][i-2]=(*iv)[i];
394
395          R->block0[n] = last+1;
396          last += (int)sqrt((double)(iv->length()-2));
397          R->block1[n] = last;
398          break;
399        }
400
401        case ringorder_no:
402           R->order[n] = ringorder_unspec;
403           return TRUE;
404
405        default:
406          Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
407          R->order[n] = ringorder_unspec;
408          return TRUE;
409    }
410    #ifdef HAVE_SHIFTED_EXPONENTS
411    }
412    #endif
413    sl=sl->next;
414  }
415
416  // check for complete coverage
417  if ((R->order[n]==ringorder_c) ||  (R->order[n]==ringorder_C)) n--;
418  if (R->block1[n] != R->N)
419  {
420    if (((R->order[n]==ringorder_dp) ||
421         (R->order[n]==ringorder_ds) ||
422         (R->order[n]==ringorder_Dp) ||
423         (R->order[n]==ringorder_Ds) ||
424         (R->order[n]==ringorder_lp) ||
425         (R->order[n]==ringorder_ls))
426        &&
427        R->block0[n] <= R->N)
428    {
429      R->block1[n] = R->N;
430    }
431    else
432    {
433      Werror("mismatch of number of vars (%d) and ordering (%d vars)",
434             R->N,R->block1[n]);
435      return TRUE;
436    }
437  }
438  R->OrdSgn = typ;
439  return FALSE;
440}
441
442// get array of strings from list of sleftv's
443static BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p)
444{
445
446  while(sl!=NULL)
447  {
448    if (sl->Name() == sNoName)
449    {
450      if (sl->Typ()==POLY_CMD)
451      {
452        sleftv s_sl;
453        iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
454        if (s_sl.Name() != sNoName)
455          *p = mstrdup(s_sl.Name());
456        else
457          *p = NULL;
458        sl->next = s_sl.next;
459        s_sl.next = NULL;
460        s_sl.CleanUp();
461        if (*p == NULL) return TRUE;
462      }
463      else
464        return TRUE;
465    }
466    else
467      *p = mstrdup(sl->Name());
468    p++;
469    sl=sl->next;
470  }
471  return FALSE;
472}
473
474
475////////////////////
476//
477// rInit itself:
478//
479// INPUT:  s: name, pn: ch & parameter (names), rv: variable (names)
480//         ord: ordering
481// RETURN: currRingHdl on success
482//         NULL        on error
483// NOTE:   * makes new ring to current ring, on success
484//         * considers input sleftv's as read-only
485idhdl rInit(char *s, sleftv* pn, sleftv* rv, sleftv* ord)
486{
487  int ch;
488  int float_len=0;
489  ring R = NULL;
490  idhdl tmp = NULL;
491  BOOLEAN ffChar=FALSE;
492  int typ = 1;
493
494  /* ch -------------------------------------------------------*/
495  // get ch of ground field
496  int numberOfAllocatedBlocks;
497
498  if (pn->Typ()==INT_CMD)
499  {
500    ch=(int)pn->Data();
501  }
502  else if ((pn->name != NULL)
503  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
504  {
505    BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
506    ch=-1;
507    if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
508    {
509      float_len=(int)pn->next->Data();
510      pn=pn->next;
511    }
512    if ((pn->next==NULL) && complex_flag)
513    {
514      pn->next=(leftv)Alloc0SizeOf(sleftv);
515      pn->next->name=mstrdup("i");
516    }
517  }
518  else
519  {
520    Werror("Wrong ground field specification");
521    goto rInitError;
522  }
523  pn=pn->next;
524
525  int l, last;
526  sleftv * sl;
527  ip_sring tmpR;
528  /*every entry in the new ring is initialized to 0*/
529
530  /* characteristic -----------------------------------------------*/
531  /* input: 0 ch=0 : Q     parameter=NULL    ffChar=FALSE   ch_flags
532   *         0    1 : Q(a,...)        *names         FALSE
533   *         0   -1 : R               NULL           FALSE  0
534   *         0   -1 : R               NULL           FALSE  prec. >6
535   *         0   -1 : C               *names         FALSE  prec. 0..?
536   *         p    p : Fp              NULL           FALSE
537   *         p   -p : Fp(a)           *names         FALSE
538   *         q    q : GF(q=p^n)       *names         TRUE
539   */
540  memset(&tmpR,0,sizeof(tmpR));
541  if (ch!=-1)
542  {
543    int l = 0;
544
545    if (ch!=0 && (ch<2) || (ch > 32003))
546    {
547      Warn("%d is invalid characteristic of ground field. 32003 is used.", ch);
548      ch=32003;
549    }
550    // load fftable, if necessary
551    if (pn!=NULL)
552    {
553      while ((ch!=fftable[l]) && (fftable[l])) l++;
554      if (fftable[l]==0) ch = IsPrime(ch);
555      else
556      {
557        char *m[1]={(char *)sNoName};
558        nfSetChar(ch,m);
559        if (errorreported) goto rInitError;
560        else ffChar=TRUE;
561      }
562    }
563    else
564      ch = IsPrime(ch);
565  }
566  // allocated ring and set ch
567  R = (ring) Alloc0SizeOf(sip_sring);
568  R->ch = ch;
569  if (ch == -1)
570  {
571    R->ch_flags= min(float_len,32767);
572  }
573
574  /* parameter -------------------------------------------------------*/
575  if (pn!=NULL)
576  {
577    R->P=pn->listLength();
578    //if ((ffChar|| (ch == 1)) && (R->P > 1))
579    if ((R->P > 1) && (ffChar || (ch == -1)))
580    {
581      WerrorS("too many parameters");
582      goto rInitError;
583    }
584    R->parameter=(char**)Alloc0(R->P*sizeof(char_ptr));
585    if (rSleftvList2StringArray(pn, R->parameter))
586    {
587      WerrorS("parameter expected");
588      goto rInitError;
589    }
590    if (ch>1 && !ffChar) R->ch=-ch;
591    else if (ch==0) R->ch=1;
592  }
593  else if (ffChar)
594  {
595    WerrorS("need one parameter");
596    goto rInitError;
597  }
598  /* post-processing of field description */
599  // we have short reals, but no short complex
600  if ((R->ch == - 1)
601  && (R->parameter !=NULL)
602  && (R->ch_flags < SHORT_REAL_LENGTH))
603    R->ch_flags = SHORT_REAL_LENGTH;
604
605  /* names and number of variables-------------------------------------*/
606  R->N = rv->listLength();
607  R->names   = (char **)Alloc0(R->N * sizeof(char_ptr));
608  if (rSleftvList2StringArray(rv, R->names))
609  {
610    WerrorS("name of ring variable expected");
611    goto rInitError;
612  }
613
614  /* check names and parameters for conflicts ------------------------- */
615  {
616    int i,j;
617    for(i=0;i<R->P; i++)
618    {
619      for(j=0;j<R->N;j++)
620      {
621        if (strcmp(R->parameter[i],R->names[j])==0)
622        {
623          Werror("parameter %d conflicts with variable %d",i+1,j+1);
624          goto rInitError;
625        }
626      }
627    }
628  }
629  /* ordering -------------------------------------------------------------*/
630  if (rSleftvOrdering2Ordering(ord, R))
631    goto rInitError;
632
633  // Complete the initialization
634  if (rComplete(R))
635    goto rInitError;
636
637  rTest(R);
638
639  // try to enter the ring into the name list //
640  // need to clean up sleftv here, before this ring can be set to
641  // new currRing or currRing can be killed beacuse new ring has
642  // same name
643  if (pn != NULL) pn->CleanUp();
644  if (rv != NULL) rv->CleanUp();
645  if (ord != NULL) ord->CleanUp();
646  if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
647    goto rInitError;
648
649  memcpy(IDRING(tmp),R,sizeof(*R));
650  // set current ring
651  FreeSizeOf(R,  ip_sring);
652  return tmp;
653
654  // error case:
655  rInitError:
656  if  (R != NULL) rDelete(R);
657  if (pn != NULL) pn->CleanUp();
658  if (rv != NULL) rv->CleanUp();
659  if (ord != NULL) ord->CleanUp();
660  return NULL;
661}
662
663/*2
664 * set a new ring from the data:
665 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
666 */
667
668int rIsRingVar(char *n)
669{
670  if ((currRing!=NULL) && (currRing->names!=NULL))
671  {
672    for (int i=0; i<currRing->N; i++)
673    {
674      if (currRing->names[i]==NULL) return -1;
675      if (strcmp(n,currRing->names[i]) == 0) return (int)i;
676    }
677  }
678  return -1;
679}
680
681char* RingVar(short i)
682{
683  return currRing->names[i];
684}
685
686void rWrite(ring r)
687{
688  if ((r==NULL)||(r->order==NULL))
689    return; /*to avoid printing after errors....*/
690
691  int nblocks=rBlocks(r);
692
693  mmTestP(r,sizeof(ip_sring));
694  mmTestP(r->order,nblocks*sizeof(int));
695  mmTestP(r->block0,nblocks*sizeof(int));
696  mmTestP(r->block1,nblocks*sizeof(int));
697  mmTestP(r->wvhdl,nblocks*sizeof(int_ptr));
698  mmTestP(r->names,r->N*sizeof(char_ptr));
699
700  nblocks--;
701
702
703  if (rField_is_GF(r))
704  {
705    Print("//   # ground field : %d\n",rInternalChar(r));
706    Print("//   primitive element : %s\n", r->parameter[0]);
707    if (r==currRing)
708    {
709      StringSetS("//   minpoly        : ");
710      nfShowMipo();PrintS(StringAppendS("\n"));
711    }
712  }
713  else
714  {
715    PrintS("//   characteristic : ");
716    if ( rField_is_R(r) )             PrintS("0 (real)\n");  /* R */
717    else if ( rField_is_long_R(r) )
718      Print("0 (real:%d digits)\n",r->ch_flags);  /* long R */
719    else if ( rField_is_long_C(r) )
720      Print("0 (complex:%d digits)\n",r->ch_flags);  /* long C */
721    else
722      Print ("%d\n",rChar(r)); /* Fp(a) */
723    if (r->parameter!=NULL)
724    {
725      Print ("//   %d parameter    : ",rPar(r));
726      char **sp=r->parameter;
727      int nop=0;
728      while (nop<rPar(r))
729      {
730        PrintS(*sp);
731        PrintS(" ");
732        sp++; nop++;
733      }
734      PrintS("\n//   minpoly        : ");
735      if ( rField_is_long_C(r) )
736      {
737        // i^2+1:
738        Print("(%s^2+1)\n",r->parameter[0]);
739      }
740      else if (r->minpoly==NULL)
741      {
742        PrintS("0\n");
743      }
744      else if (r==currRing)
745      {
746        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
747      }
748      else
749      {
750        PrintS("...\n");
751      }
752    }
753  }
754  Print("//   number of vars : %d",r->N);
755
756  //for (nblocks=0; r->order[nblocks]; nblocks++);
757  nblocks=rBlocks(r)-1;
758
759  for (int l=0, nlen=0 ; l<nblocks; l++)
760  {
761    int i;
762    Print("\n//        block %3d : ",l+1);
763
764    Print("ordering %s", rSimpleOrdStr(r->order[l]));
765
766    if ((r->order[l] >= ringorder_lp)
767    ||(r->order[l] == ringorder_M)
768    ||(r->order[l] == ringorder_a))
769    {
770      PrintS("\n//                  : names    ");
771      for (i = r->block0[l]-1; i<r->block1[l]; i++)
772      {
773        nlen = strlen(r->names[i]);
774        Print("%s ",r->names[i]);
775      }
776    }
777#ifndef NDEBUG
778    else if (r->order[l] == ringorder_s)
779    {
780      Print("  syzcomp at %d",r->typ[l].data.syz.limit);
781    }
782#endif
783
784    if (r->wvhdl[l]!=NULL)
785    {
786      for (int j= 0;
787           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
788           j+=i)
789      {
790        PrintS("\n//                  : weights  ");
791        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
792        {
793          Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
794        }
795        if (r->order[l]!=ringorder_M) break;
796      }
797    }
798  }
799  if (r->qideal!=NULL)
800  {
801    PrintS("\n// quotient ring from ideal");
802    if (r==currRing)
803    {
804      PrintLn();
805      iiWriteMatrix((matrix)r->qideal,"_",1);
806    }
807    else PrintS(" ...");
808  }
809}
810
811static void rDelete(ring r)
812{
813  int i, j;
814
815  if (r == NULL) return;
816
817  rUnComplete(r);
818  // delete order stuff
819  if (r->order != NULL)
820  {
821    i=rBlocks(r);
822    assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
823    // delete order
824    Free((ADDRESS)r->order,i*sizeof(int));
825    Free((ADDRESS)r->block0,i*sizeof(int));
826    Free((ADDRESS)r->block1,i*sizeof(int));
827    // delete weights
828    for (j=0; j<i; j++)
829    {
830      if (r->wvhdl[j]!=NULL)
831        FreeL(r->wvhdl[j]);
832    }
833    Free((ADDRESS)r->wvhdl,i*sizeof(short *));
834  }
835  else
836  {
837    assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
838  }
839
840  // delete varnames
841  if(r->names!=NULL)
842  {
843    for (i=0; i<r->N; i++)
844    {
845      if (r->names[i] != NULL) FreeL((ADDRESS)r->names[i]);
846    }
847    Free((ADDRESS)r->names,r->N*sizeof(char_ptr));
848  }
849
850  // delete parameter
851  if (r->parameter!=NULL)
852  {
853    char **s=r->parameter;
854    j = 0;
855    while (j < rPar(r))
856    {
857      if (*s != NULL) FreeL((ADDRESS)*s);
858      s++;
859      j++;
860    }
861    Free((ADDRESS)r->parameter,rPar(r)*sizeof(char_ptr));
862  }
863  FreeSizeOf(r, ip_sring);
864}
865
866void rKill(ring r)
867{
868  if ((r->ref<=0)&&(r->order!=NULL))
869  {
870#ifdef RDEBUG
871    if (traceit &TRACE_SHOW_RINGS) Print("kill ring %x\n",r);
872#endif
873    if (r==currRing)
874    {
875      if (r->qideal!=NULL)
876      {
877        idDelete(&r->qideal);
878        r->qideal=NULL;
879        currQuotient=NULL;
880      }
881      if (ppNoether!=NULL) pDelete(&ppNoether);
882      if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
883      {
884        sLastPrinted.CleanUp();
885        memset(&sLastPrinted,0,sizeof(sleftv));
886      }
887      currRing=NULL;
888      currRingHdl=NULL;
889    }
890    else if (r->qideal!=NULL)
891    {
892      ring savecurrRing = currRing;
893      rChangeCurrRing((ring)r,FALSE);
894      idDelete(&r->qideal);
895      r->qideal=NULL;
896      rChangeCurrRing(savecurrRing,FALSE);
897    }
898    int i=1;
899    int j;
900    int *pi=r->order;
901#ifdef USE_IILOCALRING
902    for (j=0;j<iiRETURNEXPR_len;j++)
903    {
904      if (iiLocalRing[j]==r)
905      {
906        if (j<myynest) Warn("killing the basering for level %d",j);
907        iiLocalRing[j]=NULL;
908      }
909    }
910#else /* USE_IILOCALRING */
911    {
912      namehdl nshdl = namespaceroot;
913
914      for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
915        //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
916        if (nshdl->currRing==r)
917        {
918          if (nshdl->myynest<myynest)
919//            Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
920          Warn("killing the basering for level %d",nshdl->myynest);
921          nshdl->currRing=NULL;
922        }
923      }
924      if (nshdl->currRing==r)
925      {
926        //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
927        if (nshdl->myynest<myynest)
928//          Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
929          Warn("killing the basering for level %d",nshdl->myynest);
930        nshdl->currRing=NULL;
931      }
932    }
933#endif /* USE_IILOCALRING */
934
935    rDelete(r);
936    return;
937  }
938  r->ref--;
939}
940
941void rKill(idhdl h)
942{
943#ifndef HAVE_NAMESPACES1
944  ring r = IDRING(h);
945  if (r!=NULL) rKill(r);
946  if (h==currRingHdl)
947  {
948#ifdef HAVE_NAMESPACES
949    namehdl nsHdl = namespaceroot;
950    while(nsHdl!=NULL) {
951      currRingHdl=NSROOT(nsHdl);
952#else /* HAVE_NAMESPACES */
953      currRingHdl=IDROOT;
954#endif /* HAVE_NAMESPACES */
955      while (currRingHdl!=NULL)
956      {
957        if ((currRingHdl!=h)
958            && (IDTYP(currRingHdl)==IDTYP(h))
959            && (h->data.uring==currRingHdl->data.uring))
960          break;
961        currRingHdl=IDNEXT(currRingHdl);
962      }
963#ifdef HAVE_NAMESPACES
964      if ((currRingHdl != NULL) && (currRingHdl!=h)
965          && (IDTYP(currRingHdl)==IDTYP(h))
966          && (h->data.uring==currRingHdl->data.uring))
967        break;
968      nsHdl = nsHdl->next;
969    }
970#endif /* HAVE_NAMESPACES */
971  }
972#else
973    if(currRingHdl==NULL)
974    {
975      namehdl ns = namespaceroot;
976      BOOLEAN found=FALSE;
977
978      while(!ns->isroot)
979      {
980        currRingHdl=NSROOT(namespaceroot->next);
981        while (currRingHdl!=NULL)
982        {
983          if ((currRingHdl!=h)
984              && (IDTYP(currRingHdl)==IDTYP(h))
985              && (h->data.uring==currRingHdl->data.uring))
986          { found=TRUE; break; }
987
988          currRingHdl=IDNEXT(currRingHdl);
989        }
990        if(found) break;
991        ns=IDNEXT(ns);
992      }
993    }
994    if(currRingHdl == NULL || IDRING(h) != IDRING(currRingHdl))
995    {
996      currRingHdl = namespaceroot->currRingHdl;
997
998/*      PrintS("Running rFind()\n");
999      currRingHdl = rFindHdl(IDRING(h), NULL, NULL);
1000      if(currRingHdl == NULL)
1001      {
1002        PrintS("rFind()return 0\n");
1003      }
1004      else
1005      {
1006        PrintS("Huppi rfind return an currRingHDL\n");
1007        Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1008      }
1009*/
1010    }
1011    else
1012    {
1013      //PrintS("Huppi found an currRingHDL\n");
1014      //Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1015
1016    }
1017#endif /* HAVE_NAMESPACES */
1018}
1019
1020idhdl rFindHdl(ring r, idhdl n, idhdl w)
1021{
1022#ifdef HAVE_NAMESPACES
1023  idhdl h;
1024  namehdl ns = namespaceroot;
1025
1026  while(!ns->isroot) {
1027    h = NSROOT(ns);
1028    if(w != NULL) h = w;
1029    while (h!=NULL)
1030    {
1031      if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1032          && (h->data.uring==r)
1033          && (h!=n))
1034        return h;
1035      h=IDNEXT(h);
1036    }
1037    ns = ns->next;
1038  }
1039  h = NSROOT(ns);
1040  if(w != NULL) h = w;
1041  while (h!=NULL)
1042  {
1043    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1044        && (h->data.uring==r)
1045        && (h!=n))
1046      return h;
1047    h=IDNEXT(h);
1048  }
1049#if 0
1050  if(namespaceroot->isroot) h = IDROOT;
1051  else h = NSROOT(namespaceroot->next);
1052  if(w != NULL) h = w;
1053  while (h!=NULL)
1054  {
1055    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1056        && (h->data.uring==r)
1057        && (h!=n))
1058      return h;
1059    h=IDNEXT(h);
1060  }
1061#endif
1062#else
1063  idhdl h=IDROOT;
1064  if(w != NULL) h = w;
1065  while (h!=NULL)
1066  {
1067    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1068        && (h->data.uring==r)
1069        && (h!=n))
1070      return h;
1071    h=IDNEXT(h);
1072  }
1073#endif
1074  return NULL;
1075}
1076
1077int rOrderName(char * ordername)
1078{
1079  int order=ringorder_unspec;
1080  while (order!= 0)
1081  {
1082    if (strcmp(ordername,rSimpleOrdStr(order))==0)
1083      break;
1084    order--;
1085  }
1086  if (order==0) Werror("wrong ring order `%s`",ordername);
1087  FreeL((ADDRESS)ordername);
1088  return order;
1089}
1090
1091char * rOrdStr(ring r)
1092{
1093  int nblocks,l,i;
1094
1095  for (nblocks=0; r->order[nblocks]; nblocks++);
1096  nblocks--;
1097
1098  StringSetS("");
1099  for (l=0; ; l++)
1100  {
1101    StringAppend((char *)rSimpleOrdStr(r->order[l]));
1102    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
1103    {
1104      if (r->wvhdl[l]!=NULL)
1105      {
1106        StringAppendS("(");
1107        for (int j= 0;
1108             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
1109             j+=i+1)
1110        {
1111          char c=',';
1112          for (i = 0; i<r->block1[l]-r->block0[l]; i++)
1113          {
1114            StringAppend("%d," ,r->wvhdl[l][i+j]);
1115          }
1116          if (r->order[l]!=ringorder_M)
1117          {
1118            StringAppend("%d)" ,r->wvhdl[l][i+j]);
1119            break;
1120          }
1121          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
1122            c=')';
1123          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
1124        }
1125      }
1126      else
1127        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
1128    }
1129    if (l==nblocks) return mstrdup(StringAppendS(""));
1130    StringAppendS(",");
1131  }
1132}
1133
1134char * rVarStr(ring r)
1135{
1136  int i;
1137  int l=2;
1138  char *s;
1139
1140  for (i=0; i<r->N; i++)
1141  {
1142    l+=strlen(r->names[i])+1;
1143  }
1144  s=(char *)AllocL(l);
1145  s[0]='\0';
1146  for (i=0; i<r->N-1; i++)
1147  {
1148    strcat(s,r->names[i]);
1149    strcat(s,",");
1150  }
1151  strcat(s,r->names[i]);
1152  return s;
1153}
1154
1155char * rCharStr(ring r)
1156{
1157  char *s;
1158  int i;
1159
1160  if (r->parameter==NULL)
1161  {
1162    i=r->ch;
1163    if(i==-1)
1164      s=mstrdup("real");                    /* R */
1165    else
1166    {
1167      s=(char *)AllocL(6);
1168      sprintf(s,"%d",i);                   /* Q, Z/p */
1169    }
1170    return s;
1171  }
1172  int l=0;
1173  for(i=0; i<rPar(r);i++)
1174  {
1175    l+=(strlen(r->parameter[i])+1);
1176  }
1177  s=(char *)AllocL(l+6);
1178  s[0]='\0';
1179  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
1180  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
1181  else
1182  {
1183    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq  */
1184    return s;
1185  }
1186  char tt[2];
1187  tt[0]=',';
1188  tt[1]='\0';
1189  for(i=0; i<rPar(r);i++)
1190  {
1191    strcat(s,tt);
1192    strcat(s,r->parameter[i]);
1193  }
1194  return s;
1195}
1196
1197char * rParStr(ring r)
1198{
1199  if (r->parameter==NULL) return mstrdup("");
1200
1201  int i;
1202  int l=2;
1203
1204  for (i=0; i<rPar(r); i++)
1205  {
1206    l+=strlen(r->parameter[i])+1;
1207  }
1208  char *s=(char *)AllocL(l);
1209  s[0]='\0';
1210  for (i=0; i<rPar(r)-1; i++)
1211  {
1212    strcat(s,r->parameter[i]);
1213    strcat(s,",");
1214  }
1215  strcat(s,r->parameter[i]);
1216  return s;
1217}
1218
1219char * rString(ring r)
1220{
1221  char *ch=rCharStr(r);
1222  char *var=rVarStr(r);
1223  char *ord=rOrdStr(r);
1224  char *res=(char *)AllocL(strlen(ch)+strlen(var)+strlen(ord)+9);
1225  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
1226  FreeL((ADDRESS)ch);
1227  FreeL((ADDRESS)var);
1228  FreeL((ADDRESS)ord);
1229  return res;
1230}
1231
1232int rChar(ring r)
1233{
1234  if (r->ch==-1)
1235    return 0;
1236  if (r->parameter==NULL) /* Q, Fp */
1237    return r->ch;
1238  if (r->ch<0)           /* Fp(a)  */
1239    return -r->ch;
1240  if (r->ch==1)          /* Q(a)  */
1241    return 0;
1242  /*else*/               /* GF(p,n) */
1243  {
1244    if ((r->ch & 1)==0) return 2;
1245    int i=3;
1246    while ((r->ch % i)!=0) i+=2;
1247    return i;
1248  }
1249}
1250
1251int    rIsExtension(ring r)
1252{
1253  if (r->parameter==NULL) /* Q, Fp */
1254    return FALSE;
1255  else
1256    return TRUE;
1257}
1258
1259int    rIsExtension()
1260{
1261  return rIsExtension( currRing );
1262}
1263
1264/*2
1265 *returns -1 for not compatible, (sum is undefined)
1266 *         0 for equal, (and sum)
1267 *         1 for compatible (and sum)
1268 */
1269int rSum(ring r1, ring r2, ring &sum)
1270{
1271  if (r1==r2)
1272  {
1273    sum=r1;
1274    r1->ref++;
1275    return 0;
1276  }
1277  ip_sring tmpR;
1278  memset(&tmpR,0,sizeof(tmpR));
1279  /* check coeff. field =====================================================*/
1280  if (rInternalChar(r1)==rInternalChar(r2))
1281  {
1282    tmpR.ch=rInternalChar(r1);
1283    if (rField_is_Q(r1)||rField_is_Zp(r1)||rField_is_GF(r1)) /*Q, Z/p, GF(p,n)*/
1284    {
1285      if (r1->parameter!=NULL)
1286      {
1287        if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1288        {
1289          tmpR.parameter=(char **)AllocSizeOf(char_ptr);
1290          tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1291          tmpR.P=1;
1292        }
1293        else
1294        {
1295          WerrorS("GF(p,n)+GF(p,n)");
1296          return -1;
1297        }
1298      }
1299    }
1300    else if ((r1->ch==1)||(r1->ch<-1)) /* Q(a),Z/p(a) */
1301    {
1302      if (r1->minpoly!=NULL)
1303      {
1304        if (r2->minpoly!=NULL)
1305        {
1306          nSetChar(r1,TRUE);
1307          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1308              && naEqual(r1->minpoly,r2->minpoly))
1309          {
1310            tmpR.parameter=(char **)AllocSizeOf(char_ptr);
1311            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1312            tmpR.minpoly=naCopy(r1->minpoly);
1313            tmpR.P=1;
1314            nSetChar(currRing,TRUE);
1315          }
1316          else
1317          {
1318            nSetChar(currRing,TRUE);
1319            WerrorS("different minpolys");
1320            return -1;
1321          }
1322        }
1323        else
1324        {
1325          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1326              && (rPar(r2)==1))
1327          {
1328            tmpR.parameter=(char **)Alloc0SizeOf(char_ptr);
1329            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1330            tmpR.P=1;
1331            nSetChar(r1,TRUE);
1332            tmpR.minpoly=naCopy(r1->minpoly);
1333            nSetChar(currRing,TRUE);
1334          }
1335          else
1336          {
1337            WerrorS("different parameters and minpoly!=0");
1338            return -1;
1339          }
1340        }
1341      }
1342      else /* r1->minpoly==NULL */
1343      {
1344        if (r2->minpoly!=NULL)
1345        {
1346          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1347              && (rPar(r1)==1))
1348          {
1349            tmpR.parameter=(char **)AllocSizeOf(char_ptr);
1350            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1351            tmpR.P=1;
1352            nSetChar(r2,TRUE);
1353            tmpR.minpoly=naCopy(r2->minpoly);
1354            nSetChar(currRing,TRUE);
1355          }
1356          else
1357          {
1358            WerrorS("different parameters and minpoly!=0");
1359            return -1;
1360          }
1361        }
1362        else
1363        {
1364          int len=rPar(r1)+rPar(r2);
1365          tmpR.parameter=(char **)Alloc(len*sizeof(char_ptr));
1366          int i;
1367          for (i=0;i<rPar(r1);i++)
1368          {
1369            tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1370          }
1371          int j,l;
1372          for(j=0;j<rPar(r2);j++)
1373          {
1374            for(l=0;l<i;l++)
1375            {
1376              if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
1377                break;
1378            }
1379            if (l==i)
1380            {
1381              tmpR.parameter[i]=mstrdup(r2->parameter[j]);
1382              i++;
1383            }
1384          }
1385          if (i!=len)
1386          {
1387            ReAlloc(tmpR.parameter,len*sizeof(char_ptr),i*sizeof(char_ptr));
1388          }
1389        }
1390      }
1391    }
1392  }
1393  else /* r1->ch!=r2->ch */
1394  {
1395    if (r1->ch<-1) /* Z/p(a) */
1396    {
1397      if ((r2->ch==0) /* Q */
1398          || (r2->ch==-r1->ch)) /* Z/p */
1399      {
1400        tmpR.ch=rInternalChar(r1);
1401        tmpR.parameter=(char **)Alloc(rPar(r1)*sizeof(char_ptr));
1402        tmpR.P=rPar(r1);
1403        memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char_ptr));
1404        if (r1->minpoly!=NULL)
1405        {
1406          nSetChar(r1,TRUE);
1407          tmpR.minpoly=naCopy(r1->minpoly);
1408          nSetChar(currRing,TRUE);
1409        }
1410      }
1411      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
1412      {
1413        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
1414        return -1;
1415      }
1416    }
1417    else if (r1->ch==-1) /* R */
1418    {
1419      WerrorS("R+..");
1420      return -1;
1421    }
1422    else if (r1->ch==0) /* Q */
1423    {
1424      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
1425      {
1426        tmpR.ch=rInternalChar(r2);
1427        tmpR.P=rPar(r2);
1428        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char_ptr));
1429        memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char_ptr));
1430        if (r2->minpoly!=NULL)
1431        {
1432          nSetChar(r1,TRUE);
1433          tmpR.minpoly=naCopy(r2->minpoly);
1434          nSetChar(currRing,TRUE);
1435        }
1436      }
1437      else if (r2->ch>1) /* Z/p,GF(p,n) */
1438      {
1439        tmpR.ch=r2->ch;
1440        if (r2->parameter!=NULL)
1441        {
1442          tmpR.parameter=(char **)AllocSizeOf(char_ptr);
1443          tmpR.P=1;
1444          tmpR.parameter[0]=mstrdup(r2->parameter[0]);
1445        }
1446      }
1447      else
1448      {
1449        WerrorS("Q+R");
1450        return -1; /* R */
1451      }
1452    }
1453    else if (r1->ch==1) /* Q(a) */
1454    {
1455      if (r2->ch==0) /* Q */
1456      {
1457        tmpR.ch=rInternalChar(r1);
1458        tmpR.P=rPar(r1);
1459        tmpR.parameter=(char **)Alloc0(rPar(r1)*sizeof(char_ptr));
1460        int i;
1461        for(i=0;i<rPar(r1);i++)
1462        {
1463          tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1464        }
1465        if (r1->minpoly!=NULL)
1466        {
1467          nSetChar(r1,TRUE);
1468          tmpR.minpoly=naCopy(r1->minpoly);
1469          nSetChar(currRing,TRUE);
1470        }
1471      }
1472      else  /* R, Z/p,GF(p,n) */
1473      {
1474        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1475        return -1;
1476      }
1477    }
1478    else /* r1->ch >=2 , Z/p */
1479    {
1480      if (r2->ch==0) /* Q */
1481      {
1482        tmpR.ch=r1->ch;
1483      }
1484      else if (r2->ch==-r1->ch) /* Z/p(a) */
1485      {
1486        tmpR.ch=rInternalChar(r2);
1487        tmpR.P=rPar(r2);
1488        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char_ptr));
1489        int i;
1490        for(i=0;i<rPar(r2);i++)
1491        {
1492          tmpR.parameter[i]=mstrdup(r2->parameter[i]);
1493        }
1494        if (r2->minpoly!=NULL)
1495        {
1496          nSetChar(r2,TRUE);
1497          tmpR.minpoly=naCopy(r2->minpoly);
1498          nSetChar(currRing,TRUE);
1499        }
1500      }
1501      else
1502      {
1503        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1504        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1505      }
1506    }
1507  }
1508  /* variable names ========================================================*/
1509  int i,j,k;
1510  int l=r1->N+r2->N;
1511  char **names=(char **)Alloc0(l*sizeof(char_ptr));
1512  k=0;
1513
1514  // collect all varnames from r1, except those which are parameters
1515  // of r2, or those which are the empty string
1516  for (i=0;i<r1->N;i++)
1517  {
1518    BOOLEAN b=TRUE;
1519
1520    if (*(r1->names[i]) == '\0')
1521      b = FALSE;
1522    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1523    {
1524      for(j=0;j<rPar(r2);j++)
1525      {
1526        if (strcmp(r1->names[i],r2->parameter[j])==0)
1527        {
1528          b=FALSE;
1529          break;
1530        }
1531      }
1532    }
1533
1534    if (b)
1535    {
1536      //Print("name : %d: %s\n",k,r1->names[i]);
1537      names[k]=mstrdup(r1->names[i]);
1538      k++;
1539    }
1540    //else
1541    //  Print("no name (par1) %s\n",r1->names[i]);
1542  }
1543  // Add variables from r2, except those which are parameters of r1
1544  // those which are empty strings, and those which equal a var of r1
1545  for(i=0;i<r2->N;i++)
1546  {
1547    BOOLEAN b=TRUE;
1548
1549    if (*(r2->names[i]) == '\0')
1550      b = FALSE;
1551    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1552    {
1553      for(j=0;j<rPar(r1);j++)
1554      {
1555        if (strcmp(r2->names[i],r1->parameter[j])==0)
1556        {
1557          b=FALSE;
1558          break;
1559        }
1560      }
1561    }
1562
1563    if (b)
1564    {
1565      for(j=0;j<r1->N;j++)
1566      {
1567        if (strcmp(r1->names[j],r2->names[i])==0)
1568        {
1569          b=FALSE;
1570          break;
1571        }
1572      }
1573      if (b)
1574      {
1575        names[k]=mstrdup(r2->names[i]);
1576        //Print("name : %d : %s\n",k,r2->names[i]);
1577        k++;
1578      }
1579      //else
1580      //  Print("no name (var): %s\n",r2->names[i]);
1581    }
1582    //else
1583    //  Print("no name (par): %s\n",r2->names[i]);
1584  }
1585  // check whether we found any vars at all
1586  if (k == 0)
1587  {
1588    names[k]=mstrdup("");
1589    k=1;
1590  }
1591  tmpR.N=k;
1592  tmpR.names=names;
1593  /* ordering *======================================================== */
1594  tmpR.OrdSgn=1;
1595  if ((r1->order[0]==ringorder_unspec)
1596      && (r2->order[0]==ringorder_unspec))
1597  {
1598    tmpR.order=(int*)Alloc(3*sizeof(int));
1599    tmpR.block0=(int*)Alloc(3*sizeof(int));
1600    tmpR.block1=(int*)Alloc(3*sizeof(int));
1601    tmpR.wvhdl=(int**)Alloc0(3*sizeof(int_ptr));
1602    tmpR.order[0]=ringorder_unspec;
1603    tmpR.order[1]=ringorder_C;
1604    tmpR.order[2]=0;
1605    tmpR.block0[0]=1;
1606    tmpR.block1[0]=tmpR.N;
1607  }
1608  else if (l==k) /* r3=r1+r2 */
1609  {
1610    int b;
1611    ring rb;
1612    if (r1->order[0]==ringorder_unspec)
1613    {
1614      /* extend order of r2 to r3 */
1615      b=rBlocks(r2);
1616      rb=r2;
1617      tmpR.OrdSgn=r2->OrdSgn;
1618    }
1619    else if (r2->order[0]==ringorder_unspec)
1620    {
1621      /* extend order of r1 to r3 */
1622      b=rBlocks(r1);
1623      rb=r1;
1624      tmpR.OrdSgn=r1->OrdSgn;
1625    }
1626    else
1627    {
1628      b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1629      rb=NULL;
1630    }
1631    tmpR.order=(int*)Alloc0(b*sizeof(int));
1632    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1633    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1634    tmpR.wvhdl=(int**)Alloc0(b*sizeof(int_ptr));
1635    /* weights not implemented yet ...*/
1636    if (rb!=NULL)
1637    {
1638      for (i=0;i<b;i++)
1639      {
1640        tmpR.order[i]=rb->order[i];
1641        tmpR.block0[i]=rb->block0[i];
1642        tmpR.block1[i]=rb->block1[i];
1643        if (rb->wvhdl[i]!=NULL)
1644          WarnS("rSum: weights not implemented");
1645      }
1646      tmpR.block0[0]=1;
1647    }
1648    else /* ring sum for complete rings */
1649    {
1650      for (i=0;r1->order[i]!=0;i++)
1651      {
1652        tmpR.order[i]=r1->order[i];
1653        tmpR.block0[i]=r1->block0[i];
1654        tmpR.block1[i]=r1->block1[i];
1655        if (r1->wvhdl[i]!=NULL)
1656        {
1657          int l=mmSizeL(r1->wvhdl[i]);
1658          tmpR.wvhdl[i]=(int *)AllocL(l);
1659          memcpy(tmpR.wvhdl[i],r1->wvhdl[i],l);
1660        }
1661      }
1662      j=i;
1663      i--;
1664      if ((r1->order[i]==ringorder_c)
1665          ||(r1->order[i]==ringorder_C))
1666      {
1667        j--;
1668        tmpR.order[b-2]=r1->order[i];
1669      }
1670      for (i=0;r2->order[i]!=0;i++,j++)
1671      {
1672        if ((r2->order[i]!=ringorder_c)
1673            &&(r2->order[i]!=ringorder_C))
1674        {
1675          tmpR.order[j]=r2->order[i];
1676          tmpR.block0[j]=r2->block0[i]+r1->N;
1677          tmpR.block1[j]=r2->block1[i]+r1->N;
1678          if (r2->wvhdl[i]!=NULL)
1679          {
1680            int l=mmSizeL(r2->wvhdl[i]);
1681            tmpR.wvhdl[j]=(int *)AllocL(l);
1682            memcpy(tmpR.wvhdl[j],r2->wvhdl[i],l);
1683          }
1684        }
1685      }
1686      if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1687        tmpR.OrdSgn=-1;
1688    }
1689  }
1690  else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1691    /* copy r1, because we have the variables from r1 */
1692  {
1693    int b=rBlocks(r1);
1694
1695    tmpR.order=(int*)Alloc0(b*sizeof(int));
1696    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1697    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1698    tmpR.wvhdl=(int**)Alloc0(b*sizeof(int_ptr));
1699    /* weights not implemented yet ...*/
1700    for (i=0;i<b;i++)
1701    {
1702      tmpR.order[i]=r1->order[i];
1703      tmpR.block0[i]=r1->block0[i];
1704      tmpR.block1[i]=r1->block1[i];
1705      if (r1->wvhdl[i]!=NULL)
1706      {
1707        int l=mmSizeL(r1->wvhdl[i]);
1708        tmpR.wvhdl[i]=(int *)AllocL(l);
1709        memcpy(tmpR.wvhdl[i],r1->wvhdl[i],l);
1710      }
1711    }
1712    tmpR.OrdSgn=r1->OrdSgn;
1713  }
1714  else
1715  {
1716    for(i=0;i<k;i++) FreeL((ADDRESS)tmpR.names[i]);
1717    Free((ADDRESS)names,tmpR.N*sizeof(char_ptr));
1718    Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1719    return -1;
1720  }
1721  sum=(ring)AllocSizeOf(ip_sring);
1722  memcpy(sum,&tmpR,sizeof(ip_sring));
1723  rComplete(sum);
1724  return 1;
1725}
1726
1727/*2
1728 * create a copy of the ring r, which must be equivalent to currRing
1729 * used for qring definition,..
1730 * (i.e.: normal rings: same nCopy as currRing;
1731 *        qring:        same nCopy, same idCopy as currRing)
1732 * DOES NOT CALL rComplete
1733 */
1734static ring rCopy0(ring r, BOOLEAN copy_qideal = TRUE, 
1735                   BOOLEAN copy_ordering = TRUE)
1736{
1737  if (r == NULL) return NULL;
1738  rTest(r);
1739  int i,j;
1740  ring res=(ring)AllocSizeOf(ip_sring);
1741
1742  memcpy4(res,r,sizeof(ip_sring));
1743  res->ref=0;
1744  if (r->parameter!=NULL)
1745  {
1746    res->minpoly=nCopy(r->minpoly);
1747    int l=rPar(r);
1748    res->parameter=(char **)Alloc(l*sizeof(char_ptr));
1749    int i;
1750    for(i=0;i<rPar(r);i++)
1751    {
1752      res->parameter[i]=mstrdup(r->parameter[i]);
1753    }
1754  }
1755  if (copy_ordering == TRUE)
1756  {
1757    i=rBlocks(r);
1758    res->wvhdl   = (int **)Alloc(i * sizeof(int_ptr));
1759    res->order   = (int *) Alloc(i * sizeof(int));
1760    res->block0  = (int *) Alloc(i * sizeof(int));
1761    res->block1  = (int *) Alloc(i * sizeof(int));
1762    for (j=0; j<i; j++)
1763    {
1764      if (r->wvhdl[j]!=NULL)
1765      {
1766        res->wvhdl[j]=(int*)AllocL(mmSizeL((ADDRESS)r->wvhdl[j]));
1767        memcpy(res->wvhdl[j],r->wvhdl[j],mmSizeL((ADDRESS)r->wvhdl[j]));
1768      }
1769      else
1770        res->wvhdl[j]=NULL;
1771    }
1772    memcpy4(res->order,r->order,i * sizeof(int));
1773    memcpy4(res->block0,r->block0,i * sizeof(int));
1774    memcpy4(res->block1,r->block1,i * sizeof(int));
1775  }
1776  else
1777  {
1778    res->wvhdl = NULL;
1779    res->order = NULL;
1780    res->block0 = NULL;
1781    res->block1 = NULL;
1782  }
1783
1784  res->names   = (char **)Alloc(r->N * sizeof(char_ptr));
1785  for (i=0; i<res->N; i++)
1786  {
1787    res->names[i] = mstrdup(r->names[i]);
1788  }
1789  res->idroot = NULL;
1790  if (r->qideal!=NULL) 
1791  {
1792    if (copy_qideal) res->qideal= idCopy(r->qideal);
1793    else res->qideal = NULL;
1794  }
1795  return res;
1796}
1797
1798/*2
1799 * create a copy of the ring r, which must be equivalent to currRing
1800 * used for qring definition,..
1801 * (i.e.: normal rings: same nCopy as currRing;
1802 *        qring:        same nCopy, same idCopy as currRing)
1803 */
1804ring rCopy(ring r)
1805{
1806  if (r == NULL) return NULL;
1807  ring res=rCopy0(r);
1808  rComplete(res, 1);
1809  return res;
1810}
1811
1812// returns TRUE, if r1 equals r2 FALSE, otherwise Equality is
1813// determined componentwise, if qr == 1, then qrideal equality is
1814// tested, as well
1815BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1816{
1817  int i, j;
1818
1819  if (r1 == r2) return 1;
1820
1821  if (r1 == NULL || r2 == NULL) return 0;
1822
1823  if ((rInternalChar(r1) != rInternalChar(r2))
1824  || (r1->ch_flags != r2->ch_flags)
1825  || (r1->N != r2->N)
1826  || (r1->OrdSgn != r2->OrdSgn)
1827  || (rPar(r1) != rPar(r2)))
1828    return 0;
1829
1830  for (i=0; i<r1->N; i++)
1831    if (strcmp(r1->names[i], r2->names[i])) return 0;
1832
1833  i=0;
1834  while (r1->order[i] != 0)
1835  {
1836    if (r2->order[i] == 0) return 0;
1837    if ((r1->order[i] != r2->order[i]) ||
1838        (r1->block0[i] != r2->block0[i]) || (r2->block0[i] != r1->block0[i]))
1839      return 0;
1840    if (r1->wvhdl[i] != NULL)
1841    {
1842      if (r2->wvhdl[i] == NULL)
1843        return 0;
1844      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1845        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1846          return 0;
1847    }
1848    else if (r2->wvhdl[i] != NULL) return 0;
1849    i++;
1850  }
1851
1852  for (i=0; i<rPar(r1);i++)
1853  {
1854      if (strcmp(r1->parameter[i], r2->parameter[i])!=0)
1855        return 0;
1856  }
1857
1858  if (r1->minpoly != NULL)
1859  {
1860    if (r2->minpoly == NULL) return 0;
1861    if (currRing == r1 || currRing == r2)
1862    {
1863      if (! nEqual(r1->minpoly, r2->minpoly)) return 0;
1864    }
1865  }
1866  else if (r2->minpoly != NULL) return 0;
1867
1868  if (qr)
1869  {
1870    if (r1->qideal != NULL)
1871    {
1872      ideal id1 = r1->qideal, id2 = r2->qideal;
1873      int i, n;
1874      poly *m1, *m2;
1875
1876      if (id2 == NULL) return 0;
1877      if ((n = IDELEMS(id1)) != IDELEMS(id2)) return 0;
1878
1879      if (currRing == r1 || currRing == r2)
1880      {
1881        m1 = id1->m;
1882        m2 = id2->m;
1883        for (i=0; i<n; i++)
1884          if (! pEqualPolys(m1[i],m2[i])) return 0;
1885      }
1886    }
1887    else if (r2->qideal != NULL) return 0;
1888  }
1889
1890  return 1;
1891}
1892
1893rOrderType_t rGetOrderType(ring r)
1894{
1895  // check for simple ordering
1896  if (rHasSimpleOrder(r))
1897  {
1898    if ((r->order[1] == ringorder_c) || (r->order[1] == ringorder_C))
1899    {
1900      switch(r->order[0])
1901      {
1902          case ringorder_dp:
1903          case ringorder_wp:
1904          case ringorder_ds:
1905          case ringorder_ws:
1906          case ringorder_ls:
1907          case ringorder_unspec:
1908            if (r->order[1] == ringorder_C ||  r->order[0] == ringorder_unspec)
1909              return rOrderType_ExpComp;
1910            return rOrderType_Exp;
1911
1912          default:
1913            assume(r->order[0] == ringorder_lp ||
1914                   r->order[0] == ringorder_Dp ||
1915                   r->order[0] == ringorder_Wp ||
1916                   r->order[0] == ringorder_Ds ||
1917                   r->order[0] == ringorder_Ws);
1918
1919            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1920            return rOrderType_Exp;
1921      }
1922    }
1923    else
1924    {
1925      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1926      return rOrderType_CompExp;
1927    }
1928  }
1929  else
1930    return rOrderType_General;
1931}
1932
1933BOOLEAN rHasSimpleOrder(ring r)
1934{
1935  return
1936    (r->order[0] == ringorder_unspec) ||
1937    ((r->order[2] == 0) &&
1938     (r->order[1] != ringorder_M &&
1939      r->order[0] != ringorder_M));
1940}
1941
1942// returns TRUE, if simple lp or ls ordering
1943BOOLEAN rHasSimpleLexOrder(ring r)
1944{
1945  return rHasSimpleOrder(r) &&
1946    (r->order[0] == ringorder_ls ||
1947     r->order[0] == ringorder_lp ||
1948     r->order[1] == ringorder_ls ||
1949     r->order[1] == ringorder_lp);
1950}
1951
1952BOOLEAN rIsPolyVar(int v)
1953{
1954  int  i=0;
1955  while(currRing->order[i]!=0)
1956  {
1957    if((currRing->block0[i]<=v)
1958    && (currRing->block1[i]>=v))
1959    {
1960      switch(currRing->order[i])
1961      {
1962        case ringorder_a:
1963          return (currRing->wvhdl[i][v-currRing->block0[i]]>0);
1964        case ringorder_M:
1965          return 2; /*don't know*/
1966        case ringorder_lp:
1967        case ringorder_dp:
1968        case ringorder_Dp:
1969        case ringorder_wp:
1970        case ringorder_Wp:
1971          return TRUE;
1972        case ringorder_ls:
1973        case ringorder_ds:
1974        case ringorder_Ds:
1975        case ringorder_ws:
1976        case ringorder_Ws:
1977          return FALSE;
1978        default:
1979          break;
1980      }
1981    }
1982    i++;
1983  }
1984  return 3; /* could not find var v*/
1985}
1986
1987#ifdef RDEBUG
1988// This should eventually become a full-fledge ring check, like pTest
1989BOOLEAN rDBTest(ring r, char* fn, int l)
1990{
1991  int i,j;
1992
1993  if (r == NULL)
1994  {
1995    Werror("Null ring in %s:%d\n", fn, l);
1996    return FALSE;
1997  }
1998
1999  if (r->N == 0) return TRUE;
2000
2001//  mmTestP(r,sizeof(ip_sring));
2002#ifdef MDEBUG
2003  i=rBlocks(r);
2004  mmDBTestBlock(r->order,i*sizeof(int),fn,l);
2005  mmDBTestBlock(r->block0,i*sizeof(int),fn,l);
2006  mmDBTestBlock(r->block1,i*sizeof(int),fn,l);
2007  mmDBTestBlock(r->wvhdl,i*sizeof(int *),fn,l);
2008  for (j=0;j<i; j++)
2009  {
2010    if (r->wvhdl[j] != NULL) mmDBTest(r->wvhdl[j], fn, l);
2011  }
2012#endif
2013  if (r->VarOffset == NULL)
2014  {
2015    Werror("Null ring VarOffset -- no rComplete (?) in n %s:%d\n", fn, l);
2016    return FALSE;
2017  }
2018#ifdef MDEBUG
2019  mmDBTestBlock(r->VarOffset,(r->N+1)*sizeof(int),fn,l);
2020#endif
2021
2022  if ((r->OrdSize==0)!=(r->typ==NULL))
2023  {
2024    Werror("mismatch OrdSize and typ-pointer in %s:%d",fn,l);
2025    return FALSE;
2026  }
2027#ifdef MDEBUG
2028  if (r->typ!=NULL)
2029    mmDBTestBlock(r->typ,r->OrdSize*sizeof(*(r->typ)),fn,l);
2030  mmDBTestBlock(r->VarOffset,(r->N+1)*sizeof(*(r->VarOffset)),fn,l);
2031#endif
2032  // test assumptions:
2033  for(i=0;i<=r->N;i++)
2034  {
2035    if(r->typ!=NULL)
2036    {
2037      for(j=0;j<r->OrdSize;j++)
2038      {
2039        if (r->typ[j].ord_typ==ro_cp)
2040        {
2041          if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
2042            Print("ordrec %d conflicts with var %d\n",j,i);
2043        }
2044        else
2045        if ((r->typ[j].ord_typ!=ro_syzcomp)
2046         && (r->VarOffset[i]/(sizeof(long)/sizeof(Exponent_t)))
2047           == (size_t)r->typ[j].data.dp.place)
2048          Print("ordrec %d conflicts with var %d\n",j,i);
2049      }
2050    }
2051    int tmp;
2052    #ifdef HAVE_SHIFTED_EXPONENTS
2053      tmp=r->VarOffset[i] & 0xffffff;
2054      #if SIZEOF_LONG == 8
2055        if ((r->VarOffset[i] >> 24) >63)
2056      #else
2057        if ((r->VarOffset[i] >> 24) >31)
2058      #endif
2059          Print("bit_start out of range:%d\n",r->VarOffset[i] >> 24);
2060    #else
2061      tmp=r->VarOffset[i];
2062    #endif
2063    if ((tmp<0) ||(tmp>r->ExpESize-1))
2064    {
2065      Print("varoffset out of range for var %d: %d\n",i,tmp);
2066    }
2067  }
2068  if(r->typ!=NULL)
2069  {
2070    for(j=0;j<r->OrdSize;j++)
2071    {
2072      if ((r->typ[j].ord_typ==ro_dp)
2073      || (r->typ[j].ord_typ==ro_wp))
2074      {
2075        if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
2076          Print("in ordrec %d: start(%d) > end(%d)\n",j,
2077            r->typ[j].data.dp.start, r->typ[j].data.dp.end);
2078        if ((r->typ[j].data.dp.start < 1)
2079        || (r->typ[j].data.dp.end > r->N))
2080          Print("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)\n",j,
2081            r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
2082      }
2083    }
2084  }
2085  return TRUE;
2086}
2087#endif
2088
2089#ifdef HAVE_SHIFTED_EXPONENTS
2090static void rO_Align(int &place, int &bitplace)
2091{
2092  // increment place to the next aligned one
2093  // (count as Exponent_t,align as longs)
2094  if (bitplace!=BITS_PER_LONG)
2095  {
2096    place++;
2097    bitplace=BITS_PER_LONG;
2098  }
2099  if (place & ((sizeof(long)/sizeof(Exponent_t))-1))
2100  {
2101    place += ((sizeof(long)/sizeof(Exponent_t))-1);
2102    place &= (~((sizeof(long)/sizeof(Exponent_t))-1));
2103  }
2104}
2105
2106static void rO_TDegree(int &place, int &bitplace, int start, int end,
2107    long *o, sro_ord &ord_struct)
2108{
2109  // degree (aligned) of variables v_start..v_end, ordsgn 1
2110  rO_Align(place,bitplace);
2111  ord_struct.ord_typ=ro_dp;
2112  ord_struct.data.dp.start=start;
2113  ord_struct.data.dp.end=end;
2114  ord_struct.data.dp.place=place/(sizeof(long)/sizeof(Exponent_t));
2115  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2116  place++;
2117  rO_Align(place,bitplace);
2118}
2119
2120static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2121    long *o, sro_ord &ord_struct)
2122{
2123  // degree (aligned) of variables v_start..v_end, ordsgn -1
2124  rO_Align(place,bitplace);
2125  ord_struct.ord_typ=ro_dp;
2126  ord_struct.data.dp.start=start;
2127  ord_struct.data.dp.end=end;
2128  ord_struct.data.dp.place=place/(sizeof(long)/sizeof(Exponent_t));
2129  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2130  place++;
2131  rO_Align(place,bitplace);
2132}
2133
2134static void rO_WDegree(int &place, int &bitplace, int start, int end,
2135    long *o, sro_ord &ord_struct, int *weights)
2136{
2137  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2138  rO_Align(place,bitplace);
2139  ord_struct.ord_typ=ro_wp;
2140  ord_struct.data.wp.start=start;
2141  ord_struct.data.wp.end=end;
2142  ord_struct.data.wp.place=place/(sizeof(long)/sizeof(Exponent_t));
2143  ord_struct.data.wp.weights=weights;
2144  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2145  place++;
2146  rO_Align(place,bitplace);
2147}
2148
2149static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2150    long *o, sro_ord &ord_struct, int *weights)
2151{
2152  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2153  rO_Align(place,bitplace);
2154  ord_struct.ord_typ=ro_wp;
2155  ord_struct.data.wp.start=start;
2156  ord_struct.data.wp.end=end;
2157  ord_struct.data.wp.place=place/(sizeof(long)/sizeof(Exponent_t));
2158  ord_struct.data.wp.weights=weights;
2159  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2160  place++;
2161  rO_Align(place,bitplace);
2162}
2163
2164static void rO_LexVars(int &place, int &bitplace, int start, int end,
2165  int &prev_ord, long *o,int *v, int bits)
2166{
2167  // a block of variables v_start..v_end with lex order, ordsgn 1
2168  int k;
2169  int incr=1;
2170  if(prev_ord!=1) rO_Align(place,bitplace);
2171
2172  if (start>end)
2173  {
2174    incr=-1;
2175  }
2176  for(k=start;;k+=incr)
2177  {
2178    bitplace-=bits;
2179    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2180    o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2181    v[k]= place | (bitplace << 24);
2182    if (k==end) break;
2183  }
2184  prev_ord=1;
2185}
2186
2187static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2188  int &prev_ord, long *o,int *v, int bits)
2189{
2190  // a block of variables v_start..v_end with lex order, ordsgn -1
2191  int k;
2192  int incr=1;
2193  if(prev_ord!=-1) rO_Align(place,bitplace);
2194
2195  if (start>end)
2196  {
2197    incr=-1;
2198  }
2199  for(k=start;;k+=incr)
2200  {
2201    bitplace-=bits;
2202    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2203    o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2204    v[k]=place | (bitplace << 24);
2205    if (k==end) break;
2206  }
2207  prev_ord=-1;
2208}
2209
2210static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2211    long *o, sro_ord &ord_struct)
2212{
2213  // ordering is derived from component number
2214  rO_Align(place,bitplace);
2215  ord_struct.ord_typ=ro_syzcomp;
2216  ord_struct.data.syzcomp.place=place/(sizeof(long)/sizeof(Exponent_t));
2217  ord_struct.data.syzcomp.Components=NULL;
2218  ord_struct.data.syzcomp.ShiftedComponents=NULL;
2219  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2220  prev_ord=1;
2221  place++;
2222  rO_Align(place,bitplace);
2223}
2224
2225static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2226    long *o, sro_ord &ord_struct)
2227{
2228  // ordering is derived from component number
2229  // let's reserve one Exponent_t for it
2230  if ((prev_ord!= -1) || (bitplace!=BITS_PER_LONG))
2231    rO_Align(place,bitplace);
2232  ord_struct.ord_typ=ro_syz;
2233  ord_struct.data.syz.place=place/(sizeof(long)/sizeof(Exponent_t));
2234  ord_struct.data.syz.limit=0;
2235  ord_struct.data.syz.syz_index = NULL;
2236  ord_struct.data.sys.curr_index = 1;
2237  o[place/(sizeof(long)/sizeof(Exponent_t))]= -1;
2238  prev_ord=-1;
2239  place++;
2240}
2241
2242BOOLEAN rComplete(ring r, int force)
2243{
2244  if (r->VarOffset!=NULL && force == 0) return FALSE;
2245
2246  int n=rBlocks(r)-1;
2247  int i;
2248  int bits;
2249  switch(r->bitmask)
2250  {
2251     case 0:
2252#if SIZEOF_LONG == 8
2253                      r->bitmask=0xffffffffffffffffL; /* NO break */
2254     case 0xffffffffffffffffL: bits=64; break; /* 64 bit longs only */
2255#endif
2256                      r->bitmask=0xffffffff; /* NO break */
2257     case 0xffffffff: bits=32; break;
2258#if SIZEOF_LONG == 8
2259     case 0xfffff:    bits=20; break; /* 64 bit longs only */
2260#endif
2261     case 0xffff:     bits=16; break;
2262#if SIZEOF_LONG == 8
2263     case 0xfff:      bits=12; break; /* 64 bit longs only */
2264#endif
2265     case 0x3ff:      bits=10; break;
2266#if SIZEOF_LONG == 8
2267     case 0x1ff:      bits=9;  break; /* 64 bit longs only */
2268#endif
2269     case 0xff:       bits=8;  break;
2270#if SIZEOF_LONG == 8
2271     case 0x7f:       bits=7;  break; /* 64 bit longs only */
2272#endif
2273     case 0x3f:       bits=6;  break;
2274     case 0x1f:       bits=5;  break;
2275     case 0xf:        bits=4;  break;
2276     case 0x7:        bits=3;  break;
2277     case 0x3:        bits=2;  break;
2278     default:
2279       Werror("unknown bitmask %xl",r->bitmask);
2280       return TRUE;
2281  }
2282  // will be used for ordsgn:
2283  long *tmp_ordsgn=(long *)Alloc0(2*(n+r->N)*sizeof(long));
2284  // will be used for VarOffset:
2285  int *v=(int *)Alloc((r->N+1)*sizeof(int));
2286  for(i=r->N; i>=0 ; i--)
2287  {
2288    v[i]=-1;
2289  }
2290  sro_ord *tmp_typ=(sro_ord *)Alloc0(2*(n+r->N)*sizeof(sro_ord));
2291  int typ_i=0;
2292  int bitplace=0;
2293  int prev_ordsgn=0;
2294  r->pVarLowIndex=0;
2295
2296  // fill in v, tmp_typ, tmp_ordsgn, determine pVarLowIndex, typ_i (== ordSize)
2297  int j=0;
2298  int j_bits=0;
2299  for(i=0;i<n;i++)
2300  {
2301    switch (r->order[i])
2302    {
2303      case ringorder_a:
2304        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2305                   r->wvhdl[i]);
2306        r->pVarLowIndex=j;
2307        typ_i++;
2308        break;
2309
2310      case ringorder_c:
2311        rO_Align(j, j_bits);
2312        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2313        break;
2314
2315      case ringorder_C:
2316        rO_Align(j, j_bits);
2317        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2318        break;
2319
2320      case ringorder_M:
2321        {
2322          int k,l;
2323          k=r->block1[i]-r->block0[i]+1; // number of vars
2324          for(l=0;l<k;l++)
2325          {
2326            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2327                       tmp_typ[typ_i],
2328                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
2329            typ_i++;
2330          }
2331          r->pVarLowIndex=j;
2332          break;
2333        }
2334
2335      case ringorder_lp:
2336        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2337                   tmp_ordsgn,v,bits);
2338        break;
2339
2340      case ringorder_ls:
2341        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2342                       tmp_ordsgn,v, bits);
2343        break;
2344
2345      case ringorder_dp:
2346        if (r->block0[i]==r->block1[i])
2347        {
2348          rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2349                     tmp_ordsgn,v, bits);
2350        }
2351        else
2352        {
2353          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2354                     tmp_typ[typ_i]);
2355          r->pVarLowIndex=j;
2356          typ_i++;
2357          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2358                         prev_ordsgn,tmp_ordsgn,v,bits);
2359        }
2360        break;
2361
2362      case ringorder_Dp:
2363        if (r->block0[i]==r->block1[i])
2364        {
2365          rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2366                     tmp_ordsgn,v, bits);
2367        }
2368        else
2369        {
2370          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2371                     tmp_typ[typ_i]);
2372          r->pVarLowIndex=j;
2373          typ_i++;
2374          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2375                     tmp_ordsgn,v, bits);
2376        }
2377        break;
2378
2379      case ringorder_ds:
2380        if (r->block0[i]==r->block1[i])
2381        {
2382          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
2383                         tmp_ordsgn,v,bits);
2384        }
2385        else
2386        {
2387          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2388                         tmp_typ[typ_i]);
2389          r->pVarLowIndex=j;
2390          typ_i++;
2391          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2392                         prev_ordsgn,tmp_ordsgn,v,bits);
2393        }
2394        break;
2395
2396      case ringorder_Ds:
2397        if (r->block0[i]==r->block1[i])
2398        {
2399          rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i],prev_ordsgn,
2400                         tmp_ordsgn,v, bits);
2401        }
2402        else
2403        {
2404          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2405                         tmp_typ[typ_i]);
2406          r->pVarLowIndex=j;
2407          typ_i++;
2408          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2409                     tmp_ordsgn,v, bits);
2410        }
2411        break;
2412
2413      case ringorder_wp:
2414        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2415                   tmp_typ[typ_i], r->wvhdl[i]);
2416        r->pVarLowIndex=j;
2417        typ_i++;
2418        if (r->block1[i]!=r->block0[i])
2419          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2420                         tmp_ordsgn, v,bits);
2421        break;
2422
2423      case ringorder_Wp:
2424        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2425                   tmp_typ[typ_i], r->wvhdl[i]);
2426        r->pVarLowIndex=j;
2427        typ_i++;
2428        if (r->block1[i]!=r->block0[i])
2429          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2430                     tmp_ordsgn,v, bits);
2431        break;
2432
2433      case ringorder_ws:
2434        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2435                       tmp_typ[typ_i], r->wvhdl[i]);
2436        r->pVarLowIndex=j;
2437        typ_i++;
2438        if (r->block1[i]!=r->block0[i])
2439          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2440                         tmp_ordsgn, v,bits);
2441        break;
2442
2443      case ringorder_Ws:
2444        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2445                       tmp_typ[typ_i], r->wvhdl[i]);
2446        r->pVarLowIndex=j;
2447        typ_i++;
2448        if (r->block1[i]!=r->block0[i])
2449          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2450                     tmp_ordsgn,v, bits);
2451        break;
2452
2453      case ringorder_S:
2454        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2455        r->pVarLowIndex=j;
2456        typ_i++;
2457        break;
2458
2459      case ringorder_s:
2460        rO_Syz(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2461        r->pVarLowIndex=j;
2462        typ_i++;
2463        break;
2464
2465      case ringorder_unspec:
2466      case ringorder_no:
2467        default:
2468          Print("undef. ringorder used\n");
2469          break;
2470    }
2471  }
2472
2473  int j0=j; // save j
2474  int j_bits0=j_bits; // save jbits
2475  rO_Align(j,j_bits);
2476  j_bits=j_bits0; j=j0;
2477
2478  r->pCompHighIndex=(j-1)/(sizeof(long)/sizeof(Exponent_t));
2479
2480  // fill in some empty slots with variables not already covered
2481  // v0 is special, is therefore normally already covered
2482  // but if not:
2483  if (v[0]== -1)
2484  {
2485    if (prev_ordsgn==1)
2486    {
2487      rO_Align(j, j_bits);
2488      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2489    }
2490    else
2491    {
2492      rO_Align(j, j_bits);
2493      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2494    }
2495  }
2496  // the variables
2497  for(i=1 ; i<r->N+1 ; i++)
2498  {
2499    if(v[i]==(-1))
2500    {
2501      if (prev_ordsgn==1)
2502      {
2503        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits);
2504      }
2505      else
2506      {
2507        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits);
2508      }
2509    }
2510  }
2511
2512  r->pVarHighIndex=j - (j_bits==0);
2513  rO_Align(j,j_bits);
2514  // ----------------------------
2515  // finished with constructing the monomial, computing sizes:
2516
2517  r->ExpESize=j;
2518  r->ExpLSize=j/(sizeof(long)/sizeof(Exponent_t));
2519  r->mm_specHeap = mmGetSpecHeap(POLYSIZE + (r->ExpLSize)*sizeof(long));
2520  assume(r->mm_specHeap != NULL);
2521
2522  // ----------------------------
2523  // indices and ordsgn vector for comparison
2524  //
2525#ifndef WORDS_BIGENDIAN
2526  r->pCompLowIndex = r->ExpLSize - 1 - r->pCompHighIndex;
2527  r->pCompHighIndex = r->ExpLSize - 1;
2528#else
2529  r->pCompLowIndex=0;
2530  // r->pCompHighIndex already set
2531#endif
2532  r->pCompLSize = r->pCompHighIndex - r->pCompLowIndex + 1;
2533  r->ordsgn=(long *)Alloc(r->pCompLSize*sizeof(long));
2534
2535  for(j=r->pCompLowIndex;j<=r->pCompHighIndex;j++)
2536  {
2537    r->ordsgn[r->pCompLSize - (j - r->pCompLowIndex) - 1]
2538      = tmp_ordsgn[j-r->pCompLowIndex];
2539  }
2540
2541  Free((ADDRESS)tmp_ordsgn,(2*(n+r->N)*sizeof(long)));
2542
2543  // ----------------------------
2544  // description of orderings for setm:
2545  //
2546  r->OrdSize=typ_i;
2547  if (typ_i==0) r->typ=NULL;
2548  else
2549  {
2550    r->typ=(sro_ord*)Alloc(typ_i*sizeof(sro_ord));
2551    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
2552  }
2553  Free((ADDRESS)tmp_typ,(2*(n+r->N)*sizeof(sro_ord)));
2554
2555#ifndef WORDS_BIGENDIAN
2556  // LITTLE_ENDIAN: revert some stuff in r->typ
2557  for(j=r->OrdSize-1;j>=0;j--)
2558  {
2559    if(r->typ[j].ord_typ==ro_cp)
2560    {
2561      int end_place=r->typ[j].data.cp.place
2562                     +r->typ[j].data.cp.end-r->typ[j].data.cp.start;
2563      r->typ[j].data.cp.place=r->ExpESize-end_place-1;
2564    }
2565    //else if(r->typ[j].ord_typ==ro_syzcomp)
2566    //{
2567    //  int place=r->typ[j].data.syzcomp.place;
2568    //  r->typ[j].data.syzcomp.place=r->ExpLSize-place-1;
2569    //}
2570    else
2571    {
2572      int new_index=r->ExpLSize-r->typ[j].data.dp.place-1;
2573      r->typ[j].data.dp.place=new_index;
2574    }
2575  }
2576#endif
2577
2578  // ----------------------------
2579  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
2580#ifdef WORDS_BIGENDIAN
2581  // BIGENDIAN:
2582  r->VarOffset=v;
2583#else
2584  // LITTLE-Endian: revert
2585  r->VarOffset=(int *)Alloc((r->N+1)*sizeof(int));
2586  for(j=r->N;j>=0;j--)
2587  {
2588    int tmp=v[j];
2589    r->VarOffset[j] = r->ExpESize-(tmp & 0xffffff)-1;
2590    r->VarOffset[j] |= (tmp & (~0xffffff));
2591  }
2592  Free((ADDRESS)v,(r->N+1)*sizeof(int));
2593  j=r->pVarLowIndex;
2594  r->pVarLowIndex=r->ExpESize-r->pVarHighIndex-1;
2595  r->pVarHighIndex=r->ExpESize-j-1;
2596#endif
2597
2598  // ----------------------------
2599  // other indicies
2600  r->pDivLow=r->pVarLowIndex/(sizeof(long)/sizeof(Exponent_t));
2601  r->pDivHigh=r->pVarHighIndex/(sizeof(long)/sizeof(Exponent_t));
2602  r->pCompIndex=r->VarOffset[0];
2603#ifdef WORDS_BIGENDIAN
2604  // HANNES--think of s,c,dp; s, dp, C,
2605  if(r->pCompIndex==0) r->pOrdIndex=1;
2606  else                 r->pOrdIndex=0;
2607#else
2608  if(r->pCompIndex <= r->ExpESize-1) r->pOrdIndex=r->ExpLSize-2;
2609  else                               r->pOrdIndex=r->ExpLSize-1;
2610#endif
2611  return FALSE;
2612}
2613#else /* not HAVE_SHIFTED_EXPONENTS: */
2614static void rO_Align(int &place)
2615{
2616  // increment place to the next aligned one
2617  // (count as Exponent_t,align as longs)
2618  if (place & ((sizeof(long)/sizeof(Exponent_t))-1))
2619  {
2620    place += ((sizeof(long)/sizeof(Exponent_t))-1);
2621    place &= (~((sizeof(long)/sizeof(Exponent_t))-1));
2622  }
2623}
2624
2625static void rO_TDegree(int &place, int start, int end,
2626    long *o, sro_ord &ord_struct)
2627{
2628  // degree (aligned) of variables v_start..v_end, ordsgn 1
2629  rO_Align(place);
2630  ord_struct.ord_typ=ro_dp;
2631  ord_struct.data.dp.start=start;
2632  ord_struct.data.dp.end=end;
2633  ord_struct.data.dp.place=place/(sizeof(long)/sizeof(Exponent_t));
2634  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2635  place++;
2636  rO_Align(place);
2637}
2638
2639static void rO_TDegree_neg(int &place, int start, int end,
2640    long *o, sro_ord &ord_struct)
2641{
2642  // degree (aligned) of variables v_start..v_end, ordsgn -1
2643  rO_Align(place);
2644  ord_struct.ord_typ=ro_dp;
2645  ord_struct.data.dp.start=start;
2646  ord_struct.data.dp.end=end;
2647  ord_struct.data.dp.place=place/(sizeof(long)/sizeof(Exponent_t));
2648  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2649  place++;
2650  rO_Align(place);
2651}
2652
2653static void rO_WDegree(int &place, int start, int end,
2654    long *o, sro_ord &ord_struct, int *weights)
2655{
2656  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2657  rO_Align(place);
2658  ord_struct.ord_typ=ro_wp;
2659  ord_struct.data.wp.start=start;
2660  ord_struct.data.wp.end=end;
2661  ord_struct.data.wp.place=place/(sizeof(long)/sizeof(Exponent_t));
2662  ord_struct.data.wp.weights=weights;
2663  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2664  place++;
2665  rO_Align(place);
2666}
2667
2668static void rO_WDegree_neg(int &place, int start, int end,
2669    long *o, sro_ord &ord_struct, int *weights)
2670{
2671  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2672  rO_Align(place);
2673  ord_struct.ord_typ=ro_wp;
2674  ord_struct.data.wp.start=start;
2675  ord_struct.data.wp.end=end;
2676  ord_struct.data.wp.place=place/(sizeof(long)/sizeof(Exponent_t));
2677  ord_struct.data.wp.weights=weights;
2678  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2679  place++;
2680  rO_Align(place);
2681}
2682
2683static void rO_LexVars(int &place, int start, int end, int &prev_ord,
2684    long *o,int *v)
2685{
2686  // a block of variables v_start..v_end with lex order, ordsgn 1
2687  int k;
2688  int incr=1;
2689  if(prev_ord!=1) rO_Align(place);
2690  if (start>end)
2691  {
2692    incr=-1;
2693  }
2694  for(k=start;;k+=incr)
2695  {
2696    o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2697    v[k]=place;
2698    place++;
2699    if (k==end) break;
2700  }
2701  prev_ord=1;
2702}
2703
2704static void rO_LexVars_neg(int &place, int start, int end, int &prev_ord,
2705    long *o,int *v)
2706{
2707  // a block of variables v_start..v_end with lex order, ordsgn -1
2708  int k;
2709  int incr=1;
2710  if(prev_ord!=-1) rO_Align(place);
2711  if (start>end)
2712  {
2713    incr=-1;
2714  }
2715  for(k=start;;k+=incr)
2716  {
2717    o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2718    v[k]=place;
2719    place++;
2720    if (k==end) break;
2721  }
2722  prev_ord=-1;
2723}
2724
2725#ifdef LONG_MONOMS
2726static void rO_DupVars(int &place, int start, int end)
2727{
2728  // a block of variables v_start..v_end to be duplicated (for pDivisibleBy):
2729  place+=(end-start+1);
2730}
2731#endif
2732
2733static void rO_Syzcomp(int &place, int &prev_ord,
2734    long *o, sro_ord &ord_struct)
2735{
2736  // ordering is derived from component number
2737  rO_Align(place);
2738  ord_struct.ord_typ=ro_syzcomp;
2739  ord_struct.data.syzcomp.place=place/(sizeof(long)/sizeof(Exponent_t));
2740  ord_struct.data.syzcomp.Components=NULL;
2741  ord_struct.data.syzcomp.ShiftedComponents=NULL;
2742  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2743  prev_ord=1;
2744  place++;
2745  rO_Align(place);
2746}
2747
2748static void rO_Syz(int &place, int &prev_ord,
2749    long *o, sro_ord &ord_struct)
2750{
2751  // ordering is derived from component number
2752  if(prev_ord!= -1) rO_Align(place);
2753  ord_struct.ord_typ=ro_syz;
2754  ord_struct.data.syz.place=place/(sizeof(long)/sizeof(Exponent_t));
2755  ord_struct.data.syz.limit=0;
2756  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2757  prev_ord=-1;
2758  place++;
2759  rO_Align(place);
2760}
2761
2762BOOLEAN rComplete(ring r, int force)
2763{
2764  if (r->VarOffset!=NULL && force == 0) return FALSE;
2765
2766  int n=rBlocks(r)-1;
2767  int i;
2768  int j=0;
2769  int prev_ordsgn=0;
2770  long *tmp_ordsgn=(long *)Alloc0(2*(n+r->N)*sizeof(long)); // wil be used for ordsgn
2771  int *v=(int *)Alloc((r->N+1)*sizeof(int)); // will be used for VarOffset
2772  for(i=r->N; i>=0 ; i--)
2773  {
2774    v[i]=-1;
2775  }
2776  sro_ord *tmp_typ=(sro_ord *)Alloc0(2*(n+r->N)*sizeof(sro_ord));
2777  int typ_i=0;
2778  r->pVarLowIndex=0;
2779
2780  // fill in v, tmp_typ, tmp_ordsgn, determine pVarLowIndex, typ_i (== ordSize)
2781  for(i=0;i<n;i++)
2782  {
2783    switch (r->order[i])
2784    {
2785      case ringorder_a:
2786        rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2787                   r->wvhdl[i]);
2788        r->pVarLowIndex=j;
2789        typ_i++;
2790        break;
2791
2792      case ringorder_c:
2793        rO_LexVars_neg(j, 0,0, prev_ordsgn,tmp_ordsgn,v);
2794        break;
2795
2796      case ringorder_C:
2797        rO_LexVars(j, 0,0, prev_ordsgn,tmp_ordsgn,v);
2798        break;
2799
2800      case ringorder_M:
2801        {
2802          int k,l;
2803          k=r->block1[i]-r->block0[i]+1; // number of vars
2804          for(l=0;l<k;l++)
2805          {
2806            rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2807                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
2808            typ_i++;
2809          }
2810          r->pVarLowIndex=j;
2811          break;
2812        }
2813
2814      case ringorder_lp:
2815        rO_LexVars(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2816        break;
2817
2818      case ringorder_ls:
2819        rO_LexVars_neg(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2820        break;
2821
2822      case ringorder_dp:
2823        if (r->block0[i]==r->block1[i])
2824        {
2825          rO_LexVars(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2826        }
2827        else
2828        {
2829          rO_TDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2830          r->pVarLowIndex=j;
2831          typ_i++;
2832          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1,
2833                         prev_ordsgn,tmp_ordsgn,v);
2834        }
2835        break;
2836
2837      case ringorder_Dp:
2838        if (r->block0[i]==r->block1[i])
2839        {
2840          rO_LexVars(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2841        }
2842        else
2843        {
2844          rO_TDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2845          r->pVarLowIndex=j;
2846          typ_i++;
2847          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2848        }
2849        break;
2850
2851      case ringorder_ds:
2852        if (r->block0[i]==r->block1[i])
2853        {
2854          rO_LexVars_neg(j, r->block0[i],r->block1[i],prev_ordsgn,tmp_ordsgn,v);
2855        }
2856        else
2857        {
2858          rO_TDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2859          r->pVarLowIndex=j;
2860          typ_i++;
2861          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1,
2862                         prev_ordsgn,tmp_ordsgn,v);
2863        }
2864        break;
2865
2866      case ringorder_Ds:
2867        if (r->block0[i]==r->block1[i])
2868        {
2869          rO_LexVars_neg(j, r->block0[i],r->block1[i],prev_ordsgn,tmp_ordsgn,v);
2870        }
2871        else
2872        {
2873          rO_TDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2874          r->pVarLowIndex=j;
2875          typ_i++;
2876          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2877        }
2878        break;
2879
2880      case ringorder_wp:
2881        rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2882                   r->wvhdl[i]);
2883        r->pVarLowIndex=j;
2884        typ_i++;
2885        if (r->block1[i]!=r->block0[i])
2886          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1, prev_ordsgn,tmp_ordsgn,v);
2887        break;
2888
2889      case ringorder_Wp:
2890        rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2891                  r->wvhdl[i]);
2892        r->pVarLowIndex=j;
2893        typ_i++;
2894        if (r->block1[i]!=r->block0[i])
2895          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2896        break;
2897
2898      case ringorder_ws:
2899        rO_WDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2900                       r->wvhdl[i]);
2901        r->pVarLowIndex=j;
2902        typ_i++;
2903        if (r->block1[i]!=r->block0[i])
2904          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1, prev_ordsgn,tmp_ordsgn,v);
2905        break;
2906
2907      case ringorder_Ws:
2908        rO_WDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2909                       r->wvhdl[i]);
2910        r->pVarLowIndex=j;
2911        typ_i++;
2912        if (r->block1[i]!=r->block0[i])
2913          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2914        break;
2915
2916      case ringorder_S:
2917        rO_Syzcomp(j, prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2918        r->pVarLowIndex=j;
2919        typ_i++;
2920        break;
2921
2922      case ringorder_s:
2923        rO_Syz(j, prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2924        r->pVarLowIndex=j;
2925        typ_i++;
2926        break;
2927
2928      case ringorder_unspec:
2929      case ringorder_no:
2930        default:
2931          Print("undef. ringorder used\n");
2932          break;
2933    }
2934  }
2935
2936  int j0=j-1;
2937  rO_Align(j);
2938  r->pCompHighIndex=(j-1)/(sizeof(long)/sizeof(Exponent_t));
2939  j=j0+1;
2940
2941  // fill in some empty slots with variables not already covered
2942  // v0 is special, is therefore normally already covered
2943  // but if not:
2944  for(i=0 ; i<r->N+1 ; i++)
2945  {
2946    if(v[i]==(-1))
2947    {
2948      if (prev_ordsgn==1)
2949      {
2950        rO_LexVars(j, i,i, prev_ordsgn,tmp_ordsgn,v);
2951      }
2952      else
2953      {
2954        rO_LexVars_neg(j, i,i, prev_ordsgn,tmp_ordsgn,v);
2955      }
2956    }
2957  }
2958
2959#ifdef LONG_MONOMS
2960  // find out where we need duplicate variables (for divisibility tests)
2961  for(i=1 ; i<r->N+1 ; i++)
2962  {
2963    if(v[i]<r->pVarLowIndex)
2964    {
2965      int start=i;
2966      while((i<r->N) && (v[i+1]<r->pVarLowIndex)) i++;
2967      tmp_typ[typ_i].ord_typ=ro_cp;
2968      tmp_typ[typ_i].data.cp.place=j;
2969      tmp_typ[typ_i].data.cp.start=start;
2970      tmp_typ[typ_i].data.cp.end=i;
2971      rO_DupVars(j, start,i);
2972      typ_i++;
2973    }
2974  }
2975#endif
2976
2977  r->pVarHighIndex=j-1;
2978  rO_Align(j);
2979  // ----------------------------
2980  // finished with constructing the monomial, computing sizes:
2981
2982  r->ExpESize=j;
2983  r->ExpLSize=j/(sizeof(long)/sizeof(Exponent_t));
2984  r->mm_specHeap = mmGetSpecHeap(POLYSIZE + (r->ExpLSize)*sizeof(long));
2985  assume(r->mm_specHeap != NULL);
2986
2987  // ----------------------------
2988  // indices and ordsgn vector for comparison
2989  //
2990#ifndef WORDS_BIGENDIAN
2991  r->pCompLowIndex = r->ExpLSize - 1 - r->pCompHighIndex;
2992  r->pCompHighIndex = r->ExpLSize - 1;
2993#else
2994  r->pCompLowIndex=0;
2995  // r->pCompHighIndex already set
2996#endif
2997  r->pCompLSize = r->pCompHighIndex - r->pCompLowIndex + 1;
2998  r->ordsgn=(long *)Alloc(r->pCompLSize*sizeof(long));
2999
3000  for(j=r->pCompLowIndex;j<=r->pCompHighIndex;j++)
3001  {
3002    r->ordsgn[r->pCompLSize - (j - r->pCompLowIndex) - 1]
3003      = tmp_ordsgn[j-r->pCompLowIndex];
3004  }
3005
3006  Free((ADDRESS)tmp_ordsgn,(2*(n+r->N)*sizeof(long)));
3007
3008  // ----------------------------
3009  // description of orderings for setm:
3010  //
3011  r->OrdSize=typ_i;
3012  if (typ_i==0) r->typ=NULL;
3013  else
3014  {
3015    r->typ=(sro_ord*)Alloc(typ_i*sizeof(sro_ord));
3016    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3017  }
3018  Free((ADDRESS)tmp_typ,(2*(n+r->N)*sizeof(sro_ord)));
3019
3020#ifndef WORDS_BIGENDIAN
3021  // LITTLE_ENDIAN: revert some stuff in r->typ
3022  for(j=r->OrdSize-1;j>=0;j--)
3023  {
3024    if(r->typ[j].ord_typ==ro_cp)
3025    {
3026      int end_place=r->typ[j].data.cp.place
3027                     +r->typ[j].data.cp.end-r->typ[j].data.cp.start;
3028      r->typ[j].data.cp.place=r->ExpESize-end_place-1;
3029    }
3030    //else if(r->typ[j].ord_typ==ro_syzcomp)
3031    //{
3032    //  int place=r->typ[j].data.syzcomp.place;
3033    //  r->typ[j].data.syzcomp.place=r->ExpLSize-place-1;
3034    //}
3035    else
3036    {
3037      int new_index=r->ExpLSize-r->typ[j].data.dp.place-1;
3038      r->typ[j].data.dp.place=new_index;
3039    }
3040  }
3041#endif
3042
3043  // ----------------------------
3044  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3045#ifdef WORDS_BIGENDIAN
3046  // BIGENDIAN:
3047  r->VarOffset=v;
3048#else
3049  // LITTLE-Endian: revert
3050  r->VarOffset=(int *)Alloc((r->N+1)*sizeof(int));
3051  for(j=r->N;j>=0;j--)
3052  {
3053    r->VarOffset[j]=r->ExpESize-v[j]-1;
3054  }
3055  Free((ADDRESS)v,(r->N+1)*sizeof(int));
3056  j=r->pVarLowIndex;
3057  r->pVarLowIndex=r->ExpESize-r->pVarHighIndex-1;
3058  r->pVarHighIndex=r->ExpESize-j-1;
3059#endif
3060
3061  // ----------------------------
3062  // other indicies
3063  r->pDivLow=r->pVarLowIndex/(sizeof(long)/sizeof(Exponent_t));
3064  r->pDivHigh=r->pVarHighIndex/(sizeof(long)/sizeof(Exponent_t));
3065  r->pCompIndex=r->VarOffset[0];
3066  // HANNES--think of s,c,dp; s, dp, C,
3067#ifdef WORDS_BIGENDIAN
3068  if(r->pCompIndex==0) r->pOrdIndex=1;
3069  else                 r->pOrdIndex=0;
3070#else
3071  if (r->order[0] == ringorder_s)
3072  {
3073    if (r->pCompIndex == r->ExpESize-3) 
3074      r->pOrdIndex = r->ExpLSize-3;
3075    else
3076      r->pOrdIndex = r->ExpLSize-2;
3077  }
3078  else if (r->pCompIndex == r->ExpESize-1) 
3079    r->pOrdIndex=r->ExpLSize-2;
3080  else                               
3081    r->pOrdIndex=r->ExpLSize-1;
3082#endif
3083  return FALSE;
3084}
3085#endif
3086
3087void rUnComplete(ring r)
3088{
3089  if (r == NULL) return;
3090  if (r->mm_specHeap != NULL)
3091    mmUnGetSpecHeap(&(r->mm_specHeap));
3092  Free((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3093  if (r->order != NULL)
3094  {
3095    if (r->order[0] == ringorder_s && r->typ[0].data.syz.limit > 0)
3096    {
3097      Free(r->typ[0].data.syz.syz_index, 
3098           (r->typ[0].data.syz.limit +1)*sizeof(int));
3099    }
3100  }
3101  if (r->OrdSize!=0 && r->typ != NULL)
3102  {
3103    Free((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord));
3104  }
3105  if (r->ordsgn != NULL && r->pCompLSize != 0)
3106    Free((ADDRESS)r->ordsgn,r->pCompLSize*sizeof(long));
3107}
3108
3109void rDebugPrint(ring r)
3110{
3111  int j;
3112  PrintS("varoffset:\n");
3113  #ifdef HAVE_SHIFTED_EXPONENTS
3114  for(j=0;j<=r->N;j++) Print("  v%d at pos %d, bit %d\n",
3115     j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
3116  Print("bitmask=0x%x\n",r->bitmask);
3117  #else
3118  for(j=0;j<=r->N;j++)
3119    Print("  v%d at pos %d\n",j,r->VarOffset[j]);
3120  #endif
3121  PrintS("ordsgn:\n");
3122  for(j=0;j<r->pCompLSize;j++)
3123    Print("  ordsgn %d at pos %d\n",r->ordsgn[j],j);
3124  Print("OrdSgn:%d\n",r->OrdSgn);
3125  PrintS("ordrec:\n");
3126  for(j=0;j<r->OrdSize;j++)
3127  {
3128    char *TYP[]={"ro_dp","ro_wp","ro_cp","ro_syzcomp", "ro_syz", "ro_none"};
3129    Print("  typ %s",TYP[r->typ[j].ord_typ]);
3130    Print("  place %d",r->typ[j].data.dp.place);
3131    if (r->typ[j].ord_typ!=ro_syzcomp)
3132    {
3133      Print("  start %d",r->typ[j].data.dp.start);
3134      Print("  end %d",r->typ[j].data.dp.end);
3135      if (r->typ[j].ord_typ==ro_wp)
3136      {
3137        Print(" w:");
3138        int l;
3139        for(l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
3140          Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
3141      }
3142    }
3143    PrintLn();
3144  }
3145  Print("pVarLowIndex:%d ",r->pVarLowIndex);
3146  Print("pVarHighIndex:%d\n",r->pVarHighIndex);
3147  Print("pDivLow:%d ",r->pDivLow);
3148  Print("pDivHigh:%d\n",r->pDivHigh);
3149  Print("pCompLowIndex:%d ",r->pCompLowIndex);
3150  Print("pCompHighIndex:%d\n",r->pCompHighIndex);
3151  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
3152  Print("ExpESize:%d ",r->ExpESize);
3153  Print("ExpLSize:%d ",r->ExpLSize);
3154  Print("OrdSize:%d\n",r->OrdSize);
3155}
3156
3157void pDebugPrint(poly p)
3158{
3159  int i;
3160  pWrite(p);
3161  while(p!=NULL)
3162  {
3163    Print("exp.e[0..%d]\n",currRing->ExpESize-1);
3164    for(i=0;i<currRing->ExpESize;i++)
3165      Print("%d ",p->exp.e[i]);
3166    Print("\nexp.l[0..%d]\n",currRing->ExpLSize-1);
3167    for(i=0;i<currRing->ExpLSize;i++)
3168      Print("%d ",p->exp.l[i]);
3169    PrintLn();pIter(p);
3170  }
3171}
3172
3173#if 0
3174/*2
3175 * create a copy of the ring r, which must be equivalent to currRing
3176 * used for qring definition,..
3177 * (i.e.: normal rings: same nCopy as currRing;
3178 *        qring:        same nCopy, same idCopy as currRing)
3179 */
3180ring   rCopyAndAddSComps(ring r)
3181{
3182  int i,j;
3183  int *pi;
3184  ring res=(ring)AllocSizeOf(ip_sring);
3185
3186  memcpy4(res,r,sizeof(ip_sring));
3187  res->ref=0;
3188  if (r->parameter!=NULL)
3189  {
3190    res->minpoly=nCopy(r->minpoly);
3191    int l=rPar(r);
3192    res->parameter=(char **)Alloc(l*sizeof(char_ptr));
3193    int i;
3194    for(i=0;i<r->P;i++)
3195    {
3196      res->parameter[i]=mstrdup(r->parameter[i]);
3197    }
3198  }
3199  res->names   = (char **)Alloc(r->N * sizeof(char_ptr));
3200  i=1; // ringorder_C ->  ringorder_S
3201  pi=r->order;
3202  while ((*pi)!=0) { i++;pi++; }
3203  res->wvhdl   = (int **)Alloc(i * sizeof(int_ptr));
3204  res->order   = (int *) Alloc(i * sizeof(int));
3205  res->block0  = (int *) Alloc(i * sizeof(int));
3206  res->block1  = (int *) Alloc(i * sizeof(int));
3207  for (j=0; j<i; j++)
3208  {
3209    if (r->wvhdl[j]!=NULL)
3210    {
3211      res->wvhdl[j]=(int*)AllocL(mmSizeL((ADDRESS)r->wvhdl[j]));
3212      memcpy(res->wvhdl[j],r->wvhdl[j],mmSizeL((ADDRESS)r->wvhdl[j]));
3213    }
3214    else
3215      res->wvhdl[j]=NULL;
3216  }
3217  memcpy4(res->order+1,r->order,i * sizeof(int));
3218  memcpy4(res->block0+1,r->block0,i * sizeof(int));
3219  memcpy4(res->block1+1,r->block1,i * sizeof(int));
3220  for (i=0; i<res->N; i++)
3221  {
3222    res->names[i] = mstrdup(r->names[i]);
3223  }
3224  res->idroot = NULL;
3225  if (r->qideal!=NULL) res->qideal= idCopy(r->qideal);
3226  // add the additional ordering:
3227  res->order[1]=ringorder_S;
3228  res->block0[1]=1;
3229  res->block1[1]=0; // block1-block0 is the length
3230  res->wvhdl[1]=NULL;
3231  rComplete(res, 1);
3232  return res;
3233}
3234#endif
3235
3236/*2
3237* asssume that rComplete was called with r
3238* assume that the first block ist ringorder_S
3239* change the block to reflect the sequence given by appending v
3240*/
3241
3242#ifdef PDEBUG
3243void rDBChangeSComps(int* currComponents,
3244                     long* currShiftedComponents,
3245                     int length,
3246                     ring r)
3247{
3248  r->typ[1].data.syzcomp.length = length;
3249  rNChangeSComps( currComponents, currShiftedComponents, r);
3250}
3251void rDBGetSComps(int** currComponents,
3252                 long** currShiftedComponents,
3253                 int *length,
3254                 ring r)
3255{
3256  *length = r->typ[1].data.syzcomp.length;
3257  rNGetSComps( currComponents, currShiftedComponents, r);
3258}
3259#endif
3260
3261void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
3262{
3263  assume(r->order[1]==ringorder_S);
3264
3265  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
3266  r->typ[1].data.syzcomp.Components = currComponents;
3267}
3268
3269void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
3270{
3271  assume(r->order[1]==ringorder_S);
3272
3273  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
3274  *currComponents =   r->typ[1].data.syzcomp.Components;
3275}
3276
3277/////////////////////////////////////////////////////////////////////////////
3278//
3279// The following routines all take as input a ring r, and return R
3280// where R has a certain property. P might be equal r in which case r
3281// had already this property
3282//
3283// Without argument, these functions work on currRing and change it,
3284// if necessary
3285
3286// for the time being, this is still here
3287static ring rAssureSyzComp(ring r);
3288ring rCurrRingAssureSyzComp()
3289{
3290  ring r = rAssureSyzComp(currRing);
3291  if (r != currRing) 
3292  {
3293    ring old_ring = currRing;
3294    rChangeCurrRing(r, TRUE);
3295    if (old_ring->qideal != NULL) 
3296    {
3297      r->qideal = idrCopyR_NoSort(old_ring->qideal, old_ring);
3298      assume(idRankFreeModule(r->qideal) == 0);
3299      currQuotient = r->qideal;
3300    }
3301  }
3302  return r;
3303}
3304
3305static ring rAssureSyzComp(ring r)
3306{
3307  if (r->order[0] == ringorder_s) return r;
3308
3309  ring res=rCopy0(r, FALSE, FALSE);
3310  int i=rBlocks(r);
3311  int j;
3312
3313  res->order=(int *)Alloc0((i+1)*sizeof(int));
3314  for(j=i;j>0;j--) res->order[j]=r->order[j-1];
3315  res->order[0]=ringorder_s;
3316
3317  res->block0=(int *)Alloc0((i+1)*sizeof(int));
3318  for(j=i;j>0;j--) res->block0[j]=r->block0[j-1];
3319
3320  res->block1=(int *)Alloc0((i+1)*sizeof(int));
3321  for(j=i;j>0;j--) res->block1[j]=r->block1[j-1];
3322
3323  int ** wvhdl =(int **)Alloc0((i+1)*sizeof(int**));
3324  for(j=i;j>0;j--) 
3325  {
3326    if (r->wvhdl[j-1] != NULL)
3327    {
3328      wvhdl[j] = (int*) AllocL(mmSizeL((ADDRESS)r->wvhdl[j-1]));
3329      memcpy(wvhdl[j], r->wvhdl[j-1],mmSizeL((ADDRESS)r->wvhdl[j-1]));
3330    }
3331  }
3332  res->wvhdl = wvhdl;
3333
3334  rComplete(res,1);
3335  return res;
3336}
3337 
3338
3339// use this fro global ordering consisting of two blocks
3340static ring rCurrRingAssure_Global(rRingOrder_t b1, rRingOrder_t b2)
3341{
3342  int r_blocks = rBlocks(currRing);
3343  int i;
3344 
3345  if (r_blocks == 2 && currRing->order[0] == b1 && currRing->order[2] == 0)
3346    return currRing;
3347 
3348  ring res = rCopy0(currRing, FALSE, FALSE);
3349  res->order = (int*)Alloc0(3*sizeof(int));
3350  res->block0 = (int*)Alloc0(3*sizeof(int));
3351  res->block1 = (int*)Alloc0(3*sizeof(int));
3352  res->wvhdl = (int**)Alloc0(3*sizeof(int*));
3353  res->order[0] = b1;
3354  res->order[1] = b2;
3355  res->block0[0] = 1;
3356  res->block1[0] = currRing->N;
3357  res->OrdSgn = 1;
3358  rComplete(res, 1);
3359  rChangeCurrRing(res, TRUE);
3360  return res;
3361}
3362
3363
3364ring rCurrRingAssure_dp_S()
3365{
3366  return rCurrRingAssure_Global(ringorder_dp, ringorder_S);
3367}
3368
3369ring rCurrRingAssure_dp_C()
3370{
3371  return rCurrRingAssure_Global(ringorder_dp, ringorder_C);
3372}
3373
3374void rSetSyzComp(int k)
3375{
3376  if (TEST_OPT_PROT) Print("{%d}", k);
3377  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz))
3378  {
3379    assume(k > currRing->typ[0].data.syz.limit);
3380    int i;
3381    if (currRing->typ[0].data.syz.limit == 0)
3382    {
3383      currRing->typ[0].data.syz.syz_index = (int*) Alloc((k+1)*sizeof(int));
3384      currRing->typ[0].data.syz.syz_index[0] = 0;
3385      currRing->typ[0].data.syz.curr_index = 1;
3386    }
3387    else
3388    {
3389      currRing->typ[0].data.syz.syz_index = (int*)
3390        ReAlloc(currRing->typ[0].data.syz.syz_index, 
3391                (currRing->typ[0].data.syz.limit+1)*sizeof(int),
3392                (k+1)*sizeof(int));
3393    }
3394    for (i=currRing->typ[0].data.syz.limit + 1; i<= k; i++)
3395    {
3396      currRing->typ[0].data.syz.syz_index[i] = 
3397        currRing->typ[0].data.syz.curr_index;
3398    }
3399    currRing->typ[0].data.syz.limit = k;
3400    currRing->typ[0].data.syz.curr_index++;
3401  }
3402  else if ((currRing->order[0]!=ringorder_c) && (k!=0))
3403  {
3404    WarnS("syzcomp in incompatible ring");
3405  }
3406}
3407
3408// return the max-comonent wchich has syzIndex i
3409int rGetMaxSyzComp(int i)
3410{
3411  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz) &&
3412      currRing->typ[0].data.syz.limit > 0 && i > 0)
3413  {
3414    assume(i <= currRing->typ[0].data.syz.limit);
3415    int j;
3416    for (j=0; j<currRing->typ[0].data.syz.limit; j++)
3417    {
3418      if (currRing->typ[0].data.syz.syz_index[j] == i  &&
3419          currRing->typ[0].data.syz.syz_index[j+1] != i)
3420      {
3421        assume(currRing->typ[0].data.syz.syz_index[j+1] == i+1);
3422        return j;
3423      }
3424    }
3425    return currRing->typ[0].data.syz.limit;
3426  }
3427  else
3428  {
3429    return 0;
3430  }
3431}
3432
3433   
Note: See TracBrowser for help on using the repository browser.