source: git/Singular/ring.cc @ 907843

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