source: git/Singular/ring.cc @ 9d06971

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