source: git/Singular/ring.cc @ 64eef3

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