source: git/Singular/ring.cc @ 48aa42

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