source: git/Singular/ring.cc @ fdc537

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