source: git/Singular/ring.cc @ e95eaa7

fieker-DuValspielwiese
Last change on this file since e95eaa7 was e95eaa7, checked in by Hans Schönemann <hannes@…>, 24 years ago
*hannes: debug for shifted exp. git-svn-id: file:///usr/local/Singular/svn/trunk@4212 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 88.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.99 2000-03-21 16:21:43 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 <= 3)
2246  {
2247    bits=2; bitmask = 3;
2248  }
2249  else if (bitmask <= 7)
2250  {
2251    bits=3; bitmask=7;
2252  }
2253  else if (bitmask <= 0xf)
2254  {
2255    bits=4; bitmask=0xf;
2256  }
2257  else if (bitmask <= 0x1f)
2258  {
2259    bits=5; bitmask=0x1f;
2260  }
2261  else if (bitmask <= 0x3f)
2262  {
2263    bits=6; bitmask=0x3f;
2264  }
2265#if SIZEOF_LONG == 8
2266  else if (bitmask <= 0x7f)
2267  {
2268    bits=7; bitmask=0x7f; /* 64 bit longs only */
2269  }
2270#endif
2271  else if (bitmask <= 0xff)
2272  {
2273    bits=8; bitmask=0xff;
2274  }
2275#if SIZEOF_LONG == 8
2276  else if (bitmask <= 0x1ff)
2277  {
2278    bits=9; bitmask=0x1ff; /* 64 bit longs only */
2279  }
2280#endif
2281  else if (bitmask <= 0x3ff)
2282  {
2283    bits=10; bitmask=0x3ff;
2284  }
2285#if SIZEOF_LONG == 8
2286  else if (bitmask <= 0xfff)
2287  {
2288    bits=12; bitmask=0xfff; /* 64 bit longs only */
2289  }
2290#endif
2291  else if (bitmask <= 0xffff)
2292  {
2293    bits=16; bitmask=0xffff;
2294  }
2295#if SIZEOF_LONG == 8
2296  else if (bitmask <= 0xfffff)
2297  {
2298    bits=20; bitmask=0xfffff; /* 64 bit longs only */
2299  }
2300  else if (bitmask <= 0xffffffff)
2301  {
2302    bits=32; bitmask=0xffffffff;
2303  }
2304  else
2305  {
2306    bits=64; bitmask=0xffffffffffffffff;
2307  }
2308#else
2309  else
2310  {
2311    bits=32; bitmask=0xffffffff;
2312  }
2313#endif
2314  return bitmask;
2315}
2316
2317BOOLEAN rComplete(ring r, int force)
2318{
2319  if (r->VarOffset!=NULL && force == 0) return FALSE;
2320
2321  int n=rBlocks(r)-1;
2322  int i;
2323  int bits;
2324  r->bitmask=rGetExpSize(r->bitmask,bits);
2325  // will be used for ordsgn:
2326  long *tmp_ordsgn=(long *)Alloc0(2*(n+r->N)*sizeof(long));
2327  // will be used for VarOffset:
2328  int *v=(int *)Alloc((r->N+1)*sizeof(int));
2329  for(i=r->N; i>=0 ; i--)
2330  {
2331    v[i]=-1;
2332  }
2333  sro_ord *tmp_typ=(sro_ord *)Alloc0(2*(n+r->N)*sizeof(sro_ord));
2334  int typ_i=0;
2335  int prev_ordsgn=0;
2336  r->pVarLowIndex=0;
2337
2338  // fill in v, tmp_typ, tmp_ordsgn, determine pVarLowIndex, typ_i (== ordSize)
2339  int j=0;
2340  int j_bits=BITS_PER_LONG;
2341  for(i=0;i<n;i++)
2342  {
2343    switch (r->order[i])
2344    {
2345      case ringorder_a:
2346        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2347                   r->wvhdl[i]);
2348        r->pVarLowIndex=j;
2349        typ_i++;
2350        break;
2351
2352      case ringorder_c:
2353        rO_Align(j, j_bits);
2354        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2355        break;
2356
2357      case ringorder_C:
2358        rO_Align(j, j_bits);
2359        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2360        break;
2361
2362      case ringorder_M:
2363        {
2364          int k,l;
2365          k=r->block1[i]-r->block0[i]+1; // number of vars
2366          for(l=0;l<k;l++)
2367          {
2368            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2369                       tmp_typ[typ_i],
2370                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
2371            typ_i++;
2372          }
2373          r->pVarLowIndex=j;
2374          break;
2375        }
2376
2377      case ringorder_lp:
2378        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2379                   tmp_ordsgn,v,bits);
2380        break;
2381
2382      case ringorder_ls:
2383        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2384                       tmp_ordsgn,v, bits);
2385        break;
2386
2387      case ringorder_dp:
2388        if (r->block0[i]==r->block1[i])
2389        {
2390          rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2391                     tmp_ordsgn,v, bits);
2392        }
2393        else
2394        {
2395          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2396                     tmp_typ[typ_i]);
2397          r->pVarLowIndex=j;
2398          typ_i++;
2399          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2400                         prev_ordsgn,tmp_ordsgn,v,bits);
2401        }
2402        break;
2403
2404      case ringorder_Dp:
2405        if (r->block0[i]==r->block1[i])
2406        {
2407          rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2408                     tmp_ordsgn,v, bits);
2409        }
2410        else
2411        {
2412          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2413                     tmp_typ[typ_i]);
2414          r->pVarLowIndex=j;
2415          typ_i++;
2416          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2417                     tmp_ordsgn,v, bits);
2418        }
2419        break;
2420
2421      case ringorder_ds:
2422        if (r->block0[i]==r->block1[i])
2423        {
2424          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
2425                         tmp_ordsgn,v,bits);
2426        }
2427        else
2428        {
2429          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2430                         tmp_typ[typ_i]);
2431          r->pVarLowIndex=j;
2432          typ_i++;
2433          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2434                         prev_ordsgn,tmp_ordsgn,v,bits);
2435        }
2436        break;
2437
2438      case ringorder_Ds:
2439        if (r->block0[i]==r->block1[i])
2440        {
2441          rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i],prev_ordsgn,
2442                         tmp_ordsgn,v, bits);
2443        }
2444        else
2445        {
2446          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2447                         tmp_typ[typ_i]);
2448          r->pVarLowIndex=j;
2449          typ_i++;
2450          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2451                     tmp_ordsgn,v, bits);
2452        }
2453        break;
2454
2455      case ringorder_wp:
2456        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2457                   tmp_typ[typ_i], r->wvhdl[i]);
2458        r->pVarLowIndex=j;
2459        typ_i++;
2460        if (r->block1[i]!=r->block0[i])
2461          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2462                         tmp_ordsgn, v,bits);
2463        break;
2464
2465      case ringorder_Wp:
2466        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2467                   tmp_typ[typ_i], r->wvhdl[i]);
2468        r->pVarLowIndex=j;
2469        typ_i++;
2470        if (r->block1[i]!=r->block0[i])
2471          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2472                     tmp_ordsgn,v, bits);
2473        break;
2474
2475      case ringorder_ws:
2476        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2477                       tmp_typ[typ_i], r->wvhdl[i]);
2478        r->pVarLowIndex=j;
2479        typ_i++;
2480        if (r->block1[i]!=r->block0[i])
2481          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2482                         tmp_ordsgn, v,bits);
2483        break;
2484
2485      case ringorder_Ws:
2486        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2487                       tmp_typ[typ_i], r->wvhdl[i]);
2488        r->pVarLowIndex=j;
2489        typ_i++;
2490        if (r->block1[i]!=r->block0[i])
2491          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2492                     tmp_ordsgn,v, bits);
2493        break;
2494
2495      case ringorder_S:
2496        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2497        r->pVarLowIndex=j;
2498        typ_i++;
2499        break;
2500
2501      case ringorder_s:
2502        rO_Syz(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2503        r->pVarLowIndex=j;
2504        typ_i++;
2505        break;
2506
2507      case ringorder_unspec:
2508      case ringorder_no:
2509        default:
2510          Print("undef. ringorder used\n");
2511          break;
2512    }
2513  }
2514
2515  int j0=j; // save j
2516  int j_bits0=j_bits; // save jbits
2517  rO_Align(j,j_bits);
2518  r->pCompHighIndex=j-1;
2519
2520  j_bits=j_bits0; j=j0;
2521
2522  // fill in some empty slots with variables not already covered
2523  // v0 is special, is therefore normally already covered
2524  // but if not:
2525  if (v[0]== -1)
2526  {
2527    if (prev_ordsgn==1)
2528    {
2529      rO_Align(j, j_bits);
2530      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2531    }
2532    else
2533    {
2534      rO_Align(j, j_bits);
2535      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG);
2536    }
2537  }
2538  // the variables
2539  for(i=1 ; i<r->N+1 ; i++)
2540  {
2541    if(v[i]==(-1))
2542    {
2543      if (prev_ordsgn==1)
2544      {
2545        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits);
2546      }
2547      else
2548      {
2549        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits);
2550      }
2551    }
2552  }
2553
2554  r->pVarHighIndex=j - (j_bits==0);
2555  rO_Align(j,j_bits);
2556  // ----------------------------
2557  // finished with constructing the monomial, computing sizes:
2558
2559  r->ExpESize=j;
2560  r->ExpLSize=j;
2561  r->mm_specHeap = mmGetSpecHeap(POLYSIZE + (r->ExpLSize)*sizeof(long));
2562  assume(r->mm_specHeap != NULL);
2563
2564  // ----------------------------
2565  // indices and ordsgn vector for comparison
2566  //
2567#ifndef WORDS_BIGENDIAN
2568  r->pCompLowIndex = r->ExpLSize - 1 - r->pCompHighIndex;
2569  r->pCompHighIndex = r->ExpLSize - 1;
2570#else
2571  r->pCompLowIndex=0;
2572  // r->pCompHighIndex already set
2573#endif
2574  r->pCompLSize = r->pCompHighIndex - r->pCompLowIndex + 1;
2575  r->ordsgn=(long *)Alloc0(r->pCompLSize*sizeof(long));
2576
2577  for(j=r->pCompLowIndex;j<=r->pCompHighIndex;j++)
2578  {
2579    r->ordsgn[r->pCompLSize - (j - r->pCompLowIndex) - 1]
2580      = tmp_ordsgn[j-r->pCompLowIndex];
2581  }
2582
2583  Free((ADDRESS)tmp_ordsgn,(2*(n+r->N)*sizeof(long)));
2584
2585  // ----------------------------
2586  // description of orderings for setm:
2587  //
2588  r->OrdSize=typ_i;
2589  if (typ_i==0) r->typ=NULL;
2590  else
2591  {
2592    r->typ=(sro_ord*)Alloc(typ_i*sizeof(sro_ord));
2593    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
2594  }
2595  Free((ADDRESS)tmp_typ,(2*(n+r->N)*sizeof(sro_ord)));
2596
2597#ifndef WORDS_BIGENDIAN
2598  // LITTLE_ENDIAN: revert some stuff in r->typ
2599  for(j=r->OrdSize-1;j>=0;j--)
2600  {
2601    if(r->typ[j].ord_typ==ro_cp)
2602    {
2603      int end_place=r->typ[j].data.cp.place
2604                     +r->typ[j].data.cp.end-r->typ[j].data.cp.start;
2605      r->typ[j].data.cp.place=r->ExpESize-end_place-1;
2606    }
2607    //else if(r->typ[j].ord_typ==ro_syzcomp)
2608    //{
2609    //  int place=r->typ[j].data.syzcomp.place;
2610    //  r->typ[j].data.syzcomp.place=r->ExpLSize-place-1;
2611    //}
2612    else
2613    {
2614      int new_index=r->ExpLSize-r->typ[j].data.dp.place-1;
2615      r->typ[j].data.dp.place=new_index;
2616    }
2617  }
2618#endif
2619
2620  // ----------------------------
2621  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
2622#ifdef WORDS_BIGENDIAN
2623  // BIGENDIAN:
2624  r->VarOffset=v;
2625#else
2626  // LITTLE-Endian: revert
2627  r->VarOffset=(int *)Alloc((r->N+1)*sizeof(int));
2628  for(j=r->N;j>=0;j--)
2629  {
2630    int tmp=v[j];
2631    r->VarOffset[j] = r->ExpESize-(tmp & 0xffffff)-1;
2632    r->VarOffset[j] |= (tmp & (~0xffffff));
2633  }
2634  Free((ADDRESS)v,(r->N+1)*sizeof(int));
2635  j=r->pVarLowIndex;
2636  r->pVarLowIndex=r->ExpESize-r->pVarHighIndex-1;
2637  r->pVarHighIndex=r->ExpESize-j-1;
2638#endif
2639
2640  // ----------------------------
2641  // other indicies
2642#ifdef LONG_MONOMS
2643  r->pDivLow=r->pVarLowIndex;
2644  r->pDivHigh=r->pVarHighIndex;
2645#endif
2646  r->pCompIndex=r->VarOffset[0];
2647#ifdef WORDS_BIGENDIAN
2648  // HANNES--think of s,c,dp; s, dp, C,
2649  if(r->pCompIndex==0) r->pOrdIndex=1;
2650  else                 r->pOrdIndex=0;
2651#else
2652  if(r->pCompIndex == r->ExpESize-1) r->pOrdIndex=r->ExpLSize-2;
2653  else                               r->pOrdIndex=r->ExpLSize-1;
2654#endif
2655  return FALSE;
2656}
2657#else /* not HAVE_SHIFTED_EXPONENTS: */
2658static void rO_Align(int &place)
2659{
2660  // increment place to the next aligned one
2661  // (count as Exponent_t,align as longs)
2662  if (place & ((sizeof(long)/sizeof(Exponent_t))-1))
2663  {
2664    place += ((sizeof(long)/sizeof(Exponent_t))-1);
2665    place &= (~((sizeof(long)/sizeof(Exponent_t))-1));
2666  }
2667}
2668
2669static void rO_TDegree(int &place, int start, int end,
2670    long *o, sro_ord &ord_struct)
2671{
2672  // degree (aligned) of variables v_start..v_end, ordsgn 1
2673  rO_Align(place);
2674  ord_struct.ord_typ=ro_dp;
2675  ord_struct.data.dp.start=start;
2676  ord_struct.data.dp.end=end;
2677  ord_struct.data.dp.place=place/(sizeof(long)/sizeof(Exponent_t));
2678  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2679  place++;
2680  rO_Align(place);
2681}
2682
2683static void rO_TDegree_neg(int &place, int start, int end,
2684    long *o, sro_ord &ord_struct)
2685{
2686  // degree (aligned) of variables v_start..v_end, ordsgn -1
2687  rO_Align(place);
2688  ord_struct.ord_typ=ro_dp;
2689  ord_struct.data.dp.start=start;
2690  ord_struct.data.dp.end=end;
2691  ord_struct.data.dp.place=place/(sizeof(long)/sizeof(Exponent_t));
2692  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2693  place++;
2694  rO_Align(place);
2695}
2696
2697static void rO_WDegree(int &place, int start, int end,
2698    long *o, sro_ord &ord_struct, int *weights)
2699{
2700  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2701  rO_Align(place);
2702  ord_struct.ord_typ=ro_wp;
2703  ord_struct.data.wp.start=start;
2704  ord_struct.data.wp.end=end;
2705  ord_struct.data.wp.place=place/(sizeof(long)/sizeof(Exponent_t));
2706  ord_struct.data.wp.weights=weights;
2707  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2708  place++;
2709  rO_Align(place);
2710}
2711
2712static void rO_WDegree_neg(int &place, int start, int end,
2713    long *o, sro_ord &ord_struct, int *weights)
2714{
2715  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2716  rO_Align(place);
2717  ord_struct.ord_typ=ro_wp;
2718  ord_struct.data.wp.start=start;
2719  ord_struct.data.wp.end=end;
2720  ord_struct.data.wp.place=place/(sizeof(long)/sizeof(Exponent_t));
2721  ord_struct.data.wp.weights=weights;
2722  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2723  place++;
2724  rO_Align(place);
2725}
2726
2727static void rO_LexVars(int &place, int start, int end, int &prev_ord,
2728    long *o,int *v)
2729{
2730  // a block of variables v_start..v_end with lex order, ordsgn 1
2731  int k;
2732  int incr=1;
2733  if(prev_ord!=1) rO_Align(place);
2734  if (start>end)
2735  {
2736    incr=-1;
2737  }
2738  for(k=start;;k+=incr)
2739  {
2740    o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2741    v[k]=place;
2742    place++;
2743    if (k==end) break;
2744  }
2745  prev_ord=1;
2746}
2747
2748static void rO_LexVars_neg(int &place, int start, int end, int &prev_ord,
2749    long *o,int *v)
2750{
2751  // a block of variables v_start..v_end with lex order, ordsgn -1
2752  int k;
2753  int incr=1;
2754  if(prev_ord!=-1) rO_Align(place);
2755  if (start>end)
2756  {
2757    incr=-1;
2758  }
2759  for(k=start;;k+=incr)
2760  {
2761    o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2762    v[k]=place;
2763    place++;
2764    if (k==end) break;
2765  }
2766  prev_ord=-1;
2767}
2768
2769#ifdef LONG_MONOMS
2770static void rO_DupVars(int &place, int start, int end)
2771{
2772  // a block of variables v_start..v_end to be duplicated (for pDivisibleBy):
2773  place+=(end-start+1);
2774}
2775#endif
2776
2777static void rO_Syzcomp(int &place, int &prev_ord,
2778    long *o, sro_ord &ord_struct)
2779{
2780  // ordering is derived from component number
2781  rO_Align(place);
2782  ord_struct.ord_typ=ro_syzcomp;
2783  ord_struct.data.syzcomp.place=place/(sizeof(long)/sizeof(Exponent_t));
2784  ord_struct.data.syzcomp.Components=NULL;
2785  ord_struct.data.syzcomp.ShiftedComponents=NULL;
2786  o[place/(sizeof(long)/sizeof(Exponent_t))]=1;
2787  prev_ord=1;
2788  place++;
2789  rO_Align(place);
2790}
2791
2792static void rO_Syz(int &place, int &prev_ord,
2793    long *o, sro_ord &ord_struct)
2794{
2795  // ordering is derived from component number
2796  if(prev_ord!= -1) rO_Align(place);
2797  ord_struct.ord_typ=ro_syz;
2798  ord_struct.data.syz.place=place/(sizeof(long)/sizeof(Exponent_t));
2799  ord_struct.data.syz.limit=0;
2800  o[place/(sizeof(long)/sizeof(Exponent_t))]=-1;
2801  prev_ord=-1;
2802  place++;
2803  rO_Align(place);
2804}
2805
2806BOOLEAN rComplete(ring r, int force)
2807{
2808  if (r->VarOffset!=NULL && force == 0) return FALSE;
2809
2810  int n=rBlocks(r)-1;
2811  int i;
2812  int j=0;
2813  int prev_ordsgn=0;
2814  long *tmp_ordsgn=(long *)Alloc0(2*(n+r->N)*sizeof(long)); // wil be used for ordsgn
2815  int *v=(int *)Alloc((r->N+1)*sizeof(int)); // will be used for VarOffset
2816  for(i=r->N; i>=0 ; i--)
2817  {
2818    v[i]=-1;
2819  }
2820  sro_ord *tmp_typ=(sro_ord *)Alloc0(2*(n+r->N)*sizeof(sro_ord));
2821  int typ_i=0;
2822  r->pVarLowIndex=0;
2823
2824  // fill in v, tmp_typ, tmp_ordsgn, determine pVarLowIndex, typ_i (== ordSize)
2825  for(i=0;i<n;i++)
2826  {
2827    switch (r->order[i])
2828    {
2829      case ringorder_a:
2830        rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2831                   r->wvhdl[i]);
2832        r->pVarLowIndex=j;
2833        typ_i++;
2834        break;
2835
2836      case ringorder_c:
2837        rO_LexVars_neg(j, 0,0, prev_ordsgn,tmp_ordsgn,v);
2838        break;
2839
2840      case ringorder_C:
2841        rO_LexVars(j, 0,0, prev_ordsgn,tmp_ordsgn,v);
2842        break;
2843
2844      case ringorder_M:
2845        {
2846          int k,l;
2847          k=r->block1[i]-r->block0[i]+1; // number of vars
2848          for(l=0;l<k;l++)
2849          {
2850            rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2851                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
2852            typ_i++;
2853          }
2854          r->pVarLowIndex=j;
2855          break;
2856        }
2857
2858      case ringorder_lp:
2859        rO_LexVars(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2860        break;
2861
2862      case ringorder_ls:
2863        rO_LexVars_neg(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2864        break;
2865
2866      case ringorder_dp:
2867        if (r->block0[i]==r->block1[i])
2868        {
2869          rO_LexVars(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2870        }
2871        else
2872        {
2873          rO_TDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2874          r->pVarLowIndex=j;
2875          typ_i++;
2876          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1,
2877                         prev_ordsgn,tmp_ordsgn,v);
2878        }
2879        break;
2880
2881      case ringorder_Dp:
2882        if (r->block0[i]==r->block1[i])
2883        {
2884          rO_LexVars(j, r->block0[i],r->block1[i], prev_ordsgn,tmp_ordsgn,v);
2885        }
2886        else
2887        {
2888          rO_TDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2889          r->pVarLowIndex=j;
2890          typ_i++;
2891          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2892        }
2893        break;
2894
2895      case ringorder_ds:
2896        if (r->block0[i]==r->block1[i])
2897        {
2898          rO_LexVars_neg(j, r->block0[i],r->block1[i],prev_ordsgn,tmp_ordsgn,v);
2899        }
2900        else
2901        {
2902          rO_TDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2903          r->pVarLowIndex=j;
2904          typ_i++;
2905          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1,
2906                         prev_ordsgn,tmp_ordsgn,v);
2907        }
2908        break;
2909
2910      case ringorder_Ds:
2911        if (r->block0[i]==r->block1[i])
2912        {
2913          rO_LexVars_neg(j, r->block0[i],r->block1[i],prev_ordsgn,tmp_ordsgn,v);
2914        }
2915        else
2916        {
2917          rO_TDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i]);
2918          r->pVarLowIndex=j;
2919          typ_i++;
2920          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2921        }
2922        break;
2923
2924      case ringorder_wp:
2925        rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2926                   r->wvhdl[i]);
2927        r->pVarLowIndex=j;
2928        typ_i++;
2929        if (r->block1[i]!=r->block0[i])
2930          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1, prev_ordsgn,tmp_ordsgn,v);
2931        break;
2932
2933      case ringorder_Wp:
2934        rO_WDegree(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2935                  r->wvhdl[i]);
2936        r->pVarLowIndex=j;
2937        typ_i++;
2938        if (r->block1[i]!=r->block0[i])
2939          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2940        break;
2941
2942      case ringorder_ws:
2943        rO_WDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2944                       r->wvhdl[i]);
2945        r->pVarLowIndex=j;
2946        typ_i++;
2947        if (r->block1[i]!=r->block0[i])
2948          rO_LexVars_neg(j, r->block1[i],r->block0[i]+1, prev_ordsgn,tmp_ordsgn,v);
2949        break;
2950
2951      case ringorder_Ws:
2952        rO_WDegree_neg(j,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2953                       r->wvhdl[i]);
2954        r->pVarLowIndex=j;
2955        typ_i++;
2956        if (r->block1[i]!=r->block0[i])
2957          rO_LexVars(j, r->block0[i],r->block1[i]-1, prev_ordsgn,tmp_ordsgn,v);
2958        break;
2959
2960      case ringorder_S:
2961        rO_Syzcomp(j, prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2962        r->pVarLowIndex=j;
2963        typ_i++;
2964        break;
2965
2966      case ringorder_s:
2967        rO_Syz(j, prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2968        r->pVarLowIndex=j;
2969        typ_i++;
2970        break;
2971
2972      case ringorder_unspec:
2973      case ringorder_no:
2974        default:
2975          Print("undef. ringorder used\n");
2976          break;
2977    }
2978  }
2979
2980  int j0=j-1;
2981  rO_Align(j);
2982  r->pCompHighIndex=(j-1)/(sizeof(long)/sizeof(Exponent_t));
2983  j=j0+1;
2984
2985  // fill in some empty slots with variables not already covered
2986  // v0 is special, is therefore normally already covered
2987  // but if not:
2988  for(i=0 ; i<r->N+1 ; i++)
2989  {
2990    if(v[i]==(-1))
2991    {
2992      if (prev_ordsgn==1)
2993      {
2994        rO_LexVars(j, i,i, prev_ordsgn,tmp_ordsgn,v);
2995      }
2996      else
2997      {
2998        rO_LexVars_neg(j, i,i, prev_ordsgn,tmp_ordsgn,v);
2999      }
3000    }
3001  }
3002
3003#ifdef LONG_MONOMS
3004  // find out where we need duplicate variables (for divisibility tests)
3005  for(i=1 ; i<r->N+1 ; i++)
3006  {
3007    if(v[i]<r->pVarLowIndex)
3008    {
3009      int start=i;
3010      while((i<r->N) && (v[i+1]<r->pVarLowIndex)) i++;
3011      tmp_typ[typ_i].ord_typ=ro_cp;
3012      tmp_typ[typ_i].data.cp.place=j;
3013      tmp_typ[typ_i].data.cp.start=start;
3014      tmp_typ[typ_i].data.cp.end=i;
3015      rO_DupVars(j, start,i);
3016      typ_i++;
3017    }
3018  }
3019#endif
3020
3021  r->pVarHighIndex=j-1;
3022  rO_Align(j);
3023  // ----------------------------
3024  // finished with constructing the monomial, computing sizes:
3025
3026  r->ExpESize=j;
3027  r->ExpLSize=j/(sizeof(long)/sizeof(Exponent_t));
3028  r->mm_specHeap = mmGetSpecHeap(POLYSIZE + (r->ExpLSize)*sizeof(long));
3029  assume(r->mm_specHeap != NULL);
3030
3031  // ----------------------------
3032  // indices and ordsgn vector for comparison
3033  //
3034#ifndef WORDS_BIGENDIAN
3035  r->pCompLowIndex = r->ExpLSize - 1 - r->pCompHighIndex;
3036  r->pCompHighIndex = r->ExpLSize - 1;
3037#else
3038  r->pCompLowIndex=0;
3039  // r->pCompHighIndex already set
3040#endif
3041  r->pCompLSize = r->pCompHighIndex - r->pCompLowIndex + 1;
3042  r->ordsgn=(long *)Alloc0(r->pCompLSize*sizeof(long));
3043
3044#ifndef WORDS_BIGENDIAN
3045  for(j=r->pCompLowIndex;j<=r->pCompHighIndex;j++)
3046  {
3047    r->ordsgn[r->pCompLSize - (j - r->pCompLowIndex) - 1]
3048      = tmp_ordsgn[j-r->pCompLowIndex];
3049  }
3050#else
3051  for(j=r->pCompLowIndex;j<=r->pCompHighIndex;j++)
3052  {
3053    r->ordsgn[j]
3054      = tmp_ordsgn[j-r->pCompLowIndex];
3055  }
3056#endif
3057
3058  Free((ADDRESS)tmp_ordsgn,(2*(n+r->N)*sizeof(long)));
3059
3060  // ----------------------------
3061  // description of orderings for setm:
3062  //
3063  r->OrdSize=typ_i;
3064  if (typ_i==0) r->typ=NULL;
3065  else
3066  {
3067    r->typ=(sro_ord*)Alloc(typ_i*sizeof(sro_ord));
3068    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3069  }
3070  Free((ADDRESS)tmp_typ,(2*(n+r->N)*sizeof(sro_ord)));
3071
3072#ifndef WORDS_BIGENDIAN
3073  // LITTLE_ENDIAN: revert some stuff in r->typ
3074  for(j=r->OrdSize-1;j>=0;j--)
3075  {
3076    if(r->typ[j].ord_typ==ro_cp)
3077    {
3078      int end_place=r->typ[j].data.cp.place
3079                     +r->typ[j].data.cp.end-r->typ[j].data.cp.start;
3080      r->typ[j].data.cp.place=r->ExpESize-end_place-1;
3081    }
3082    //else if(r->typ[j].ord_typ==ro_syzcomp)
3083    //{
3084    //  int place=r->typ[j].data.syzcomp.place;
3085    //  r->typ[j].data.syzcomp.place=r->ExpLSize-place-1;
3086    //}
3087    else
3088    {
3089      int new_index=r->ExpLSize-r->typ[j].data.dp.place-1;
3090      r->typ[j].data.dp.place=new_index;
3091    }
3092  }
3093#endif
3094
3095  // ----------------------------
3096  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3097#ifdef WORDS_BIGENDIAN
3098  // BIGENDIAN:
3099  r->VarOffset=v;
3100#else
3101  // LITTLE-Endian: revert
3102  r->VarOffset=(int *)Alloc((r->N+1)*sizeof(int));
3103  for(j=r->N;j>=0;j--)
3104  {
3105    r->VarOffset[j]=r->ExpESize-v[j]-1;
3106  }
3107  Free((ADDRESS)v,(r->N+1)*sizeof(int));
3108  j=r->pVarLowIndex;
3109  r->pVarLowIndex=r->ExpESize-r->pVarHighIndex-1;
3110  r->pVarHighIndex=r->ExpESize-j-1;
3111#endif
3112
3113  // ----------------------------
3114  // other indicies
3115#ifdef LONG_MONOMS
3116  r->pDivLow=r->pVarLowIndex/(sizeof(long)/sizeof(Exponent_t));
3117  r->pDivHigh=r->pVarHighIndex/(sizeof(long)/sizeof(Exponent_t));
3118#endif
3119  r->pCompIndex=r->VarOffset[0];
3120#ifdef WORDS_BIGENDIAN
3121  if (r->order[0] == ringorder_s)
3122  {
3123    /* l[0] is occupied by ringorder_s,
3124    *  does l[1] contain the component-number ? */
3125    if (r->pCompIndex < 2*sizeof(long)/sizeof(Exponent_t)) /* e-index of l[2] */
3126      r->pOrdIndex = 2;
3127    else
3128      r->pOrdIndex = 1;
3129  }
3130  else if (r->pCompIndex  < sizeof(long)/sizeof(Exponent_t))
3131    r->pOrdIndex=1;
3132  else
3133    r->pOrdIndex=0;
3134#else
3135  if (r->order[0] == ringorder_s)
3136  {
3137    if (r->pCompIndex == r->ExpESize-3)
3138      r->pOrdIndex = r->ExpLSize-3;
3139    else
3140      r->pOrdIndex = r->ExpLSize-2;
3141  }
3142  else if (r->pCompIndex == r->ExpESize-1)
3143    r->pOrdIndex=r->ExpLSize-2;
3144  else
3145    r->pOrdIndex=r->ExpLSize-1;
3146#endif
3147  return FALSE;
3148}
3149#endif
3150
3151void rUnComplete(ring r)
3152{
3153  if (r == NULL) return;
3154  if (r->VarOffset != NULL)
3155  {
3156    if (r->mm_specHeap != NULL)
3157      mmUnGetSpecHeap(&(r->mm_specHeap));
3158
3159    Free((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3160    if (r->order != NULL)
3161    {
3162      if (r->order[0] == ringorder_s && r->typ[0].data.syz.limit > 0)
3163      {
3164        Free(r->typ[0].data.syz.syz_index,
3165             (r->typ[0].data.syz.limit +1)*sizeof(int));
3166      }
3167    }
3168    if (r->OrdSize!=0 && r->typ != NULL)
3169    {
3170      Free((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord));
3171    }
3172    if (r->ordsgn != NULL && r->pCompLSize != 0)
3173      Free((ADDRESS)r->ordsgn,r->pCompLSize*sizeof(long));
3174  }
3175}
3176
3177void rDebugPrint(ring r)
3178{
3179  if (r==NULL)
3180  {
3181    PrintS("NULL ?\n");
3182    return;
3183  }
3184  char *TYP[]={"ro_dp","ro_wp","ro_cp","ro_syzcomp", "ro_syz", "ro_none"};
3185  int i,j;
3186  PrintS("varoffset:\n");
3187  #ifdef HAVE_SHIFTED_EXPONENTS
3188  for(j=0;j<=r->N;j++) Print("  v%d at e-pos %d, bit %d\n",
3189     j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
3190  Print("bitmask=0x%x\n",r->bitmask);
3191  #else
3192  for(j=0;j<=r->N;j++)
3193    Print("  v%d at e-pos %d\n",j,r->VarOffset[j]);
3194  #endif
3195  PrintS("ordsgn:\n");
3196  for(j=0;j<r->pCompLSize;j++)
3197    Print("  ordsgn %d at pos %d\n",r->ordsgn[j],j+r->pCompLowIndex);
3198  Print("OrdSgn:%d\n",r->OrdSgn);
3199  PrintS("ordrec:\n");
3200  for(j=0;j<r->OrdSize;j++)
3201  {
3202    Print("  typ %s",TYP[r->typ[j].ord_typ]);
3203    Print("  place %d",r->typ[j].data.dp.place);
3204    if (r->typ[j].ord_typ!=ro_syzcomp)
3205    {
3206      Print("  start %d",r->typ[j].data.dp.start);
3207      Print("  end %d",r->typ[j].data.dp.end);
3208      if (r->typ[j].ord_typ==ro_wp)
3209      {
3210        Print(" w:");
3211        int l;
3212        for(l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
3213          Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
3214      }
3215    }
3216    PrintLn();
3217  }
3218  Print("pVarLowIndex:%d ",r->pVarLowIndex);
3219  Print("pVarHighIndex:%d\n",r->pVarHighIndex);
3220#ifdef LONG_MONOMS
3221  Print("pDivLow:%d ",r->pDivLow);
3222  Print("pDivHigh:%d\n",r->pDivHigh);
3223#endif
3224  Print("pCompLowIndex:%d ",r->pCompLowIndex);
3225  Print("pCompHighIndex:%d\n",r->pCompHighIndex);
3226  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
3227  Print("ExpESize:%d ",r->ExpESize);
3228  Print("ExpLSize:%d ",r->ExpLSize);
3229  Print("OrdSize:%d\n",r->OrdSize);
3230  PrintS("--------------------\n");
3231  for(j=0;j<r->ExpLSize;j++)
3232  {
3233    Print("L[%d]: ",j);
3234    if ((j>=r->pCompLowIndex) && (j<=r->pCompHighIndex))
3235      Print("ordsgn %d ", r->ordsgn[j-r->pCompLowIndex]);
3236    else
3237      PrintS("no comp ");
3238    #ifdef HAVE_SHIFTED_EXPONENTS
3239    i=1;
3240    #else
3241    i=0;
3242    #endif
3243    for(;i<=r->N;i++)
3244    {
3245      #ifdef HAVE_SHIFTED_EXPONENTS
3246      if( (r->VarOffset[i] & 0xffffff) == j )
3247      {  Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
3248                                         r->VarOffset[i] >>24 ); }
3249      #else
3250      if( r->VarOffset[i]*sizeof(Exponent_t)/sizeof(long) == j )
3251      {  Print("v%d at e[%d]; ", i, r->VarOffset[i]); }
3252      #endif
3253    }
3254    #ifdef HAVE_SHIFTED_EXPONENTS
3255    if( r->pCompIndex==j ) PrintS("v0; ");
3256    #endif
3257    for(i=0;i<r->OrdSize;i++)
3258    {
3259      if (r->typ[i].data.dp.place == j)
3260      {
3261        Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
3262          r->typ[i].data.dp.start, r->typ[i].data.dp.end);
3263      }
3264    }
3265
3266    if (j==r->pOrdIndex)
3267      PrintS("pOrdIndex\n");
3268    else
3269      PrintLn();
3270  }
3271}
3272
3273void pDebugPrint(poly p)
3274{
3275  int i,j;
3276  pWrite(p);
3277  j=10;
3278  while(p!=NULL)
3279  {
3280    Print("exp.e[0..%d]\n",currRing->ExpESize-1);
3281    for(i=0;i<currRing->ExpESize;i++)
3282      Print("%d ",p->exp.e[i]);
3283    Print("\nexp.l[0..%d]\n",currRing->ExpLSize-1);
3284    for(i=0;i<currRing->ExpLSize;i++)
3285      Print("%d ",p->exp.l[i]);
3286    PrintLn();
3287    Print("v0:%d ",pGetComp(p));
3288    for(i=1;i<=pVariables;i++) Print(" v%d:%d",i,pGetExp(p,i));
3289    PrintLn();
3290    pIter(p);
3291    j--;
3292    if (j==0) { PrintS("...\n"); break; }
3293  }
3294}
3295
3296
3297/*2
3298* asssume that rComplete was called with r
3299* assume that the first block ist ringorder_S
3300* change the block to reflect the sequence given by appending v
3301*/
3302
3303#ifdef PDEBUG
3304void rDBChangeSComps(int* currComponents,
3305                     long* currShiftedComponents,
3306                     int length,
3307                     ring r)
3308{
3309  r->typ[1].data.syzcomp.length = length;
3310  rNChangeSComps( currComponents, currShiftedComponents, r);
3311}
3312void rDBGetSComps(int** currComponents,
3313                 long** currShiftedComponents,
3314                 int *length,
3315                 ring r)
3316{
3317  *length = r->typ[1].data.syzcomp.length;
3318  rNGetSComps( currComponents, currShiftedComponents, r);
3319}
3320#endif
3321
3322void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
3323{
3324  assume(r->order[1]==ringorder_S);
3325
3326  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
3327  r->typ[1].data.syzcomp.Components = currComponents;
3328}
3329
3330void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
3331{
3332  assume(r->order[1]==ringorder_S);
3333
3334  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
3335  *currComponents =   r->typ[1].data.syzcomp.Components;
3336}
3337
3338/////////////////////////////////////////////////////////////////////////////
3339//
3340// The following routines all take as input a ring r, and return R
3341// where R has a certain property. P might be equal r in which case r
3342// had already this property
3343//
3344// Without argument, these functions work on currRing and change it,
3345// if necessary
3346
3347// for the time being, this is still here
3348static ring rAssure_SyzComp(ring r, BOOLEAN complete = TRUE);
3349ring rCurrRingAssure_SyzComp()
3350{
3351  ring r = rAssure_SyzComp(currRing);
3352  if (r != currRing)
3353  {
3354    ring old_ring = currRing;
3355    rChangeCurrRing(r, TRUE);
3356    if (old_ring->qideal != NULL)
3357    {
3358      r->qideal = idrCopyR_NoSort(old_ring->qideal, old_ring);
3359      assume(idRankFreeModule(r->qideal) == 0);
3360      currQuotient = r->qideal;
3361    }
3362  }
3363  return r;
3364}
3365
3366static ring rAssure_SyzComp(ring r, BOOLEAN complete = TRUE)
3367{
3368  if (r->order[0] == ringorder_s) return r;
3369  ring res=rCopy0(r, FALSE, FALSE);
3370  int i=rBlocks(r);
3371  int j;
3372
3373  res->order=(int *)Alloc0((i+1)*sizeof(int));
3374  for(j=i;j>0;j--) res->order[j]=r->order[j-1];
3375  res->order[0]=ringorder_s;
3376
3377  res->block0=(int *)Alloc0((i+1)*sizeof(int));
3378  for(j=i;j>0;j--) res->block0[j]=r->block0[j-1];
3379
3380  res->block1=(int *)Alloc0((i+1)*sizeof(int));
3381  for(j=i;j>0;j--) res->block1[j]=r->block1[j-1];
3382
3383  int ** wvhdl =(int **)Alloc0((i+1)*sizeof(int**));
3384  for(j=i;j>0;j--)
3385  {
3386    if (r->wvhdl[j-1] != NULL)
3387    {
3388      wvhdl[j] = (int*) AllocL(mmSizeL((ADDRESS)r->wvhdl[j-1]));
3389      memcpy(wvhdl[j], r->wvhdl[j-1],mmSizeL((ADDRESS)r->wvhdl[j-1]));
3390    }
3391  }
3392  res->wvhdl = wvhdl;
3393
3394  if (complete) rComplete(res, 1);
3395  return res;
3396}
3397
3398static ring rAssure_CompLastBlock(ring r, BOOLEAN complete = TRUE)
3399{
3400  int last_block = rBlocks(r) - 2;
3401  if (r->order[last_block] != ringorder_c &&
3402      r->order[last_block] != ringorder_C)
3403  {
3404    int c_pos = 0;
3405    int i;
3406
3407    for (i=0; i< last_block; i++)
3408    {
3409      if (r->order[i] == ringorder_c || r->order[i] == ringorder_C)
3410      {
3411        c_pos = i;
3412        break;
3413      }
3414    }
3415    if (c_pos != -1)
3416    {
3417      ring new_r = rCopy0(r, FALSE, TRUE);
3418      for (i=c_pos+1; i<=last_block; i++)
3419      {
3420        new_r->order[i-1] = new_r->order[i];
3421        new_r->block0[i-1] = new_r->block0[i];
3422        new_r->block1[i-1] = new_r->block1[i];
3423        new_r->wvhdl[i-1] = new_r->wvhdl[i];
3424      }
3425      new_r->order[last_block] = r->order[c_pos];
3426      new_r->block0[last_block] = r->block0[c_pos];
3427      new_r->block1[last_block] = r->block1[c_pos];
3428      new_r->wvhdl[last_block] = r->wvhdl[c_pos];
3429      if (complete) rComplete(new_r, 1);
3430      return new_r;
3431    }
3432  }
3433  return r;
3434}
3435
3436ring rCurrRingAssure_CompLastBlock()
3437{
3438  ring new_r = rAssure_CompLastBlock(currRing);
3439  if (currRing != new_r)
3440  {
3441    ring old_r = currRing;
3442    rChangeCurrRing(new_r, TRUE);
3443    if (old_r->qideal != NULL)
3444    {
3445      new_r->qideal = idrCopyR(old_r->qideal, old_r);
3446      currQuotient = new_r->qideal;
3447    }
3448  }
3449  return new_r;
3450}
3451
3452ring rCurrRingAssure_SyzComp_CompLastBlock()
3453{
3454  ring new_r_1 = rAssure_CompLastBlock(currRing, FALSE);
3455  ring new_r = rAssure_SyzComp(new_r_1, FALSE);
3456
3457  if (new_r != currRing)
3458  {
3459    ring old_r = currRing;
3460    if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
3461    rComplete(new_r, 1);
3462    rChangeCurrRing(new_r, TRUE);
3463    if (old_r->qideal != NULL)
3464    {
3465      new_r->qideal = idrCopyR(old_r->qideal, old_r);
3466      currQuotient = new_r->qideal;
3467    }
3468    rTest(new_r);
3469    rTest(old_r);
3470  }
3471  return new_r;
3472}
3473
3474// use this for global orderings consisting of two blocks
3475static ring rCurrRingAssure_Global(rRingOrder_t b1, rRingOrder_t b2)
3476{
3477  int r_blocks = rBlocks(currRing);
3478  int i;
3479
3480  assume(b1 == ringorder_c || b1 == ringorder_C ||
3481         b2 == ringorder_c || b2 == ringorder_C ||
3482         b2 == ringorder_S);
3483  if ((r_blocks == 3) &&
3484      (currRing->order[0] == b1) &&
3485      (currRing->order[1] == b2) &&
3486      (currRing->order[2] == 0))
3487    return currRing;
3488  ring res = rCopy0(currRing, TRUE, FALSE);
3489  res->order = (int*)Alloc0(3*sizeof(int));
3490  res->block0 = (int*)Alloc0(3*sizeof(int));
3491  res->block1 = (int*)Alloc0(3*sizeof(int));
3492  res->wvhdl = (int**)Alloc0(3*sizeof(int*));
3493  res->order[0] = b1;
3494  res->order[1] = b2;
3495  if (b1 == ringorder_c || b1 == ringorder_C)
3496  {
3497    res->block0[1] = 1;
3498    res->block1[1] = currRing->N;
3499  }
3500  else
3501  {
3502    res->block0[0] = 1;
3503    res->block1[0] = currRing->N;
3504  }
3505  // HANNES: This sould be set in rComplete
3506  res->OrdSgn = 1;
3507  rComplete(res, 1);
3508  rChangeCurrRing(res, TRUE);
3509  return res;
3510}
3511
3512
3513ring rCurrRingAssure_dp_S()
3514{
3515  return rCurrRingAssure_Global(ringorder_dp, ringorder_S);
3516}
3517
3518ring rCurrRingAssure_dp_C()
3519{
3520  return rCurrRingAssure_Global(ringorder_dp, ringorder_C);
3521}
3522
3523ring rCurrRingAssure_C_dp()
3524{
3525  return rCurrRingAssure_Global(ringorder_C, ringorder_dp);
3526}
3527
3528
3529void rSetSyzComp(int k)
3530{
3531  if (TEST_OPT_PROT) Print("{%d}", k);
3532  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz))
3533  {
3534    assume(k > currRing->typ[0].data.syz.limit);
3535    int i;
3536    if (currRing->typ[0].data.syz.limit == 0)
3537    {
3538      currRing->typ[0].data.syz.syz_index = (int*) Alloc0((k+1)*sizeof(int));
3539      currRing->typ[0].data.syz.syz_index[0] = 0;
3540      currRing->typ[0].data.syz.curr_index = 1;
3541    }
3542    else
3543    {
3544      currRing->typ[0].data.syz.syz_index = (int*)
3545        ReAlloc(currRing->typ[0].data.syz.syz_index,
3546                (currRing->typ[0].data.syz.limit+1)*sizeof(int),
3547                (k+1)*sizeof(int));
3548    }
3549    for (i=currRing->typ[0].data.syz.limit + 1; i<= k; i++)
3550    {
3551      currRing->typ[0].data.syz.syz_index[i] =
3552        currRing->typ[0].data.syz.curr_index;
3553    }
3554    currRing->typ[0].data.syz.limit = k;
3555    currRing->typ[0].data.syz.curr_index++;
3556  }
3557  else if ((currRing->order[0]!=ringorder_c) && (k!=0))
3558  {
3559    WarnS("syzcomp in incompatible ring");
3560  }
3561#ifdef PDEBUG
3562#ifdef HAVE_SHIFTED_EXPONENTS
3563  extern int pDBsyzComp;
3564  pDBsyzComp=k; 
3565#endif
3566#endif
3567}
3568
3569// return the max-comonent wchich has syzIndex i
3570int rGetMaxSyzComp(int i)
3571{
3572  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz) &&
3573      currRing->typ[0].data.syz.limit > 0 && i > 0)
3574  {
3575    assume(i <= currRing->typ[0].data.syz.limit);
3576    int j;
3577    for (j=0; j<currRing->typ[0].data.syz.limit; j++)
3578    {
3579      if (currRing->typ[0].data.syz.syz_index[j] == i  &&
3580          currRing->typ[0].data.syz.syz_index[j+1] != i)
3581      {
3582        assume(currRing->typ[0].data.syz.syz_index[j+1] == i+1);
3583        return j;
3584      }
3585    }
3586    return currRing->typ[0].data.syz.limit;
3587  }
3588  else
3589  {
3590    return 0;
3591  }
3592}
3593
3594BOOLEAN rRing_is_Homog(ring r)
3595{
3596  if (r == NULL) return FALSE;
3597  int i, j, nb = rBlocks(r);
3598  for (i=0; i<nb; i++)
3599  {
3600    if (r->wvhdl[i] != NULL)
3601    {
3602      int length = r->block1[i] - r->block0[i];
3603      int* wvhdl = r->wvhdl[i];
3604      if (r->order[i] == ringorder_M) length *= length;
3605      assume(mmSizeL(wvhdl) >= length*sizeof(int));
3606
3607      for (j=0; j< length; j++)
3608      {
3609        if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
3610      }
3611    }
3612  }
3613  return TRUE;
3614}
3615
3616BOOLEAN rRing_has_CompLastBlock(ring r)
3617{
3618  assume(r != NULL);
3619  int lb = rBlocks(r) - 2;
3620  return (r->order[lb] == ringorder_c || r->order[lb] == ringorder_C);
3621}
3622
Note: See TracBrowser for help on using the repository browser.