source: git/Singular/ring.cc @ 6e56de

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