source: git/Singular/ring.cc @ 0e84aa

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