source: git/Singular/ring.cc @ 5cfef2

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