source: git/Singular/ring.cc @ 87bef42

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