source: git/Singular/ring.cc @ 74aa78

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