source: git/Singular/ring.cc @ 38545c5

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