source: git/libpolys/polys/monomials/ring.cc @ afa93a

spielwiese
Last change on this file since afa93a was afa93a, checked in by Oleksandr Motsak <motsak@…>, 13 years ago
FIX: p_?GetCoeff must test the input
  • Property mode set to 100644
File size: 133.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT - the interpreter related ring operations
8*/
9
10/* includes */
11#include <math.h>
12
13// #include <polys/options.h>
14#include <omalloc/omalloc.h>
15#include <misc/options.h>
16#include <polys/monomials/ring.h>
17#include <polys/monomials/p_polys.h>
18#include <polys/simpleideals.h>
19#include <coeffs/numbers.h>
20// #include <???/febase.h>
21// #include <???/intvec.h>
22#include <polys/ext_fields/longalg.h>
23#include <polys/ext_fields/longtrans.h>
24#include <coeffs/ffields.h>
25#include <polys/monomials/ring.h>
26#include <polys/monomials/maps.h>
27#include <polys/prCopy.h>
28// #include "../Singular/ipshell.h"
29#include <polys/templates/p_Procs.h>
30
31#include <polys/matpol.h>
32
33#ifdef HAVE_PLURAL
34#include <polys/nc/nc.h>
35#include <polys/nc/sca.h>
36#endif
37// #include <???/maps.h>
38// #include <???/matpol.h>
39#ifdef HAVE_FACTORY
40#define SI_DONT_HAVE_GLOBAL_VARS
41#  include <factory/factory.h>
42#endif
43
44#define BITS_PER_LONG 8*SIZEOF_LONG
45
46omBin sip_sring_bin = omGetSpecBin(sizeof(ip_sring));
47
48static const char * const ringorder_name[] =
49{
50  " ?", ///< ringorder_no = 0,
51  "a", ///< ringorder_a,
52  "A", ///< ringorder_a64,
53  "c", ///< ringorder_c,
54  "C", ///< ringorder_C,
55  "M", ///< ringorder_M,
56  "S", ///< ringorder_S,
57  "s", ///< ringorder_s,
58  "lp", ///< ringorder_lp,
59  "dp", ///< ringorder_dp,
60  "rp", ///< ringorder_rp,
61  "Dp", ///< ringorder_Dp,
62  "wp", ///< ringorder_wp,
63  "Wp", ///< ringorder_Wp,
64  "ls", ///< ringorder_ls,
65  "ds", ///< ringorder_ds,
66  "Ds", ///< ringorder_Ds,
67  "ws", ///< ringorder_ws,
68  "Ws", ///< ringorder_Ws,
69  "L", ///< ringorder_L,
70  "aa", ///< ringorder_aa
71  "rs", ///< ringorder_rs,
72  "IS", ///<  ringorder_IS
73  " _" ///< ringorder_unspec
74};
75
76#define  rInternalChar(r) ((r)->cf->ch)
77
78const char * rSimpleOrdStr(int ord)
79{
80  return ringorder_name[ord];
81}
82
83/// unconditionally deletes fields in r
84void rDelete(ring r);
85/// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
86static void rSetVarL(ring r);
87/// get r->divmask depending on bits per exponent
88static unsigned long rGetDivMask(int bits);
89/// right-adjust r->VarOffset
90static void rRightAdjustVarOffset(ring r);
91static void rOptimizeLDeg(ring r);
92
93/*0 implementation*/
94//BOOLEAN rField_is_R(ring r)
95//{
96//  if (r->cf->ch== -1)
97//  {
98//    if (r->float_len==(short)0) return TRUE;
99//  }
100//  return FALSE;
101//}
102
103/*
104
105/// internally changes the gloabl ring and resets the relevant
106/// global variables:
107/// SHOULD BE DEPRECATED NOW...?
108void rChangeCurrRing(ring r)
109{
110 // if ((currRing!=NULL) && (currRing->cf->minpoly!=NULL))
111 // {
112 //   omCheckAddr(currRing->cf->minpoly);
113 // }
114  //------------ set global ring vars --------------------------------
115  //currRing = r;
116  //currQuotient=NULL;
117  if (r != NULL)
118  {
119    rTest(r);
120    //------------ set global ring vars --------------------------------
121    //currQuotient=r->qideal;
122
123    //------------ global variables related to coefficients ------------
124    nSetChar(r->cf);
125
126    //------------ global variables related to polys -------------------
127    p_SetGlobals(r);
128    //------------ global variables related to factory -----------------
129#ifdef HAVE_FACTORY
130    //int c=ABS(nGetChar());
131    //if (c==1) c=0;
132    //setCharacteristic( c );
133#endif
134  }
135}
136*/
137
138ring rDefault(coeffs cf, int N, char **n,int ord_size, int *ord, int *block0, int *block1)
139{
140  assume( cf != NULL);
141  ring r=(ring) omAlloc0Bin(sip_sring_bin);
142  r->N     = N;
143  r->cf = cf;
144  /*rPar(r)  = 0; Alloc0 */
145  /*names*/
146  r->names = (char **) omAlloc0(N * sizeof(char *));
147  int i;
148  for(i=0;i<N;i++)
149  {
150    r->names[i]  = omStrDup(n[i]);
151  }
152  /*weights: entries for 2 blocks: NULL*/
153  r->wvhdl = (int **)omAlloc0((ord_size+1) * sizeof(int *));
154  r->order = ord;
155  r->block0 = block0;
156  r->block1 = block1;
157  /*polynomial ring*/
158  r->OrdSgn    = 1;
159
160  /* complete ring intializations */
161  rComplete(r);
162  return r;
163}
164ring rDefault(int ch, int N, char **n,int ord_size, int *ord, int *block0, int *block1)
165{
166  coeffs cf;
167  if (ch==0) cf=nInitChar(n_Q,NULL);
168  else       cf=nInitChar(n_Zp,(void*)(long)ch);
169  assume( cf != NULL);
170  return rDefault(cf,N,n,ord_size,ord,block0,block1);
171}
172ring   rDefault(coeffs cf, int N, char **n)
173{
174  assume( cf != NULL);
175  /*order: lp,0*/
176  int *order = (int *) omAlloc(2* sizeof(int));
177  int *block0 = (int *)omAlloc0(2 * sizeof(int));
178  int *block1 = (int *)omAlloc0(2 * sizeof(int));
179  /* ringorder dp for the first block: var 1..N */
180  order[0]  = ringorder_lp;
181  block0[0] = 1;
182  block1[0] = N;
183  /* the last block: everything is 0 */
184  order[1]  = 0;
185
186  return rDefault(cf,N,n,2,order,block0,block1);
187}
188
189ring rDefault(int ch, int N, char **n)
190{
191  coeffs cf;
192  if (ch==0) cf=nInitChar(n_Q,NULL);
193  else       cf=nInitChar(n_Zp,(void*)(long)ch);
194  assume( cf != NULL);
195  return rDefault(cf,N,n);
196}
197
198///////////////////////////////////////////////////////////////////////////
199//
200// rInit: define a new ring from sleftv's
201//
202//-> ipshell.cc
203
204/////////////////////////////
205// Auxillary functions
206//
207
208// check intvec, describing the ordering
209BOOLEAN rCheckIV(intvec *iv)
210{
211  if ((iv->length()!=2)&&(iv->length()!=3))
212  {
213    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
214    return TRUE;
215  }
216  return FALSE;
217}
218
219int rTypeOfMatrixOrder(intvec * order)
220{
221  int i=0,j,typ=1;
222  int sz = (int)sqrt((double)(order->length()-2));
223  if ((sz*sz)!=(order->length()-2))
224  {
225    WerrorS("Matrix order is not a square matrix");
226    typ=0;
227  }
228  while ((i<sz) && (typ==1))
229  {
230    j=0;
231    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
232    if (j>=sz)
233    {
234      typ = 0;
235      WerrorS("Matrix order not complete");
236    }
237    else if ((*order)[j*sz+i+2]<0)
238      typ = -1;
239    else
240      i++;
241  }
242  return typ;
243}
244
245/*2
246 * set a new ring from the data:
247 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
248 */
249
250int r_IsRingVar(const char *n, ring r)
251{
252  if ((r!=NULL) && (r->names!=NULL))
253  {
254    for (int i=0; i<r->N; i++)
255    {
256      if (r->names[i]==NULL) return -1;
257      if (strcmp(n,r->names[i]) == 0) return (int)i;
258    }
259  }
260  return -1;
261}
262
263
264void rWrite(ring r)
265{
266  if ((r==NULL)||(r->order==NULL))
267    return; /*to avoid printing after errors....*/
268
269  int nblocks=rBlocks(r);
270
271  // omCheckAddrSize(r,sizeof(ip_sring));
272  omCheckAddrSize(r->order,nblocks*sizeof(int));
273  omCheckAddrSize(r->block0,nblocks*sizeof(int));
274  omCheckAddrSize(r->block1,nblocks*sizeof(int));
275  omCheckAddrSize(r->wvhdl,nblocks*sizeof(int *));
276  omCheckAddrSize(r->names,r->N*sizeof(char *));
277
278  nblocks--;
279
280  n_CoeffWrite(r->cf);
281#if 0
282  {
283    PrintS("//   characteristic : ");
284    if (r->cf->parameter!=NULL)
285    {
286      Print ("//   %d parameter    : ",rPar(r));
287      char **sp=r->cf->parameter;
288      int nop=0;
289      while (nop<rPar(r))
290      {
291        PrintS(*sp);
292        PrintS(" ");
293        sp++; nop++;
294      }
295      PrintS("\n//   minpoly        : ");
296      if ( rField_is_long_C(r) )
297      {
298        // i^2+1:
299        Print("(%s^2+1)\n",r->cf->parameter[0]);
300      }
301      else if (r->cf->minpoly==NULL)
302      {
303        PrintS("0\n");
304      }
305      else
306      {
307        StringSetS(""); n_Write(r->cf->minpoly,r->cf); PrintS(StringAppendS("\n"));
308      }
309      //if (r->minideal!=NULL)
310      //{
311      //  iiWriteMatrix((matrix)r->minideal,"//   minpolys",1,0);
312      //  PrintLn();
313      //}
314    }
315  }
316#endif
317  Print("//   number of vars : %d",r->N);
318
319  //for (nblocks=0; r->order[nblocks]; nblocks++);
320  nblocks=rBlocks(r)-1;
321
322  for (int l=0, nlen=0 ; l<nblocks; l++)
323  {
324    int i;
325    Print("\n//        block %3d : ",l+1);
326
327    Print("ordering %s", rSimpleOrdStr(r->order[l]));
328
329
330    if (r->order[l] == ringorder_s)
331    {
332      assume( l == 0 );
333#ifndef NDEBUG
334      Print("  syzcomp at %d",r->typ[l].data.syz.limit);
335#endif
336      continue;
337    }
338    else if (r->order[l] == ringorder_IS)
339    {
340      assume( r->block0[l] == r->block1[l] );
341      const int s = r->block0[l];
342      assume( (-2 < s) && (s < 2) );
343      Print("(%d)", s); // 0 => prefix! +/-1 => suffix!
344      continue;
345    }
346    else if (
347    (  (r->order[l] >= ringorder_lp)
348    ||(r->order[l] == ringorder_M)
349    ||(r->order[l] == ringorder_a)
350    ||(r->order[l] == ringorder_a64)
351    ||(r->order[l] == ringorder_aa) ) && (r->order[l] < ringorder_IS) )
352    {
353      PrintS("\n//                  : names   ");
354      for (i = r->block0[l]-1; i<r->block1[l]; i++)
355      {
356        nlen = strlen(r->names[i]);
357        Print(" %s",r->names[i]);
358      }
359    }
360
361    if (r->wvhdl[l]!=NULL)
362    {
363      for (int j= 0;
364           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
365           j+=i)
366      {
367        PrintS("\n//                  : weights ");
368        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
369        {
370          if (r->order[l] == ringorder_a64)
371          {
372            int64 *w=(int64 *)r->wvhdl[l];
373            #if SIZEOF_LONG == 4
374            Print("%*lld " ,nlen,w[i+j]);
375            #else
376            Print(" %*ld"  ,nlen,w[i+j]);
377            #endif
378          }
379          else
380            Print(" %*d" ,nlen,r->wvhdl[l][i+j]);
381        }
382        if (r->order[l]!=ringorder_M) break;
383      }
384    }
385  }
386#ifdef HAVE_PLURAL
387  if(rIsPluralRing(r))
388  {
389    PrintS("\n//   noncommutative relations:");
390    poly pl=NULL;
391    int nl;
392    int i,j;
393    for (i = 1; i<r->N; i++)
394    {
395      for (j = i+1; j<=r->N; j++)
396      {
397        nl = n_IsOne(p_GetCoeff(MATELEM(r->GetNC()->C,i,j),r), r->cf);
398        if ( (MATELEM(r->GetNC()->D,i,j)!=NULL) || (!nl) )
399        {
400          Print("\n//    %s%s=",r->names[j-1],r->names[i-1]);
401          pl = MATELEM(r->GetNC()->MT[UPMATELEM(i,j,r->N)],1,1);
402          p_Write0(pl, r, r);
403        }
404      }
405    }
406#if 0  /*Singularg should not differ from Singular except in error case*/
407    Print("\n//   noncommutative type:%d", (int)ncRingType(r));
408    Print("\n//      is skew constant:%d",r->GetNC()->IsSkewConstant);
409    if( rIsSCA(r) )
410    {
411      Print("\n//   alternating variables: [%d, %d]", scaFirstAltVar(r), scaLastAltVar(r));
412      const ideal Q = SCAQuotient(r); // resides within r!
413      PrintS("\n//   quotient of sca by ideal");
414
415      if (Q!=NULL)
416      {
417//        if (r==currRing)
418//        {
419//          PrintLn();
420//          iiWriteMatrix((matrix)Q,"scaQ",1);
421//        }
422//        else
423            PrintS(" ...");
424      }
425      else
426        PrintS(" (NULL)");
427    }
428#endif
429  }
430#endif
431  //if (r->qideal!=NULL)
432  //{
433  //  PrintS("\n// quotient ring from ideal\n");
434  //  iiWriteMatrix((matrix)r->qideal,"_",1);
435  //}
436}
437
438void rDelete(ring r)
439{
440  int i, j;
441
442  if (r == NULL) return;
443
444#ifdef HAVE_PLURAL
445  if (rIsPluralRing(r))
446    nc_rKill(r);
447#endif
448
449  nKillChar(r->cf); r->cf = NULL;
450  rUnComplete(r);
451  // delete order stuff
452  if (r->order != NULL)
453  {
454    i=rBlocks(r);
455    assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
456    // delete order
457    omFreeSize((ADDRESS)r->order,i*sizeof(int));
458    omFreeSize((ADDRESS)r->block0,i*sizeof(int));
459    omFreeSize((ADDRESS)r->block1,i*sizeof(int));
460    // delete weights
461    for (j=0; j<i; j++)
462    {
463      if (r->wvhdl[j]!=NULL)
464        omFree(r->wvhdl[j]);
465    }
466    omFreeSize((ADDRESS)r->wvhdl,i*sizeof(int *));
467  }
468  else
469  {
470    assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
471  }
472
473  // delete varnames
474  if(r->names!=NULL)
475  {
476    for (i=0; i<r->N; i++)
477    {
478      if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
479    }
480    omFreeSize((ADDRESS)r->names,r->N*sizeof(char *));
481  }
482
483//   // delete parameter
484//   if (r->cf->parameter!=NULL)
485//   {
486//     char **s=r->cf->parameter;
487//     j = 0;
488//     while (j < rPar(r))
489//     {
490//       if (*s != NULL) omFree((ADDRESS)*s);
491//       s++;
492//       j++;
493//     }
494//     omFreeSize((ADDRESS)r->cf->parameter,rPar(r)*sizeof(char *));
495//   }
496  omFreeBin(r, sip_sring_bin);
497}
498
499int rOrderName(char * ordername)
500{
501  int order=ringorder_unspec;
502  while (order!= 0)
503  {
504    if (strcmp(ordername,rSimpleOrdStr(order))==0)
505      break;
506    order--;
507  }
508  if (order==0) Werror("wrong ring order `%s`",ordername);
509  omFree((ADDRESS)ordername);
510  return order;
511}
512
513char * rOrdStr(ring r)
514{
515  if ((r==NULL)||(r->order==NULL)) return omStrDup("");
516  int nblocks,l,i;
517
518  for (nblocks=0; r->order[nblocks]; nblocks++);
519  nblocks--;
520
521  StringSetS("");
522  for (l=0; ; l++)
523  {
524    StringAppendS((char *)rSimpleOrdStr(r->order[l]));
525    if (
526           (r->order[l] != ringorder_c)
527        && (r->order[l] != ringorder_C)
528        && (r->order[l] != ringorder_s)
529        && (r->order[l] != ringorder_S)
530        && (r->order[l] != ringorder_IS)
531       )
532    {
533      if (r->wvhdl[l]!=NULL)
534      {
535        StringAppendS("(");
536        for (int j= 0;
537             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
538             j+=i+1)
539        {
540          char c=',';
541          if(r->order[l]==ringorder_a64)
542          {
543            int64 * w=(int64 *)r->wvhdl[l];
544            for (i = 0; i<r->block1[l]-r->block0[l]; i++)
545            {
546              StringAppend("%lld," ,w[i]);
547            }
548            StringAppend("%lld)" ,w[i]);
549            break;
550          }
551          else
552          {
553            for (i = 0; i<r->block1[l]-r->block0[l]; i++)
554            {
555              StringAppend("%d," ,r->wvhdl[l][i+j]);
556            }
557          }
558          if (r->order[l]!=ringorder_M)
559          {
560            StringAppend("%d)" ,r->wvhdl[l][i+j]);
561            break;
562          }
563          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
564            c=')';
565          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
566        }
567      }
568      else
569        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
570    }
571    else if (r->order[l] == ringorder_IS)
572    {
573      assume( r->block0[l] == r->block1[l] );
574      const int s = r->block0[l];
575      assume( (-2 < s) && (s < 2) );
576
577      StringAppend("(%d)", s);
578    }
579
580    if (l==nblocks) return omStrDup(StringAppendS(""));
581    StringAppendS(",");
582  }
583}
584
585char * rVarStr(ring r)
586{
587  if ((r==NULL)||(r->names==NULL)) return omStrDup("");
588  int i;
589  int l=2;
590  char *s;
591
592  for (i=0; i<r->N; i++)
593  {
594    l+=strlen(r->names[i])+1;
595  }
596  s=(char *)omAlloc((long)l);
597  s[0]='\0';
598  for (i=0; i<r->N-1; i++)
599  {
600    strcat(s,r->names[i]);
601    strcat(s,",");
602  }
603  strcat(s,r->names[i]);
604  return s;
605}
606
607char * rCharStr(ring r)
608{
609  char *s;
610  int i;
611
612#ifdef HAVE_RINGS
613  if (rField_is_Ring_Z(r))
614  {
615    s=omStrDup("integer");                   // Z
616    return s;
617  }
618  if(rField_is_Ring_2toM(r))
619  {
620    char* s = (char*) omAlloc(7+10+2);
621    sprintf(s,"integer,%lu",r->cf->modExponent);
622    return s;
623  }
624  if(rField_is_Ring_ModN(r))
625  {
626    long l = (long)mpz_sizeinbase(r->cf->modBase, 10) + 2+7;
627    char* s = (char*) omAlloc(l);
628    gmp_sprintf(s,"integer,%Zd",r->cf->modBase);
629    return s;
630  }
631  if(rField_is_Ring_PtoM(r))
632  {
633    long l = (long)mpz_sizeinbase(r->cf->modBase, 10) + 2+7+10;
634    char* s = (char*) omAlloc(l);
635    gmp_sprintf(s,"integer,%Zd^%lu",r->cf->modBase,r->cf->modExponent);
636    return s;
637  }
638#endif
639  if (r->cf->parameter==NULL)
640  {
641    i=r->cf->ch;
642    if(i==-1)
643      s=omStrDup("real");                    /* R */
644    else
645    {
646      s=(char *)omAlloc(MAX_INT_LEN+1);
647      sprintf(s,"%d",i);                   /* Q, Z/p */
648    }
649    return s;
650  }
651  if (rField_is_long_C(r))
652  {
653    s=(char *)omAlloc(21+strlen(r->cf->parameter[0]));
654    sprintf(s,"complex,%d,%s",r->float_len,r->cf->parameter[0]);   /* C */
655    return s;
656  }
657  int l=0;
658  for(i=0; i<rPar(r);i++)
659  {
660    l+=(strlen(r->cf->parameter[i])+1);
661  }
662  s=(char *)omAlloc((long)(l+MAX_INT_LEN+1));
663  s[0]='\0';
664  if (r->cf->ch<0)       sprintf(s,"%d",-r->cf->ch); /* Fp(a) */
665  else if (r->cf->ch==1) sprintf(s,"0");         /* Q(a)  */
666  else
667  {
668    sprintf(s,"%d,%s",r->cf->ch,r->cf->parameter[0]); /* GF(q)  */
669    return s;
670  }
671  char tt[2];
672  tt[0]=',';
673  tt[1]='\0';
674  for(i=0; i<rPar(r);i++)
675  {
676    strcat(s,tt);
677    strcat(s,r->cf->parameter[i]);
678  }
679  return s;
680}
681
682char * rParStr(ring r)
683{
684  if ((r==NULL)||(r->cf->parameter==NULL)) return omStrDup("");
685
686  int i;
687  int l=2;
688
689  for (i=0; i<rPar(r); i++)
690  {
691    l+=strlen(r->cf->parameter[i])+1;
692  }
693  char *s=(char *)omAlloc((long)l);
694  s[0]='\0';
695  for (i=0; i<rPar(r)-1; i++)
696  {
697    strcat(s,r->cf->parameter[i]);
698    strcat(s,",");
699  }
700  strcat(s,r->cf->parameter[i]);
701  return s;
702}
703
704char * rString(ring r)
705{
706  char *ch=rCharStr(r);
707  char *var=rVarStr(r);
708  char *ord=rOrdStr(r);
709  char *res=(char *)omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
710  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
711  omFree((ADDRESS)ch);
712  omFree((ADDRESS)var);
713  omFree((ADDRESS)ord);
714  return res;
715}
716
717int  rIsExtension(const ring r)
718{
719  return (r->cf->parameter!=NULL); /* R, Q, Fp: FALSE */
720}
721
722static int binaryPower (const int a, const int b)
723{
724  /* computes a^b according to the binary representation of b,
725     i.e., a^7 = a^4 * a^2 * a^1. This saves some multiplications. */
726  int result = 1;
727  int factor = a;
728  int bb = b;
729  while (bb != 0)
730  {
731    if (bb % 2 != 0) result = result * factor;
732    bb = bb / 2;
733    factor = factor * factor;
734  }
735  return result;
736}
737
738int rChar(ring r)
739{
740  TODO(Somabody, move this proc. over to coeffs!?);
741
742#ifdef HAVE_RINGS
743  if (rField_is_Ring_2toM(r))
744    return binaryPower(2, (int)(unsigned long)r->cf->modExponent);
745  if (rField_is_Ring_ModN(r))
746    return (int)mpz_get_ui(r->cf->modBase);
747  if (rField_is_Ring_PtoM(r))
748    return binaryPower((int)mpz_get_ui(r->cf->modBase),
749                       (int)(unsigned long)r->cf->modExponent);
750
751#endif
752  if (rField_is_numeric(r))
753    return 0;
754  if (!rIsExtension(r)) /* Q, Fp */
755    return r->cf->ch;
756  if (rField_is_Zp_a(r))  /* Fp(a)  */
757    return -r->cf->ch;
758  if (rField_is_Q_a(r))   /* Q(a)  */
759    return 0;
760  /*else*/               /* GF(p,n) */
761  {
762    if ((r->cf->ch & 1)==0) return 2;
763    int i=3;
764    while ((r->cf->ch % i)!=0) i+=2;
765    return i;
766  }
767}
768
769typedef char *             char_ptr;
770omBin char_ptr_bin = omGetSpecBin(sizeof(char_ptr)); // deallocation?
771
772
773// creates a commutative nc extension; "converts" comm.ring to a Plural ring
774#ifdef HAVE_PLURAL
775ring nc_rCreateNCcomm_rCopy(ring r)
776{
777  r = rCopy(r);
778  if (rIsPluralRing(r))
779    return r;
780
781  matrix C = mpNew(r->N,r->N); // ring-independent!?!
782  matrix D = mpNew(r->N,r->N);
783
784  for(int i=1; i<r->N; i++)
785    for(int j=i+1; j<=r->N; j++)
786      MATELEM(C,i,j) = p_One( r);
787
788  if (nc_CallPlural(C, D, NULL, NULL, r, false, true, false, r/*??currRing??*/, TRUE)) // TODO: what about quotient ideal?
789    WarnS("Error initializing multiplication!"); // No reaction!???
790
791  return r;
792}
793#endif
794
795
796/*2
797 *returns -1 for not compatible, (sum is undefined)
798 *         1 for compatible (and sum)
799 */
800/* vartest: test for variable/paramter names
801* dp_dp: for comm. rings: use block order dp + dp/ds/wp
802*/
803int rSumInternal(ring r1, ring r2, ring &sum, BOOLEAN vartest, BOOLEAN dp_dp)
804{
805
806  ip_sring tmpR;
807  memset(&tmpR,0,sizeof(tmpR));
808  /* check coeff. field =====================================================*/
809
810  if (r1->cf==r2->cf)
811  {
812    tmpR.cf=r1->cf;
813    r1->cf->ref++;
814  }
815  else /* different type */
816  {
817    if (getCoeffType(r1->cf)==n_Zp)
818    {
819      if (getCoeffType(r2->cf)==n_Q)
820      {
821        tmpR.cf=r1->cf;
822        r1->cf->ref++;
823      }
824      else
825      {
826        WerrorS("Z/p+...");
827        return -1;
828      }
829    }
830    else if (getCoeffType(r1->cf)==n_R)
831    {
832      WerrorS("R+..");
833      return -1;
834    }
835    else if (getCoeffType(r1->cf)==n_Q)
836    {
837      if (getCoeffType(r2->cf)==n_Zp)
838      {
839        tmpR.cf=r2->cf;
840        r2->cf->ref++;
841      }
842      else
843      {
844        WerrorS("Q+...");
845        return -1;
846      }
847    }
848    else
849    {
850      WerrorS("coeff sum not yet implemented");
851      return -1;
852    }
853  }
854  /* variable names ========================================================*/
855  int i,j,k;
856  int l=r1->N+r2->N;
857  char **names=(char **)omAlloc0(l*sizeof(char *));
858  k=0;
859
860  // collect all varnames from r1, except those which are parameters
861  // of r2, or those which are the empty string
862  for (i=0;i<r1->N;i++)
863  {
864    BOOLEAN b=TRUE;
865
866    if (*(r1->names[i]) == '\0')
867      b = FALSE;
868    else if ((r2->cf->parameter!=NULL) && (strlen(r1->names[i])==1))
869    {
870      if (vartest)
871      {
872        for(j=0;j<rPar(r2);j++)
873        {
874          if (strcmp(r1->names[i],r2->cf->parameter[j])==0)
875          {
876            b=FALSE;
877            break;
878          }
879        }
880      }
881    }
882
883    if (b)
884    {
885      //Print("name : %d: %s\n",k,r1->names[i]);
886      names[k]=omStrDup(r1->names[i]);
887      k++;
888    }
889    //else
890    //  Print("no name (par1) %s\n",r1->names[i]);
891  }
892  // Add variables from r2, except those which are parameters of r1
893  // those which are empty strings, and those which equal a var of r1
894  for(i=0;i<r2->N;i++)
895  {
896    BOOLEAN b=TRUE;
897
898    if (*(r2->names[i]) == '\0')
899      b = FALSE;
900    else if ((r1->cf->parameter!=NULL) && (strlen(r2->names[i])==1))
901    {
902      if (vartest)
903      {
904        for(j=0;j<rPar(r1);j++)
905        {
906          if (strcmp(r2->names[i],r1->cf->parameter[j])==0)
907          {
908            b=FALSE;
909            break;
910          }
911        }
912      }
913    }
914
915    if (b)
916    {
917      if (vartest)
918      {
919        for(j=0;j<r1->N;j++)
920        {
921          if (strcmp(r1->names[j],r2->names[i])==0)
922          {
923            b=FALSE;
924            break;
925          }
926        }
927      }
928      if (b)
929      {
930        //Print("name : %d : %s\n",k,r2->names[i]);
931        names[k]=omStrDup(r2->names[i]);
932        k++;
933      }
934      //else
935      //  Print("no name (var): %s\n",r2->names[i]);
936    }
937    //else
938    //  Print("no name (par): %s\n",r2->names[i]);
939  }
940  // check whether we found any vars at all
941  if (k == 0)
942  {
943    names[k]=omStrDup("");
944    k=1;
945  }
946  tmpR.N=k;
947  tmpR.names=names;
948  /* ordering *======================================================== */
949  tmpR.OrdSgn=1;
950  if (dp_dp
951#ifdef HAVE_PLURAL
952      && !rIsPluralRing(r1) && !rIsPluralRing(r2)
953#endif
954     )
955  {
956    tmpR.order=(int*)omAlloc(4*sizeof(int));
957    tmpR.block0=(int*)omAlloc0(4*sizeof(int));
958    tmpR.block1=(int*)omAlloc0(4*sizeof(int));
959    tmpR.wvhdl=(int**)omAlloc0(4*sizeof(int *));
960    tmpR.order[0]=ringorder_dp;
961    tmpR.block0[0]=1;
962    tmpR.block1[0]=rVar(r1);
963    if (r2->OrdSgn==1)
964    {
965      if ((r2->block0[0]==1)
966      && (r2->block1[0]==rVar(r2))
967      && ((r2->order[0]==ringorder_wp)
968        || (r2->order[0]==ringorder_Wp)
969        || (r2->order[0]==ringorder_Dp))
970     )
971     {
972       tmpR.order[1]=r2->order[0];
973       if (r2->wvhdl[0]!=NULL)
974         tmpR.wvhdl[1]=(int *)omMemDup(r2->wvhdl[0]);
975     }
976     else
977        tmpR.order[1]=ringorder_dp;
978    }
979    else
980    {
981      tmpR.order[1]=ringorder_ds;
982      tmpR.OrdSgn=-1;
983    }
984    tmpR.block0[1]=rVar(r1)+1;
985    tmpR.block1[1]=rVar(r1)+rVar(r2);
986    tmpR.order[2]=ringorder_C;
987    tmpR.order[3]=0;
988  }
989  else
990  {
991    if ((r1->order[0]==ringorder_unspec)
992        && (r2->order[0]==ringorder_unspec))
993    {
994      tmpR.order=(int*)omAlloc(3*sizeof(int));
995      tmpR.block0=(int*)omAlloc(3*sizeof(int));
996      tmpR.block1=(int*)omAlloc(3*sizeof(int));
997      tmpR.wvhdl=(int**)omAlloc0(3*sizeof(int *));
998      tmpR.order[0]=ringorder_unspec;
999      tmpR.order[1]=ringorder_C;
1000      tmpR.order[2]=0;
1001      tmpR.block0[0]=1;
1002      tmpR.block1[0]=tmpR.N;
1003    }
1004    else if (l==k) /* r3=r1+r2 */
1005    {
1006      int b;
1007      ring rb;
1008      if (r1->order[0]==ringorder_unspec)
1009      {
1010        /* extend order of r2 to r3 */
1011        b=rBlocks(r2);
1012        rb=r2;
1013        tmpR.OrdSgn=r2->OrdSgn;
1014      }
1015      else if (r2->order[0]==ringorder_unspec)
1016      {
1017        /* extend order of r1 to r3 */
1018        b=rBlocks(r1);
1019        rb=r1;
1020        tmpR.OrdSgn=r1->OrdSgn;
1021      }
1022      else
1023      {
1024        b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1025        rb=NULL;
1026      }
1027      tmpR.order=(int*)omAlloc0(b*sizeof(int));
1028      tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1029      tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1030      tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int *));
1031      /* weights not implemented yet ...*/
1032      if (rb!=NULL)
1033      {
1034        for (i=0;i<b;i++)
1035        {
1036          tmpR.order[i]=rb->order[i];
1037          tmpR.block0[i]=rb->block0[i];
1038          tmpR.block1[i]=rb->block1[i];
1039          if (rb->wvhdl[i]!=NULL)
1040            WarnS("rSum: weights not implemented");
1041        }
1042        tmpR.block0[0]=1;
1043      }
1044      else /* ring sum for complete rings */
1045      {
1046        for (i=0;r1->order[i]!=0;i++)
1047        {
1048          tmpR.order[i]=r1->order[i];
1049          tmpR.block0[i]=r1->block0[i];
1050          tmpR.block1[i]=r1->block1[i];
1051          if (r1->wvhdl[i]!=NULL)
1052            tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1053        }
1054        j=i;
1055        i--;
1056        if ((r1->order[i]==ringorder_c)
1057            ||(r1->order[i]==ringorder_C))
1058        {
1059          j--;
1060          tmpR.order[b-2]=r1->order[i];
1061        }
1062        for (i=0;r2->order[i]!=0;i++)
1063        {
1064          if ((r2->order[i]!=ringorder_c)
1065              &&(r2->order[i]!=ringorder_C))
1066          {
1067            tmpR.order[j]=r2->order[i];
1068            tmpR.block0[j]=r2->block0[i]+rVar(r1);
1069            tmpR.block1[j]=r2->block1[i]+rVar(r1);
1070            if (r2->wvhdl[i]!=NULL)
1071            {
1072              tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1073            }
1074            j++;
1075          }
1076        }
1077        if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1078          tmpR.OrdSgn=-1;
1079      }
1080    }
1081    else if ((k==rVar(r1)) && (k==rVar(r2))) /* r1 and r2 are "quite"
1082                                                the same ring */
1083      /* copy r1, because we have the variables from r1 */
1084    {
1085      int b=rBlocks(r1);
1086
1087      tmpR.order=(int*)omAlloc0(b*sizeof(int));
1088      tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1089      tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1090      tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int *));
1091      /* weights not implemented yet ...*/
1092      for (i=0;i<b;i++)
1093      {
1094        tmpR.order[i]=r1->order[i];
1095        tmpR.block0[i]=r1->block0[i];
1096        tmpR.block1[i]=r1->block1[i];
1097        if (r1->wvhdl[i]!=NULL)
1098        {
1099          tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1100        }
1101      }
1102      tmpR.OrdSgn=r1->OrdSgn;
1103    }
1104    else
1105    {
1106      for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1107      omFreeSize((ADDRESS)names,tmpR.N*sizeof(char *));
1108      Werror("difficulties with variables: %d,%d -> %d",rVar(r1),rVar(r2),k);
1109      return -1;
1110    }
1111  }
1112  sum=(ring)omAllocBin(sip_sring_bin);
1113  memcpy(sum,&tmpR,sizeof(ip_sring));
1114  rComplete(sum);
1115
1116//#ifdef RDEBUG
1117//  rDebugPrint(sum);
1118//#endif
1119
1120
1121
1122#ifdef HAVE_PLURAL
1123  if(1)
1124  {
1125//    ring old_ring = currRing;
1126
1127    BOOLEAN R1_is_nc = rIsPluralRing(r1);
1128    BOOLEAN R2_is_nc = rIsPluralRing(r2);
1129
1130    if ( (R1_is_nc) || (R2_is_nc))
1131    {
1132      ring R1 = nc_rCreateNCcomm_rCopy(r1);
1133      assume( rIsPluralRing(R1) );
1134
1135#if 0
1136#ifdef RDEBUG
1137      rWrite(R1);
1138      rDebugPrint(R1);
1139#endif
1140#endif
1141      ring R2 = nc_rCreateNCcomm_rCopy(r2);
1142#if 0
1143#ifdef RDEBUG
1144      rWrite(R2);
1145      rDebugPrint(R2);
1146#endif
1147#endif
1148
1149//      rChangeCurrRing(sum); // ?
1150
1151      // Projections from R_i into Sum:
1152      /* multiplication matrices business: */
1153      /* find permutations of vars and pars */
1154      int *perm1 = (int *)omAlloc0((rVar(R1)+1)*sizeof(int));
1155      int *par_perm1 = NULL;
1156      if (rPar(R1)!=0) par_perm1=(int *)omAlloc0((rPar(R1)+1)*sizeof(int));
1157
1158      int *perm2 = (int *)omAlloc0((rVar(R2)+1)*sizeof(int));
1159      int *par_perm2 = NULL;
1160      if (rPar(R2)!=0) par_perm2=(int *)omAlloc0((rPar(R2)+1)*sizeof(int));
1161
1162      maFindPerm(R1->names,  rVar(R1),  R1->cf->parameter,  rPar(R1),
1163                 sum->names, rVar(sum), sum->cf->parameter, rPar(sum),
1164                 perm1, par_perm1, sum->cf->ch);
1165
1166      maFindPerm(R2->names,  rVar(R2),  R2->cf->parameter,  rPar(R2),
1167                 sum->names, rVar(sum), sum->cf->parameter, rPar(sum),
1168                 perm2, par_perm2, sum->cf->ch);
1169
1170
1171      matrix C1 = R1->GetNC()->C, C2 = R2->GetNC()->C;
1172      matrix D1 = R1->GetNC()->D, D2 = R2->GetNC()->D;
1173
1174      // !!!! BUG? C1 and C2 might live in different baserings!!!
1175
1176      int l = rVar(R1) + rVar(R2);
1177
1178      matrix C  = mpNew(l,l);
1179      matrix D  = mpNew(l,l);
1180
1181      for (i = 1; i <= rVar(R1); i++)
1182        for (j= rVar(R1)+1; j <= l; j++)
1183          MATELEM(C,i,j) = p_One(sum); // in 'sum'
1184
1185      id_Test((ideal)C, sum);
1186
1187      nMapFunc nMap1 = n_SetMap(R1->cf,sum->cf); /* can change something global: not usable
1188                                                    after the next nSetMap call :( */
1189      // Create blocked C and D matrices:
1190      for (i=1; i<= rVar(R1); i++)
1191        for (j=i+1; j<=rVar(R1); j++)
1192        {
1193          assume(MATELEM(C1,i,j) != NULL);
1194          MATELEM(C,i,j) = p_PermPoly(MATELEM(C1,i,j), perm1, R1, sum, nMap1, par_perm1, rPar(R1)); // need ADD + CMP ops.
1195
1196          if (MATELEM(D1,i,j) != NULL)
1197            MATELEM(D,i,j) = p_PermPoly(MATELEM(D1,i,j), perm1, R1, sum, nMap1, par_perm1, rPar(R1));
1198        }
1199
1200      id_Test((ideal)C, sum);
1201      id_Test((ideal)D, sum);
1202
1203
1204      nMapFunc nMap2 = n_SetMap(R2->cf,sum->cf); /* can change something global: not usable
1205                                                    after the next nSetMap call :( */
1206      for (i=1; i<= rVar(R2); i++)
1207        for (j=i+1; j<=rVar(R2); j++)
1208        {
1209          assume(MATELEM(C2,i,j) != NULL);
1210          MATELEM(C,rVar(R1)+i,rVar(R1)+j) = p_PermPoly(MATELEM(C2,i,j),perm2,R2,sum, nMap2,par_perm2,rPar(R2));
1211
1212          if (MATELEM(D2,i,j) != NULL)
1213            MATELEM(D,rVar(R1)+i,rVar(R1)+j) = p_PermPoly(MATELEM(D2,i,j),perm2,R2,sum, nMap2,par_perm2,rPar(R2));
1214        }
1215
1216      id_Test((ideal)C, sum);
1217      id_Test((ideal)D, sum);
1218
1219      // Now sum is non-commutative with blocked structure constants!
1220      if (nc_CallPlural(C, D, NULL, NULL, sum, false, false, true, sum))
1221        WarnS("Error initializing non-commutative multiplication!");
1222
1223      /* delete R1, R2*/
1224
1225#if 0
1226#ifdef RDEBUG
1227      rWrite(sum);
1228      rDebugPrint(sum);
1229
1230      Print("\nRefs: R1: %d, R2: %d\n", R1->GetNC()->ref, R2->GetNC()->ref);
1231
1232#endif
1233#endif
1234
1235
1236      rDelete(R1);
1237      rDelete(R2);
1238
1239      /* delete perm arrays */
1240      if (perm1!=NULL) omFree((ADDRESS)perm1);
1241      if (perm2!=NULL) omFree((ADDRESS)perm2);
1242      if (par_perm1!=NULL) omFree((ADDRESS)par_perm1);
1243      if (par_perm2!=NULL) omFree((ADDRESS)par_perm2);
1244
1245//      rChangeCurrRing(old_ring);
1246    }
1247
1248  }
1249#endif
1250
1251  ideal Q=NULL;
1252  ideal Q1=NULL, Q2=NULL;
1253  if (r1->qideal!=NULL)
1254  {
1255//    rChangeCurrRing(sum);
1256//     if (r2->qideal!=NULL)
1257//     {
1258//       WerrorS("todo: qring+qring");
1259//       return -1;
1260//     }
1261//     else
1262//     {}
1263    /* these were defined in the Plural Part above... */
1264    int *perm1 = (int *)omAlloc0((rVar(r1)+1)*sizeof(int));
1265    int *par_perm1 = NULL;
1266    if (rPar(r1)!=0) par_perm1=(int *)omAlloc0((rPar(r1)+1)*sizeof(int));
1267    maFindPerm(r1->names,  rVar(r1),  r1->cf->parameter,  rPar(r1),
1268               sum->names, rVar(sum), sum->cf->parameter, rPar(sum),
1269               perm1, par_perm1, sum->cf->ch);
1270    nMapFunc nMap1 = n_SetMap(r1->cf,sum->cf);
1271    Q1 = idInit(IDELEMS(r1->qideal),1);
1272
1273    for (int for_i=0;for_i<IDELEMS(r1->qideal);for_i++)
1274      Q1->m[for_i] = p_PermPoly(
1275                                r1->qideal->m[for_i], perm1,
1276                                r1, sum,
1277                                nMap1,
1278                                par_perm1, rPar(r1));
1279
1280    omFree((ADDRESS)perm1);
1281  }
1282
1283  if (r2->qideal!=NULL)
1284  {
1285    //if (currRing!=sum)
1286    //  rChangeCurrRing(sum);
1287    int *perm2 = (int *)omAlloc0((rVar(r2)+1)*sizeof(int));
1288    int *par_perm2 = NULL;
1289    if (rPar(r2)!=0) par_perm2=(int *)omAlloc0((rPar(r2)+1)*sizeof(int));
1290    maFindPerm(r2->names,  rVar(r2),  r2->cf->parameter,  rPar(r2),
1291               sum->names, rVar(sum), sum->cf->parameter, rPar(sum),
1292               perm2, par_perm2, sum->cf->ch);
1293    nMapFunc nMap2 = n_SetMap(r2->cf,sum->cf);
1294    Q2 = idInit(IDELEMS(r2->qideal),1);
1295
1296    for (int for_i=0;for_i<IDELEMS(r2->qideal);for_i++)
1297      Q2->m[for_i] = p_PermPoly(
1298                  r2->qideal->m[for_i], perm2,
1299                  r2, sum,
1300                  nMap2,
1301                  par_perm2, rPar(r2));
1302
1303    omFree((ADDRESS)perm2);
1304  }
1305  if ( (Q1!=NULL) || ( Q2!=NULL))
1306  {
1307    Q = id_SimpleAdd(Q1,Q2,sum);
1308  }
1309  sum->qideal = Q;
1310
1311#ifdef HAVE_PLURAL
1312  if( rIsPluralRing(sum) )
1313    nc_SetupQuotient( sum );
1314#endif
1315  return 1;
1316}
1317
1318/*2
1319 *returns -1 for not compatible, (sum is undefined)
1320 *         0 for equal, (and sum)
1321 *         1 for compatible (and sum)
1322 */
1323int rSum(ring r1, ring r2, ring &sum)
1324{
1325  if (r1==r2)
1326  {
1327    sum=r1;
1328    r1->ref++;
1329    return 0;
1330  }
1331  return rSumInternal(r1,r2,sum,TRUE,FALSE);
1332}
1333
1334/*2
1335 * create a copy of the ring r, which must be equivalent to currRing
1336 * used for qring definition,..
1337 * (i.e.: normal rings: same nCopy as currRing;
1338 *        qring:        same nCopy, same idCopy as currRing)
1339 * DOES NOT CALL rComplete
1340 */
1341ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
1342{
1343  if (r == NULL) return NULL;
1344  int i,j;
1345  ring res=(ring)omAllocBin(sip_sring_bin);
1346  memset(res,0,sizeof(ip_sring));
1347  //memcpy(res,r,sizeof(ip_sring));
1348  //memset: res->idroot=NULL; /* local objects */
1349  //ideal      minideal;
1350  res->options=r->options; /* ring dependent options */
1351
1352  //memset: res->ordsgn=NULL;
1353  //memset: res->typ=NULL;
1354  //memset: res->VarOffset=NULL;
1355  //memset: res->firstwv=NULL;
1356
1357  //struct omBin   PolyBin; /* Bin from where monoms are allocated */
1358  //memset: res->PolyBin=NULL; // rComplete
1359  res->cf=r->cf;     /* coeffs */
1360  res->cf->ref++;
1361
1362  //memset: res->ref=0; /* reference counter to the ring */
1363
1364  res->float_len=r->float_len; /* additional char-flags */
1365  res->float_len2=r->float_len2; /* additional char-flags */
1366
1367  res->N=rVar(r);      /* number of vars */
1368  res->OrdSgn=r->OrdSgn; /* 1 for polynomial rings, -1 otherwise */
1369
1370  res->firstBlockEnds=r->firstBlockEnds;
1371#ifdef HAVE_PLURAL
1372  res->real_var_start=r->real_var_start;
1373  res->real_var_end=r->real_var_end;
1374#endif
1375
1376#ifdef HAVE_SHIFTBBA
1377  res->isLPring=r->isLPring; /* 0 for non-letterplace rings, otherwise the number of LP blocks, at least 1, known also as lV */
1378#endif
1379
1380  res->VectorOut=r->VectorOut;
1381  res->ShortOut=r->ShortOut;
1382  res->CanShortOut=r->CanShortOut;
1383  res->LexOrder=r->LexOrder; // TRUE if the monomial ordering has polynomial and power series blocks
1384  res->MixedOrder=r->MixedOrder; // ?? 1 for lex ordering (except ls), -1 otherwise
1385  res->ComponentOrder=r->ComponentOrder;
1386
1387  //memset: res->ExpL_Size=0;
1388  //memset: res->CmpL_Size=0;
1389  //memset: res->VarL_Size=0;
1390  //memset: res->pCompIndex=0;
1391  //memset: res->pOrdIndex=0;
1392  //memset: res->OrdSize=0;
1393  //memset: res->VarL_LowIndex=0;
1394  //memset: res->MinExpPerLong=0;
1395  //memset: res->NegWeightL_Size=0;
1396  //memset: res->NegWeightL_Offset=NULL;
1397  //memset: res->VarL_Offset=NULL;
1398
1399  // the following are set by rComplete unless predefined
1400  // therefore, we copy these values: maybe they are non-standard
1401  /* mask for getting single exponents */
1402  res->bitmask=r->bitmask;
1403  res->divmask=r->divmask;
1404  res->BitsPerExp = r->BitsPerExp;
1405  res->ExpPerLong =  r->ExpPerLong;
1406
1407  //memset: res->p_Procs=NULL;
1408  //memset: res->pFDeg=NULL;
1409  //memset: res->pLDeg=NULL;
1410  //memset: res->pFDegOrig=NULL;
1411  //memset: res->pLDegOrig=NULL;
1412  //memset: res->p_Setm=NULL;
1413  //memset: res->cf=NULL;
1414  res->options=r->options;
1415  //
1416  if (r->algring!=NULL)
1417    r->algring->ref++;
1418  res->algring=r->algring;
1419  //memset: res->minideal=NULL;
1420  if (copy_ordering == TRUE)
1421  {
1422    i=rBlocks(r);
1423    res->wvhdl   = (int **)omAlloc(i * sizeof(int *));
1424    res->order   = (int *) omAlloc(i * sizeof(int));
1425    res->block0  = (int *) omAlloc(i * sizeof(int));
1426    res->block1  = (int *) omAlloc(i * sizeof(int));
1427    for (j=0; j<i; j++)
1428    {
1429      if (r->wvhdl[j]!=NULL)
1430      {
1431        res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1432      }
1433      else
1434        res->wvhdl[j]=NULL;
1435    }
1436    memcpy(res->order,r->order,i * sizeof(int));
1437    memcpy(res->block0,r->block0,i * sizeof(int));
1438    memcpy(res->block1,r->block1,i * sizeof(int));
1439  }
1440  //memset: else
1441  //memset: {
1442  //memset:   res->wvhdl = NULL;
1443  //memset:   res->order = NULL;
1444  //memset:   res->block0 = NULL;
1445  //memset:   res->block1 = NULL;
1446  //memset: }
1447
1448  res->names   = (char **)omAlloc0(rVar(r) * sizeof(char *));
1449  for (i=0; i<rVar(res); i++)
1450  {
1451    res->names[i] = omStrDup(r->names[i]);
1452  }
1453  if (r->qideal!=NULL)
1454  {
1455    if (copy_qideal)
1456    {
1457      #ifndef NDEBUG
1458      if (!copy_ordering)
1459        WerrorS("internal error: rCopy0(Q,TRUE,FALSE)");
1460      else
1461      #endif
1462      {
1463      #ifndef NDEBUG
1464        WarnS("internal bad stuff: rCopy0(Q,TRUE,TRUE)");
1465      #endif
1466        rComplete(res);
1467        res->qideal= idrCopyR_NoSort(r->qideal, r, res);
1468        rUnComplete(res);
1469      }
1470    }
1471    //memset: else res->qideal = NULL;
1472  }
1473  //memset: else res->qideal = NULL;
1474  //memset: res->GetNC() = NULL; // copy is purely commutative!!!
1475  return res;
1476}
1477
1478/*2
1479 * create a copy of the ring r, which must be equivalent to currRing
1480 * used for qring definition,..
1481 * (i.e.: normal rings: same nCopy as currRing;
1482 *        qring:        same nCopy, same idCopy as currRing)
1483 */
1484ring rCopy(ring r)
1485{
1486  if (r == NULL) return NULL;
1487  ring res=rCopy0(r,FALSE,TRUE);
1488  rComplete(res, 1); // res is purely commutative so far
1489  if (r->qideal!=NULL) res->qideal=idrCopyR_NoSort(r->qideal, r, res);
1490
1491#ifdef HAVE_PLURAL
1492  if (rIsPluralRing(r))
1493    if( nc_rCopy(res, r, true) );
1494#endif
1495
1496  return res;
1497}
1498
1499// returns TRUE, if r1 equals r2 FALSE, otherwise Equality is
1500// determined componentwise, if qr == 1, then qrideal equality is
1501// tested, as well
1502BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1503{
1504  int i, j;
1505
1506  if (r1 == r2) return TRUE;
1507
1508  if (r1 == NULL || r2 == NULL) return FALSE;
1509
1510  if ((r1->cf->type != r2->cf->type)
1511  || (r1->float_len != r2->float_len)
1512  || (r1->float_len2 != r2->float_len2)
1513  || (rVar(r1) != rVar(r2))
1514  || (r1->OrdSgn != r2->OrdSgn)
1515  || (rPar(r1) != rPar(r2)))
1516    return FALSE;
1517
1518  for (i=0; i<rVar(r1); i++)
1519  {
1520    if (r1->names[i] != NULL && r2->names[i] != NULL)
1521    {
1522      if (strcmp(r1->names[i], r2->names[i])) return FALSE;
1523    }
1524    else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1525    {
1526      return FALSE;
1527    }
1528  }
1529
1530  i=0;
1531  while (r1->order[i] != 0)
1532  {
1533    if (r2->order[i] == 0) return FALSE;
1534    if ((r1->order[i] != r2->order[i])
1535    || (r1->block0[i] != r2->block0[i])
1536    || (r1->block1[i] != r2->block1[i]))
1537      return FALSE;
1538    if (r1->wvhdl[i] != NULL)
1539    {
1540      if (r2->wvhdl[i] == NULL)
1541        return FALSE;
1542      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1543        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1544          return FALSE;
1545    }
1546    else if (r2->wvhdl[i] != NULL) return FALSE;
1547    i++;
1548  }
1549  if (r2->order[i] != 0) return FALSE;
1550
1551  for (i=0; i<rPar(r1);i++)
1552  {
1553      if (strcmp(r1->cf->parameter[i], r2->cf->parameter[i])!=0)
1554        return FALSE;
1555  }
1556
1557  if (r1->cf->minpoly != NULL)
1558  {
1559    if (r2->cf->minpoly == NULL) return FALSE;
1560    if (! n_Equal(r1->cf->minpoly, r2->cf->minpoly, r1->cf)) return FALSE;
1561  }
1562  else if (r2->cf->minpoly != NULL) return FALSE;
1563
1564  if (qr)
1565  {
1566    if (r1->qideal != NULL)
1567    {
1568      ideal id1 = r1->qideal, id2 = r2->qideal;
1569      int i, n;
1570      poly *m1, *m2;
1571
1572      if (id2 == NULL) return FALSE;
1573      if ((n = IDELEMS(id1)) != IDELEMS(id2)) return FALSE;
1574
1575      {
1576        m1 = id1->m;
1577        m2 = id2->m;
1578        for (i=0; i<n; i++)
1579          if (! p_EqualPolys(m1[i],m2[i],r1)) return FALSE;
1580      }
1581    }
1582    else if (r2->qideal != NULL) return FALSE;
1583  }
1584
1585  return TRUE;
1586}
1587
1588// returns TRUE, if r1 and r2 represents the monomials in the same way
1589// FALSE, otherwise
1590// this is an analogue to rEqual but not so strict
1591BOOLEAN rSamePolyRep(ring r1, ring r2)
1592{
1593  int i, j;
1594
1595  if (r1 == r2) return TRUE;
1596
1597  if (r1 == NULL || r2 == NULL) return FALSE;
1598
1599  if ((r1->cf->type != r2->cf->type)
1600  || (r1->float_len != r2->float_len)
1601  || (r1->float_len2 != r2->float_len2)
1602  || (rVar(r1) != rVar(r2))
1603  || (r1->OrdSgn != r2->OrdSgn)
1604  || (rPar(r1) != rPar(r2)))
1605    return FALSE;
1606
1607  if (rVar(r1)!=rVar(r2)) return FALSE;
1608  if (rPar(r1)!=rPar(r2)) return FALSE;
1609
1610  i=0;
1611  while (r1->order[i] != 0)
1612  {
1613    if (r2->order[i] == 0) return FALSE;
1614    if ((r1->order[i] != r2->order[i])
1615    || (r1->block0[i] != r2->block0[i])
1616    || (r1->block1[i] != r2->block1[i]))
1617      return FALSE;
1618    if (r1->wvhdl[i] != NULL)
1619    {
1620      if (r2->wvhdl[i] == NULL)
1621        return FALSE;
1622      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1623        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1624          return FALSE;
1625    }
1626    else if (r2->wvhdl[i] != NULL) return FALSE;
1627    i++;
1628  }
1629  if (r2->order[i] != 0) return FALSE;
1630
1631  // we do not check minpoly
1632  // we do not check qideal
1633
1634  return TRUE;
1635}
1636
1637rOrderType_t rGetOrderType(ring r)
1638{
1639  // check for simple ordering
1640  if (rHasSimpleOrder(r))
1641  {
1642    if ((r->order[1] == ringorder_c)
1643    || (r->order[1] == ringorder_C))
1644    {
1645      switch(r->order[0])
1646      {
1647          case ringorder_dp:
1648          case ringorder_wp:
1649          case ringorder_ds:
1650          case ringorder_ws:
1651          case ringorder_ls:
1652          case ringorder_unspec:
1653            if (r->order[1] == ringorder_C
1654            ||  r->order[0] == ringorder_unspec)
1655              return rOrderType_ExpComp;
1656            return rOrderType_Exp;
1657
1658          default:
1659            assume(r->order[0] == ringorder_lp ||
1660                   r->order[0] == ringorder_rs ||
1661                   r->order[0] == ringorder_Dp ||
1662                   r->order[0] == ringorder_Wp ||
1663                   r->order[0] == ringorder_Ds ||
1664                   r->order[0] == ringorder_Ws);
1665
1666            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1667            return rOrderType_Exp;
1668      }
1669    }
1670    else
1671    {
1672      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1673      return rOrderType_CompExp;
1674    }
1675  }
1676  else
1677    return rOrderType_General;
1678}
1679
1680BOOLEAN rHasSimpleOrder(const ring r)
1681{
1682  if (r->order[0] == ringorder_unspec) return TRUE;
1683  int blocks = rBlocks(r) - 1;
1684  assume(blocks >= 1);
1685  if (blocks == 1) return TRUE;
1686
1687  int s = 0;
1688  while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1689  {
1690    s++;
1691    blocks--;
1692  }
1693
1694  if ((blocks - s) > 2)  return FALSE;
1695
1696  assume( blocks == s + 2 );
1697
1698  if (
1699     (r->order[s] != ringorder_c)
1700  && (r->order[s] != ringorder_C)
1701  && (r->order[s+1] != ringorder_c)
1702  && (r->order[s+1] != ringorder_C)
1703     )
1704    return FALSE;
1705  if ((r->order[s+1] == ringorder_M)
1706  || (r->order[s] == ringorder_M))
1707    return FALSE;
1708  return TRUE;
1709}
1710
1711// returns TRUE, if simple lp or ls ordering
1712BOOLEAN rHasSimpleLexOrder(const ring r)
1713{
1714  return rHasSimpleOrder(r) &&
1715    (r->order[0] == ringorder_ls ||
1716     r->order[0] == ringorder_lp ||
1717     r->order[1] == ringorder_ls ||
1718     r->order[1] == ringorder_lp);
1719}
1720
1721BOOLEAN rOrder_is_DegOrdering(const rRingOrder_t order)
1722{
1723  switch(order)
1724  {
1725      case ringorder_dp:
1726      case ringorder_Dp:
1727      case ringorder_ds:
1728      case ringorder_Ds:
1729      case ringorder_Ws:
1730      case ringorder_Wp:
1731      case ringorder_ws:
1732      case ringorder_wp:
1733        return TRUE;
1734
1735      default:
1736        return FALSE;
1737  }
1738}
1739
1740BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1741{
1742  switch(order)
1743  {
1744      case ringorder_Ws:
1745      case ringorder_Wp:
1746      case ringorder_ws:
1747      case ringorder_wp:
1748        return TRUE;
1749
1750      default:
1751        return FALSE;
1752  }
1753}
1754
1755BOOLEAN rHasSimpleOrderAA(ring r)
1756{
1757  if (r->order[0] == ringorder_unspec) return TRUE;
1758  int blocks = rBlocks(r) - 1;
1759  assume(blocks >= 1);
1760  if (blocks == 1) return TRUE;
1761
1762  int s = 0;
1763  while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1764  {
1765    s++;
1766    blocks--;
1767  }
1768
1769  if ((blocks - s) > 3)  return FALSE;
1770
1771//  if ((blocks > 3) || (blocks < 2)) return FALSE;
1772  if ((blocks - s) == 3)
1773  {
1774    return (((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M) &&
1775             ((r->order[s+2] == ringorder_c) || (r->order[s+2] == ringorder_C))) ||
1776            (((r->order[s] == ringorder_c) || (r->order[s] == ringorder_C)) &&
1777             (r->order[s+1] == ringorder_aa) && (r->order[s+2] != ringorder_M)));
1778  }
1779  else
1780  {
1781    return ((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M));
1782  }
1783}
1784
1785// return TRUE if p_SetComp requires p_Setm
1786BOOLEAN rOrd_SetCompRequiresSetm(ring r)
1787{
1788  if (r->typ != NULL)
1789  {
1790    int pos;
1791    for (pos=0;pos<r->OrdSize;pos++)
1792    {
1793      sro_ord* o=&(r->typ[pos]);
1794      if ((o->ord_typ == ro_syzcomp) || (o->ord_typ == ro_syz) || (o->ord_typ == ro_is) || (o->ord_typ == ro_isTemp)) return TRUE;
1795    }
1796  }
1797  return FALSE;
1798}
1799
1800// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
1801BOOLEAN rOrd_is_Totaldegree_Ordering(ring r)
1802{
1803  // Hmm.... what about Syz orderings?
1804  return (rVar(r) > 1 &&
1805          ((rHasSimpleOrder(r) &&
1806           (rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) ||
1807            rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) ||
1808           (rHasSimpleOrderAA(r) &&
1809            (rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) ||
1810             rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
1811}
1812
1813// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
1814BOOLEAN rOrd_is_WeightedDegree_Ordering(ring r )
1815{
1816  // Hmm.... what about Syz orderings?
1817  return ((rVar(r) > 1) &&
1818          rHasSimpleOrder(r) &&
1819          (rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) ||
1820           rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
1821}
1822
1823BOOLEAN rIsPolyVar(int v, ring r)
1824{
1825  int  i=0;
1826  while(r->order[i]!=0)
1827  {
1828    if((r->block0[i]<=v)
1829    && (r->block1[i]>=v))
1830    {
1831      switch(r->order[i])
1832      {
1833        case ringorder_a:
1834          return (r->wvhdl[i][v-r->block0[i]]>0);
1835        case ringorder_M:
1836          return 2; /*don't know*/
1837        case ringorder_a64: /* assume: all weight are non-negative!*/
1838        case ringorder_lp:
1839        case ringorder_rs:
1840        case ringorder_dp:
1841        case ringorder_Dp:
1842        case ringorder_wp:
1843        case ringorder_Wp:
1844          return TRUE;
1845        case ringorder_ls:
1846        case ringorder_ds:
1847        case ringorder_Ds:
1848        case ringorder_ws:
1849        case ringorder_Ws:
1850          return FALSE;
1851        default:
1852          break;
1853      }
1854    }
1855    i++;
1856  }
1857  return 3; /* could not find var v*/
1858}
1859
1860#ifdef RDEBUG
1861// This should eventually become a full-fledge ring check, like pTest
1862BOOLEAN rDBTest(ring r, const char* fn, const int l)
1863{
1864  int i,j;
1865
1866  if (r == NULL)
1867  {
1868    dReportError("Null ring in %s:%d", fn, l);
1869    return FALSE;
1870  }
1871
1872
1873  if (r->N == 0) return TRUE;
1874
1875//  omCheckAddrSize(r,sizeof(ip_sring));
1876#if OM_CHECK > 0
1877  i=rBlocks(r);
1878  omCheckAddrSize(r->order,i*sizeof(int));
1879  omCheckAddrSize(r->block0,i*sizeof(int));
1880  omCheckAddrSize(r->block1,i*sizeof(int));
1881  if (r->wvhdl!=NULL)
1882  {
1883    omCheckAddrSize(r->wvhdl,i*sizeof(int *));
1884    for (j=0;j<i; j++)
1885    {
1886      if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
1887    }
1888  }
1889#endif
1890  if (r->VarOffset == NULL)
1891  {
1892    dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
1893    return FALSE;
1894  }
1895  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
1896
1897  if ((r->OrdSize==0)!=(r->typ==NULL))
1898  {
1899    dReportError("mismatch OrdSize and typ-pointer in %s:%d");
1900    return FALSE;
1901  }
1902  omcheckAddrSize(r->typ,r->OrdSize*sizeof(*(r->typ)));
1903  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(*(r->VarOffset)));
1904  // test assumptions:
1905  for(i=0;i<=r->N;i++) // for all variables (i = 0..N)
1906  {
1907    if(r->typ!=NULL)
1908    {
1909      for(j=0;j<r->OrdSize;j++) // for all ordering blocks (j =0..OrdSize-1)
1910      {
1911        if(r->typ[j].ord_typ == ro_isTemp)
1912        {
1913          const int p = r->typ[j].data.isTemp.suffixpos;
1914
1915          if(p <= j)
1916            dReportError("ordrec prefix %d is unmatched",j);
1917
1918          assume( p < r->OrdSize );
1919
1920          if(r->typ[p].ord_typ != ro_is)
1921            dReportError("ordrec prefix %d is unmatched (suffix: %d is wrong!!!)",j, p);
1922
1923          // Skip all intermediate blocks for undone variables:
1924          if(r->typ[j].data.isTemp.pVarOffset[i] != -1) // Check i^th variable
1925          {
1926            j = p - 1; // SKIP ALL INTERNAL BLOCKS...???
1927            continue; // To make for check OrdSize bound...
1928          }
1929        }
1930        else if (r->typ[j].ord_typ == ro_is)
1931        {
1932          // Skip all intermediate blocks for undone variables:
1933          if(r->typ[j].data.is.pVarOffset[i] != -1)
1934          {
1935            // ???
1936          }
1937
1938        }
1939        else
1940        {
1941          if (r->typ[j].ord_typ==ro_cp)
1942          {
1943            if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
1944              dReportError("ordrec %d conflicts with var %d",j,i);
1945          }
1946          else
1947            if ((r->typ[j].ord_typ!=ro_syzcomp)
1948            && (r->VarOffset[i] == r->typ[j].data.dp.place))
1949              dReportError("ordrec %d conflicts with var %d",j,i);
1950        }
1951      }
1952    }
1953    int tmp;
1954      tmp=r->VarOffset[i] & 0xffffff;
1955      #if SIZEOF_LONG == 8
1956        if ((r->VarOffset[i] >> 24) >63)
1957      #else
1958        if ((r->VarOffset[i] >> 24) >31)
1959      #endif
1960          dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
1961      if (i > 0 && ((tmp<0) ||(tmp>r->ExpL_Size-1)))
1962      {
1963        dReportError("varoffset out of range for var %d: %d",i,tmp);
1964      }
1965  }
1966  if(r->typ!=NULL)
1967  {
1968    for(j=0;j<r->OrdSize;j++)
1969    {
1970      if ((r->typ[j].ord_typ==ro_dp)
1971      || (r->typ[j].ord_typ==ro_wp)
1972      || (r->typ[j].ord_typ==ro_wp_neg))
1973      {
1974        if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
1975          dReportError("in ordrec %d: start(%d) > end(%d)",j,
1976            r->typ[j].data.dp.start, r->typ[j].data.dp.end);
1977        if ((r->typ[j].data.dp.start < 1)
1978        || (r->typ[j].data.dp.end > r->N))
1979          dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
1980            r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
1981      }
1982    }
1983  }
1984  if (r->cf->minpoly!=NULL)
1985  {
1986    omCheckAddr(r->cf->minpoly);
1987  }
1988  //assume(r->cf!=NULL);
1989
1990  return TRUE;
1991}
1992#endif
1993
1994static void rO_Align(int &place, int &bitplace)
1995{
1996  // increment place to the next aligned one
1997  // (count as Exponent_t,align as longs)
1998  if (bitplace!=BITS_PER_LONG)
1999  {
2000    place++;
2001    bitplace=BITS_PER_LONG;
2002  }
2003}
2004
2005static void rO_TDegree(int &place, int &bitplace, int start, int end,
2006    long *o, sro_ord &ord_struct)
2007{
2008  // degree (aligned) of variables v_start..v_end, ordsgn 1
2009  rO_Align(place,bitplace);
2010  ord_struct.ord_typ=ro_dp;
2011  ord_struct.data.dp.start=start;
2012  ord_struct.data.dp.end=end;
2013  ord_struct.data.dp.place=place;
2014  o[place]=1;
2015  place++;
2016  rO_Align(place,bitplace);
2017}
2018
2019static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2020    long *o, sro_ord &ord_struct)
2021{
2022  // degree (aligned) of variables v_start..v_end, ordsgn -1
2023  rO_Align(place,bitplace);
2024  ord_struct.ord_typ=ro_dp;
2025  ord_struct.data.dp.start=start;
2026  ord_struct.data.dp.end=end;
2027  ord_struct.data.dp.place=place;
2028  o[place]=-1;
2029  place++;
2030  rO_Align(place,bitplace);
2031}
2032
2033static void rO_WDegree(int &place, int &bitplace, int start, int end,
2034    long *o, sro_ord &ord_struct, int *weights)
2035{
2036  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2037  while((start<end) && (weights[0]==0)) { start++; weights++; }
2038  while((start<end) && (weights[end-start]==0)) { end--; }
2039  int i;
2040  int pure_tdeg=1;
2041  for(i=start;i<=end;i++)
2042  {
2043    if(weights[i-start]!=1)
2044    {
2045      pure_tdeg=0;
2046      break;
2047    }
2048  }
2049  if (pure_tdeg)
2050  {
2051    rO_TDegree(place,bitplace,start,end,o,ord_struct);
2052    return;
2053  }
2054  rO_Align(place,bitplace);
2055  ord_struct.ord_typ=ro_wp;
2056  ord_struct.data.wp.start=start;
2057  ord_struct.data.wp.end=end;
2058  ord_struct.data.wp.place=place;
2059  ord_struct.data.wp.weights=weights;
2060  o[place]=1;
2061  place++;
2062  rO_Align(place,bitplace);
2063  for(i=start;i<=end;i++)
2064  {
2065    if(weights[i-start]<0)
2066    {
2067      ord_struct.ord_typ=ro_wp_neg;
2068      break;
2069    }
2070  }
2071}
2072
2073static void rO_WDegree64(int &place, int &bitplace, int start, int end,
2074    long *o, sro_ord &ord_struct, int64 *weights)
2075{
2076  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1,
2077  // reserved 2 places
2078  rO_Align(place,bitplace);
2079  ord_struct.ord_typ=ro_wp64;
2080  ord_struct.data.wp64.start=start;
2081  ord_struct.data.wp64.end=end;
2082  ord_struct.data.wp64.place=place;
2083  ord_struct.data.wp64.weights64=weights;
2084  o[place]=1;
2085  place++;
2086  o[place]=1;
2087  place++;
2088  rO_Align(place,bitplace);
2089}
2090
2091static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2092    long *o, sro_ord &ord_struct, int *weights)
2093{
2094  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2095  while((start<end) && (weights[0]==0)) { start++; weights++; }
2096  while((start<end) && (weights[end-start]==0)) { end--; }
2097  rO_Align(place,bitplace);
2098  ord_struct.ord_typ=ro_wp;
2099  ord_struct.data.wp.start=start;
2100  ord_struct.data.wp.end=end;
2101  ord_struct.data.wp.place=place;
2102  ord_struct.data.wp.weights=weights;
2103  o[place]=-1;
2104  place++;
2105  rO_Align(place,bitplace);
2106  int i;
2107  for(i=start;i<=end;i++)
2108  {
2109    if(weights[i-start]<0)
2110    {
2111      ord_struct.ord_typ=ro_wp_neg;
2112      break;
2113    }
2114  }
2115}
2116
2117static void rO_LexVars(int &place, int &bitplace, int start, int end,
2118  int &prev_ord, long *o,int *v, int bits, int opt_var)
2119{
2120  // a block of variables v_start..v_end with lex order, ordsgn 1
2121  int k;
2122  int incr=1;
2123  if(prev_ord==-1) rO_Align(place,bitplace);
2124
2125  if (start>end)
2126  {
2127    incr=-1;
2128  }
2129  for(k=start;;k+=incr)
2130  {
2131    bitplace-=bits;
2132    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2133    o[place]=1;
2134    v[k]= place | (bitplace << 24);
2135    if (k==end) break;
2136  }
2137  prev_ord=1;
2138  if (opt_var!= -1)
2139  {
2140    assume((opt_var == end+1) ||(opt_var == end-1));
2141    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
2142    int save_bitplace=bitplace;
2143    bitplace-=bits;
2144    if (bitplace < 0)
2145    {
2146      bitplace=save_bitplace;
2147      return;
2148    }
2149    // there is enough space for the optional var
2150    v[opt_var]=place | (bitplace << 24);
2151  }
2152}
2153
2154static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2155  int &prev_ord, long *o,int *v, int bits, int opt_var)
2156{
2157  // a block of variables v_start..v_end with lex order, ordsgn -1
2158  int k;
2159  int incr=1;
2160  if(prev_ord==1) rO_Align(place,bitplace);
2161
2162  if (start>end)
2163  {
2164    incr=-1;
2165  }
2166  for(k=start;;k+=incr)
2167  {
2168    bitplace-=bits;
2169    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2170    o[place]=-1;
2171    v[k]=place | (bitplace << 24);
2172    if (k==end) break;
2173  }
2174  prev_ord=-1;
2175//  #if 0
2176  if (opt_var!= -1)
2177  {
2178    assume((opt_var == end+1) ||(opt_var == end-1));
2179    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
2180    int save_bitplace=bitplace;
2181    bitplace-=bits;
2182    if (bitplace < 0)
2183    {
2184      bitplace=save_bitplace;
2185      return;
2186    }
2187    // there is enough space for the optional var
2188    v[opt_var]=place | (bitplace << 24);
2189  }
2190//  #endif
2191}
2192
2193static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2194    long *o, sro_ord &ord_struct)
2195{
2196  // ordering is derived from component number
2197  rO_Align(place,bitplace);
2198  ord_struct.ord_typ=ro_syzcomp;
2199  ord_struct.data.syzcomp.place=place;
2200  ord_struct.data.syzcomp.Components=NULL;
2201  ord_struct.data.syzcomp.ShiftedComponents=NULL;
2202  o[place]=1;
2203  prev_ord=1;
2204  place++;
2205  rO_Align(place,bitplace);
2206}
2207
2208static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2209    long *o, sro_ord &ord_struct)
2210{
2211  // ordering is derived from component number
2212  // let's reserve one Exponent_t for it
2213  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
2214    rO_Align(place,bitplace);
2215  ord_struct.ord_typ=ro_syz;
2216  ord_struct.data.syz.place=place;
2217  ord_struct.data.syz.limit=0;
2218  ord_struct.data.syz.syz_index = NULL;
2219  ord_struct.data.syz.curr_index = 1;
2220  o[place]= -1;
2221  prev_ord=-1;
2222  place++;
2223}
2224
2225#ifndef NDEBUG
2226# define MYTEST 0
2227#else /* ifndef NDEBUG */
2228# define MYTEST 0
2229#endif /* ifndef NDEBUG */
2230
2231static void rO_ISPrefix(int &place, int &bitplace, int &prev_ord,
2232    long *o, int N, int *v, sro_ord &ord_struct)
2233{
2234  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
2235    rO_Align(place,bitplace);
2236  // since we add something afterwards - it's better to start with anew!?
2237
2238  ord_struct.ord_typ = ro_isTemp;
2239  ord_struct.data.isTemp.start = place;
2240  ord_struct.data.isTemp.pVarOffset = (int *)omMemDup(v);
2241  ord_struct.data.isTemp.suffixpos = -1;
2242
2243  // We will act as rO_Syz on our own!!!
2244  // Here we allocate an exponent as a level placeholder
2245  o[place]= -1;
2246  prev_ord=-1;
2247  place++;
2248}
2249static void rO_ISSuffix(int &place, int &bitplace, int &prev_ord, long *o,
2250  int N, int *v, sro_ord *tmp_typ, int &typ_i, int sgn)
2251{
2252
2253  // Let's find previous prefix:
2254  int typ_j = typ_i - 1;
2255  while(typ_j >= 0)
2256  {
2257    if( tmp_typ[typ_j].ord_typ == ro_isTemp)
2258      break;
2259    typ_j --;
2260  }
2261
2262  assume( typ_j >= 0 );
2263
2264  if( typ_j < 0 ) // Found NO prefix!!! :(
2265    return;
2266
2267  assume( tmp_typ[typ_j].ord_typ == ro_isTemp );
2268
2269  // Get saved state:
2270  const int start = tmp_typ[typ_j].data.isTemp.start;
2271  int *pVarOffset = tmp_typ[typ_j].data.isTemp.pVarOffset;
2272
2273/*
2274  // shift up all blocks
2275  while(typ_j < (typ_i-1))
2276  {
2277    tmp_typ[typ_j] = tmp_typ[typ_j+1];
2278    typ_j++;
2279  }
2280  typ_j = typ_i - 1; // No increment for typ_i
2281*/
2282  tmp_typ[typ_j].data.isTemp.suffixpos = typ_i;
2283
2284  // Let's keep that dummy for now...
2285  typ_j = typ_i; // the typ to change!
2286  typ_i++; // Just for now...
2287
2288
2289  for( int i = 0; i <= N; i++ ) // Note [0] == component !!! No Skip?
2290  {
2291    // Was i-th variable allocated inbetween?
2292    if( v[i] != pVarOffset[i] )
2293    {
2294      pVarOffset[i] = v[i]; // Save for later...
2295      v[i] = -1; // Undo!
2296      assume( pVarOffset[i] != -1 );
2297    }
2298    else
2299      pVarOffset[i] = -1; // No change here...
2300  }
2301
2302  if( pVarOffset[0] != -1 )
2303    pVarOffset[0] &= 0x0fff;
2304
2305  sro_ord &ord_struct = tmp_typ[typ_j];
2306
2307
2308  ord_struct.ord_typ = ro_is;
2309  ord_struct.data.is.start = start;
2310  ord_struct.data.is.end   = place;
2311  ord_struct.data.is.pVarOffset = pVarOffset;
2312
2313
2314  // What about component???
2315//   if( v[0] != -1 ) // There is a component already...???
2316//     if( o[ v[0] & 0x0fff ] == sgn )
2317//     {
2318//       pVarOffset[0] = -1; // NEVER USED Afterwards...
2319//       return;
2320//     }
2321
2322
2323  // Moreover: we need to allocate the module component (v[0]) here!
2324  if( v[0] == -1) // It's possible that there was module component v0 at the begining (before prefix)!
2325  {
2326    // Start with a whole long exponent
2327    if( bitplace != BITS_PER_LONG )
2328      rO_Align(place, bitplace);
2329
2330    assume( bitplace == BITS_PER_LONG );
2331    bitplace -= BITS_PER_LONG;
2332    assume(bitplace == 0);
2333    v[0] = place | (bitplace << 24); // Never mind whether pVarOffset[0] > 0!!!
2334    o[place] = sgn; // Singnum for component ordering
2335    prev_ord = sgn;
2336  }
2337}
2338
2339
2340static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
2341{
2342  if (bitmask == 0)
2343  {
2344    bits=16; bitmask=0xffff;
2345  }
2346  else if (bitmask <= 1L)
2347  {
2348    bits=1; bitmask = 1L;
2349  }
2350  else if (bitmask <= 3L)
2351  {
2352    bits=2; bitmask = 3L;
2353  }
2354  else if (bitmask <= 7L)
2355  {
2356    bits=3; bitmask=7L;
2357  }
2358  else if (bitmask <= 0xfL)
2359  {
2360    bits=4; bitmask=0xfL;
2361  }
2362  else if (bitmask <= 0x1fL)
2363  {
2364    bits=5; bitmask=0x1fL;
2365  }
2366  else if (bitmask <= 0x3fL)
2367  {
2368    bits=6; bitmask=0x3fL;
2369  }
2370#if SIZEOF_LONG == 8
2371  else if (bitmask <= 0x7fL)
2372  {
2373    bits=7; bitmask=0x7fL; /* 64 bit longs only */
2374  }
2375#endif
2376  else if (bitmask <= 0xffL)
2377  {
2378    bits=8; bitmask=0xffL;
2379  }
2380#if SIZEOF_LONG == 8
2381  else if (bitmask <= 0x1ffL)
2382  {
2383    bits=9; bitmask=0x1ffL; /* 64 bit longs only */
2384  }
2385#endif
2386  else if (bitmask <= 0x3ffL)
2387  {
2388    bits=10; bitmask=0x3ffL;
2389  }
2390#if SIZEOF_LONG == 8
2391  else if (bitmask <= 0xfffL)
2392  {
2393    bits=12; bitmask=0xfff; /* 64 bit longs only */
2394  }
2395#endif
2396  else if (bitmask <= 0xffffL)
2397  {
2398    bits=16; bitmask=0xffffL;
2399  }
2400#if SIZEOF_LONG == 8
2401  else if (bitmask <= 0xfffffL)
2402  {
2403    bits=20; bitmask=0xfffffL; /* 64 bit longs only */
2404  }
2405  else if (bitmask <= 0xffffffffL)
2406  {
2407    bits=32; bitmask=0xffffffffL;
2408  }
2409  else if (bitmask <= 0x7fffffffffffffffL)
2410  {
2411    bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2412  }
2413  else
2414  {
2415    bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2416  }
2417#else
2418  else if (bitmask <= 0x7fffffff)
2419  {
2420    bits=31; bitmask=0x7fffffff; /* for overflow tests*/
2421  }
2422  else
2423  {
2424    bits=31; bitmask=0x7fffffffL; /* for overflow tests*/
2425  }
2426#endif
2427  return bitmask;
2428}
2429
2430/*2
2431* optimize rGetExpSize for a block of N variables, exp <=bitmask
2432*/
2433static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
2434{
2435  bitmask =rGetExpSize(bitmask, bits);
2436  int vars_per_long=BIT_SIZEOF_LONG/bits;
2437  int bits1;
2438  loop
2439  {
2440    if (bits == BIT_SIZEOF_LONG-1)
2441    {
2442      bits =  BIT_SIZEOF_LONG - 1;
2443      return LONG_MAX;
2444    }
2445    unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
2446    int vars_per_long1=BIT_SIZEOF_LONG/bits1;
2447    if ((((N+vars_per_long-1)/vars_per_long) ==
2448         ((N+vars_per_long1-1)/vars_per_long1)))
2449    {
2450      vars_per_long=vars_per_long1;
2451      bits=bits1;
2452      bitmask=bitmask1;
2453    }
2454    else
2455    {
2456      return bitmask; /* and bits */
2457    }
2458  }
2459}
2460
2461
2462/*2
2463 * create a copy of the ring r, which must be equivalent to currRing
2464 * used for std computations
2465 * may share data structures with currRing
2466 * DOES CALL rComplete
2467 */
2468ring rModifyRing(ring r, BOOLEAN omit_degree,
2469                         BOOLEAN omit_comp,
2470                         unsigned long exp_limit)
2471{
2472  assume (r != NULL );
2473  assume (exp_limit > 1);
2474  BOOLEAN need_other_ring;
2475  BOOLEAN omitted_degree = FALSE;
2476
2477  int iNeedInducedOrderingSetup = 0; ///< How many induced ordering block do we have?
2478  int bits;
2479
2480  exp_limit=rGetExpSize(exp_limit, bits, r->N);
2481  need_other_ring = (exp_limit != r->bitmask);
2482
2483  int nblocks=rBlocks(r);
2484  int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2485  int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2486  int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2487  int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int *));
2488
2489  int i=0;
2490  int j=0; /*  i index in r, j index in res */
2491
2492  for( int r_ord=r->order[i]; (r_ord != 0) && (i < nblocks); j++, r_ord=r->order[++i])
2493  {
2494    BOOLEAN copy_block_index=TRUE;
2495
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:
2504          r_ord=ringorder_lp;
2505          break;
2506        case ringorder_Ws:
2507        case ringorder_Ds:
2508        case ringorder_ws:
2509        case ringorder_ds:
2510          r_ord=ringorder_ls;
2511          break;
2512        default:
2513          break;
2514      }
2515    }
2516    switch(r_ord)
2517    {
2518      case ringorder_S:
2519      {
2520#ifndef NDEBUG
2521        Warn("Error: unhandled ordering in rModifyRing: ringorder_S = [%d]", r_ord);
2522#endif
2523        order[j]=r_ord; /*r->order[i];*/
2524        break;
2525      }
2526      case ringorder_C:
2527      case ringorder_c:
2528        if (!omit_comp)
2529        {
2530          order[j]=r_ord; /*r->order[i]*/;
2531        }
2532        else
2533        {
2534          j--;
2535          need_other_ring=TRUE;
2536          omit_comp=FALSE;
2537          copy_block_index=FALSE;
2538        }
2539        break;
2540      case ringorder_wp:
2541      case ringorder_dp:
2542      case ringorder_ws:
2543      case ringorder_ds:
2544        if(!omit_degree)
2545        {
2546          order[j]=r_ord; /*r->order[i]*/;
2547        }
2548        else
2549        {
2550          order[j]=ringorder_rs;
2551          need_other_ring=TRUE;
2552          omit_degree=FALSE;
2553          omitted_degree = TRUE;
2554        }
2555        break;
2556      case ringorder_Wp:
2557      case ringorder_Dp:
2558      case ringorder_Ws:
2559      case ringorder_Ds:
2560        if(!omit_degree)
2561        {
2562          order[j]=r_ord; /*r->order[i];*/
2563        }
2564        else
2565        {
2566          order[j]=ringorder_lp;
2567          need_other_ring=TRUE;
2568          omit_degree=FALSE;
2569          omitted_degree = TRUE;
2570        }
2571        break;
2572      case ringorder_IS:
2573      {
2574        if (omit_comp)
2575        {
2576#ifndef NDEBUG
2577          Warn("Error: WRONG USAGE of rModifyRing: cannot omit component due to the ordering block [%d]: %d (ringorder_IS)", i, r_ord);
2578#endif
2579          omit_comp = FALSE;
2580        }
2581        order[j]=r_ord; /*r->order[i];*/
2582        iNeedInducedOrderingSetup++;
2583        break;
2584      }
2585      case ringorder_s:
2586      {
2587        assume((i == 0) && (j == 0));
2588        if (omit_comp)
2589        {
2590#ifndef NDEBUG
2591          Warn("WRONG USAGE? of rModifyRing: omitting component due to the ordering block [%d]: %d (ringorder_s)", i, r_ord);
2592#endif
2593          omit_comp = FALSE;
2594        }
2595        order[j]=r_ord; /*r->order[i];*/
2596        break;
2597      }
2598      default:
2599        order[j]=r_ord; /*r->order[i];*/
2600        break;
2601    }
2602    if (copy_block_index)
2603    {
2604      block0[j]=r->block0[i];
2605      block1[j]=r->block1[i];
2606      wvhdl[j]=r->wvhdl[i];
2607    }
2608
2609    // order[j]=ringorder_no; //  done by omAlloc0
2610  }
2611  if(!need_other_ring)
2612  {
2613    omFreeSize(order,(nblocks+1)*sizeof(int));
2614    omFreeSize(block0,(nblocks+1)*sizeof(int));
2615    omFreeSize(block1,(nblocks+1)*sizeof(int));
2616    omFreeSize(wvhdl,(nblocks+1)*sizeof(int *));
2617    return r;
2618  }
2619  ring res=(ring)omAlloc0Bin(sip_sring_bin);
2620  *res = *r;
2621
2622#ifdef HAVE_PLURAL
2623  res->GetNC() = NULL;
2624#endif
2625
2626  // res->qideal, res->idroot ???
2627  res->wvhdl=wvhdl;
2628  res->order=order;
2629  res->block0=block0;
2630  res->block1=block1;
2631  res->bitmask=exp_limit;
2632  int tmpref=r->cf->ref;
2633  rComplete(res, 1);
2634  r->cf->ref=tmpref;
2635
2636  // adjust res->pFDeg: if it was changed globally, then
2637  // it must also be changed for new ring
2638  if (r->pFDegOrig != res->pFDegOrig &&
2639           rOrd_is_WeightedDegree_Ordering(r))
2640  {
2641    // still might need adjustment for weighted orderings
2642    // and omit_degree
2643    res->firstwv = r->firstwv;
2644    res->firstBlockEnds = r->firstBlockEnds;
2645    res->pFDeg = res->pFDegOrig = p_WFirstTotalDegree;
2646  }
2647  if (omitted_degree)
2648    res->pLDeg = res->pLDegOrig = r->pLDegOrig;
2649
2650  rOptimizeLDeg(res);
2651
2652  // set syzcomp
2653  if (res->typ != NULL)
2654  {
2655    if( res->typ[0].ord_typ == ro_syz) // "s" Always on [0] place!
2656    {
2657      res->typ[0] = r->typ[0]; // Copy struct!? + setup the same limit!
2658
2659      if (r->typ[0].data.syz.limit > 0)
2660      {
2661        res->typ[0].data.syz.syz_index
2662          = (int*) omAlloc((r->typ[0].data.syz.limit +1)*sizeof(int));
2663        memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2664              (r->typ[0].data.syz.limit +1)*sizeof(int));
2665      }
2666    }
2667
2668    if( iNeedInducedOrderingSetup > 0 )
2669    {
2670      for(j = 0, i = 0; (i < nblocks) && (iNeedInducedOrderingSetup > 0); i++)
2671        if( res->typ[i].ord_typ == ro_is ) // Search for suffixes!
2672        {
2673          ideal F = idrHeadR(r->typ[i].data.is.F, r, res); // Copy F from r into res!
2674          assume(
2675            rSetISReference( res,
2676              F,  // WILL BE COPIED!
2677              r->typ[i].data.is.limit,
2678              j++,
2679              r->typ[i].data.is.componentWeights // WILL BE COPIED
2680              )
2681            );
2682          id_Delete(&F, res);
2683          iNeedInducedOrderingSetup--;
2684        }
2685    } // Process all induced Ordering blocks! ...
2686  }
2687  // the special case: homog (omit_degree) and 1 block rs: that is global:
2688  // it comes from dp
2689  res->OrdSgn=r->OrdSgn;
2690
2691
2692#ifdef HAVE_PLURAL
2693  if (rIsPluralRing(r))
2694  {
2695    if ( nc_rComplete(r, res, false) ) // no qideal!
2696    {
2697#ifndef NDEBUG
2698      WarnS("error in nc_rComplete");
2699#endif
2700      // cleanup?
2701
2702//      rDelete(res);
2703//      return r;
2704
2705      // just go on..
2706    }
2707
2708    if( rIsSCA(r) )
2709    {
2710      if( !sca_Force(res, scaFirstAltVar(r), scaLastAltVar(r)) )
2711      WarnS("error in sca_Force!");
2712    }
2713  }
2714#endif
2715
2716  return res;
2717}
2718
2719// construct Wp,C ring
2720ring rModifyRing_Wp(ring r, int* weights)
2721{
2722  ring res=(ring)omAlloc0Bin(sip_sring_bin);
2723  *res = *r;
2724#ifdef HAVE_PLURAL
2725  res->GetNC() = NULL;
2726#endif
2727
2728  /*weights: entries for 3 blocks: NULL*/
2729  res->wvhdl = (int **)omAlloc0(3 * sizeof(int *));
2730  /*order: Wp,C,0*/
2731  res->order = (int *) omAlloc(3 * sizeof(int *));
2732  res->block0 = (int *)omAlloc0(3 * sizeof(int *));
2733  res->block1 = (int *)omAlloc0(3 * sizeof(int *));
2734  /* ringorder Wp for the first block: var 1..r->N */
2735  res->order[0]  = ringorder_Wp;
2736  res->block0[0] = 1;
2737  res->block1[0] = r->N;
2738  res->wvhdl[0] = weights;
2739  /* ringorder C for the second block: no vars */
2740  res->order[1]  = ringorder_C;
2741  /* the last block: everything is 0 */
2742  res->order[2]  = 0;
2743  /*polynomial ring*/
2744  res->OrdSgn    = 1;
2745
2746  int tmpref=r->cf->ref;
2747  rComplete(res, 1);
2748  r->cf->ref=tmpref;
2749#ifdef HAVE_PLURAL
2750  if (rIsPluralRing(r))
2751  {
2752    if ( nc_rComplete(r, res, false) ) // no qideal!
2753    {
2754#ifndef NDEBUG
2755      WarnS("error in nc_rComplete");
2756#endif
2757      // cleanup?
2758
2759//      rDelete(res);
2760//      return r;
2761
2762      // just go on..
2763    }
2764  }
2765#endif
2766  return res;
2767}
2768
2769// construct lp, C ring with r->N variables, r->names vars....
2770ring rModifyRing_Simple(ring r, BOOLEAN ommit_degree, BOOLEAN ommit_comp, unsigned long exp_limit, BOOLEAN &simple)
2771{
2772  simple=TRUE;
2773  if (!rHasSimpleOrder(r))
2774  {
2775    simple=FALSE; // sorting needed
2776    assume (r != NULL );
2777    assume (exp_limit > 1);
2778    int bits;
2779
2780    exp_limit=rGetExpSize(exp_limit, bits, r->N);
2781
2782    int nblocks=1+(ommit_comp!=0);
2783    int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2784    int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2785    int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2786    int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int *));
2787
2788    order[0]=ringorder_lp;
2789    block0[0]=1;
2790    block1[0]=r->N;
2791    if (!ommit_comp)
2792    {
2793      order[1]=ringorder_C;
2794    }
2795    ring res=(ring)omAlloc0Bin(sip_sring_bin);
2796    *res = *r;
2797#ifdef HAVE_PLURAL
2798    res->GetNC() = NULL;
2799#endif
2800    // res->qideal, res->idroot ???
2801    res->wvhdl=wvhdl;
2802    res->order=order;
2803    res->block0=block0;
2804    res->block1=block1;
2805    res->bitmask=exp_limit;
2806    int tmpref=r->cf->ref;
2807    rComplete(res, 1);
2808    r->cf->ref=tmpref;
2809
2810#ifdef HAVE_PLURAL
2811    if (rIsPluralRing(r))
2812    {
2813      if ( nc_rComplete(r, res, false) ) // no qideal!
2814      {
2815#ifndef NDEBUG
2816        WarnS("error in nc_rComplete");
2817#endif
2818        // cleanup?
2819
2820//      rDelete(res);
2821//      return r;
2822
2823      // just go on..
2824      }
2825    }
2826#endif
2827
2828    rOptimizeLDeg(res);
2829
2830    return res;
2831  }
2832  return rModifyRing(r, ommit_degree, ommit_comp, exp_limit);
2833}
2834
2835void rKillModifiedRing_Simple(ring r)
2836{
2837  rKillModifiedRing(r);
2838}
2839
2840
2841void rKillModifiedRing(ring r)
2842{
2843  rUnComplete(r);
2844  omFree(r->order);
2845  omFree(r->block0);
2846  omFree(r->block1);
2847  omFree(r->wvhdl);
2848  omFreeBin(r,sip_sring_bin);
2849}
2850
2851void rKillModified_Wp_Ring(ring r)
2852{
2853  rUnComplete(r);
2854  omFree(r->order);
2855  omFree(r->block0);
2856  omFree(r->block1);
2857  omFree(r->wvhdl[0]);
2858  omFree(r->wvhdl);
2859  omFreeBin(r,sip_sring_bin);
2860}
2861
2862static void rSetOutParams(ring r)
2863{
2864  r->VectorOut = (r->order[0] == ringorder_c);
2865  r->ShortOut = TRUE;
2866  {
2867    int i;
2868    if (r->cf->parameter!=NULL)
2869    {
2870      for (i=0;i<rPar(r);i++)
2871      {
2872        if(strlen(r->cf->parameter[i])>1)
2873        {
2874          r->ShortOut=FALSE;
2875          break;
2876        }
2877      }
2878    }
2879    if (r->ShortOut)
2880    {
2881      // Hmm... sometimes (e.g., from maGetPreimage) new variables
2882      // are introduced, but their names are never set
2883      // hence, we do the following awkward trick
2884      int N = omSizeWOfAddr(r->names);
2885      if (r->N < N) N = r->N;
2886
2887      for (i=(N-1);i>=0;i--)
2888      {
2889        if(r->names[i] != NULL && strlen(r->names[i])>1)
2890        {
2891          r->ShortOut=FALSE;
2892          break;
2893        }
2894      }
2895    }
2896  }
2897  r->CanShortOut = r->ShortOut;
2898}
2899
2900/*2
2901* sets r->MixedOrder and r->ComponentOrder for orderings with more than one block
2902* block of variables (ip is the block number, o_r the number of the ordering)
2903* o is the position of the orderingering in r
2904*/
2905static void rHighSet(ring r, int o_r, int o)
2906{
2907  switch(o_r)
2908  {
2909    case ringorder_lp:
2910    case ringorder_dp:
2911    case ringorder_Dp:
2912    case ringorder_wp:
2913    case ringorder_Wp:
2914    case ringorder_rp:
2915    case ringorder_a:
2916    case ringorder_aa:
2917    case ringorder_a64:
2918      if (r->OrdSgn==-1) r->MixedOrder=TRUE;
2919      break;
2920    case ringorder_ls:
2921    case ringorder_rs:
2922    case ringorder_ds:
2923    case ringorder_Ds:
2924    case ringorder_s:
2925      break;
2926    case ringorder_ws:
2927    case ringorder_Ws:
2928      if (r->wvhdl[o]!=NULL)
2929      {
2930        int i;
2931        for(i=r->block1[o]-r->block0[o];i>=0;i--)
2932          if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
2933      }
2934      break;
2935    case ringorder_c:
2936      r->ComponentOrder=1;
2937      break;
2938    case ringorder_C:
2939    case ringorder_S:
2940      r->ComponentOrder=-1;
2941      break;
2942    case ringorder_M:
2943      r->LexOrder=TRUE;
2944      break;
2945    case ringorder_IS:
2946    { // TODO: What is r->ComponentOrder???
2947      r->MixedOrder=TRUE;
2948/*
2949      if( r->block0[o] != 0 ) // Suffix has the comonent
2950        r->ComponentOrder = r->block0[o];
2951      else // Prefix has level...
2952        r->ComponentOrder=-1;
2953*/
2954      break;
2955    }
2956
2957    default:
2958      dReportError("wrong internal ordering:%d at %s, l:%d\n",o_r,__FILE__,__LINE__);
2959  }
2960}
2961
2962static void rSetFirstWv(ring r, int i, int* order, int* block1, int** wvhdl)
2963{
2964  // cheat for ringorder_aa
2965  if (order[i] == ringorder_aa)
2966    i++;
2967  if(block1[i]!=r->N) r->LexOrder=TRUE;
2968  r->firstBlockEnds=block1[i];
2969  r->firstwv = wvhdl[i];
2970  if ((order[i]== ringorder_ws)
2971  || (order[i]==ringorder_Ws)
2972  || (order[i]== ringorder_wp)
2973  || (order[i]==ringorder_Wp)
2974  || (order[i]== ringorder_a)
2975   /*|| (order[i]==ringorder_A)*/)
2976  {
2977    int j;
2978    for(j=block1[i]-r->block0[i];j>=0;j--)
2979    {
2980      if (r->firstwv[j]<0) r->MixedOrder=TRUE;
2981      if (r->firstwv[j]==0) r->LexOrder=TRUE;
2982    }
2983  }
2984  else if (order[i]==ringorder_a64)
2985  {
2986    int j;
2987    int64 *w=rGetWeightVec(r);
2988    for(j=block1[i]-r->block0[i];j>=0;j--)
2989    {
2990      if (w[j]==0) r->LexOrder=TRUE;
2991    }
2992  }
2993}
2994
2995static void rOptimizeLDeg(ring r)
2996{
2997  if (r->pFDeg == p_Deg)
2998  {
2999    if (r->pLDeg == pLDeg1)
3000      r->pLDeg = pLDeg1_Deg;
3001    if (r->pLDeg == pLDeg1c)
3002      r->pLDeg = pLDeg1c_Deg;
3003  }
3004  else if (r->pFDeg == p_Totaldegree)
3005  {
3006    if (r->pLDeg == pLDeg1)
3007      r->pLDeg = pLDeg1_Totaldegree;
3008    if (r->pLDeg == pLDeg1c)
3009      r->pLDeg = pLDeg1c_Totaldegree;
3010  }
3011  else if (r->pFDeg == p_WFirstTotalDegree)
3012  {
3013    if (r->pLDeg == pLDeg1)
3014      r->pLDeg = pLDeg1_WFirstTotalDegree;
3015    if (r->pLDeg == pLDeg1c)
3016      r->pLDeg = pLDeg1c_WFirstTotalDegree;
3017  }
3018}
3019
3020// set pFDeg, pLDeg, MixOrder, ComponentOrder, etc
3021static void rSetDegStuff(ring r)
3022{
3023  int* order = r->order;
3024  int* block0 = r->block0;
3025  int* block1 = r->block1;
3026  int** wvhdl = r->wvhdl;
3027
3028  if (order[0]==ringorder_S ||order[0]==ringorder_s || order[0]==ringorder_IS)
3029  {
3030    order++;
3031    block0++;
3032    block1++;
3033    wvhdl++;
3034  }
3035  r->LexOrder = FALSE;
3036  r->MixedOrder = FALSE;
3037  r->ComponentOrder = 1;
3038  r->pFDeg = p_Totaldegree;
3039  r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
3040
3041  /*======== ordering type is (_,c) =========================*/
3042  if ((order[0]==ringorder_unspec) || (order[1] == 0)
3043      ||(
3044    ((order[1]==ringorder_c)||(order[1]==ringorder_C)
3045     ||(order[1]==ringorder_S)
3046     ||(order[1]==ringorder_s))
3047    && (order[0]!=ringorder_M)
3048    && (order[2]==0))
3049    )
3050  {
3051    if ((order[0]!=ringorder_unspec)
3052    && ((order[1]==ringorder_C)||(order[1]==ringorder_S)||
3053        (order[1]==ringorder_s)))
3054      r->ComponentOrder=-1;
3055    if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
3056    if ((order[0] == ringorder_lp)
3057    || (order[0] == ringorder_ls)
3058    || (order[0] == ringorder_rp)
3059    || (order[0] == ringorder_rs))
3060    {
3061      r->LexOrder=TRUE;
3062      r->pLDeg = pLDeg1c;
3063      r->pFDeg = p_Totaldegree;
3064    }
3065    if ((order[0] == ringorder_a)
3066    || (order[0] == ringorder_wp)
3067    || (order[0] == ringorder_Wp)
3068    || (order[0] == ringorder_ws)
3069    || (order[0] == ringorder_Ws))
3070      r->pFDeg = p_WFirstTotalDegree;
3071    r->firstBlockEnds=block1[0];
3072    r->firstwv = wvhdl[0];
3073  }
3074  /*======== ordering type is (c,_) =========================*/
3075  else if (((order[0]==ringorder_c)
3076            ||(order[0]==ringorder_C)
3077            ||(order[0]==ringorder_S)
3078            ||(order[0]==ringorder_s))
3079  && (order[1]!=ringorder_M)
3080  &&  (order[2]==0))
3081  {
3082    if ((order[0]==ringorder_C)||(order[0]==ringorder_S)||
3083        order[0]==ringorder_s)
3084      r->ComponentOrder=-1;
3085    if ((order[1] == ringorder_lp)
3086    || (order[1] == ringorder_ls)
3087    || (order[1] == ringorder_rp)
3088    || order[1] == ringorder_rs)
3089    {
3090      r->LexOrder=TRUE;
3091      r->pLDeg = pLDeg1c;
3092      r->pFDeg = p_Totaldegree;
3093    }
3094    r->firstBlockEnds=block1[1];
3095    if (wvhdl!=NULL) r->firstwv = wvhdl[1];
3096    if ((order[1] == ringorder_a)
3097    || (order[1] == ringorder_wp)
3098    || (order[1] == ringorder_Wp)
3099    || (order[1] == ringorder_ws)
3100    || (order[1] == ringorder_Ws))
3101      r->pFDeg = p_WFirstTotalDegree;
3102  }
3103  /*------- more than one block ----------------------*/
3104  else
3105  {
3106    if ((r->VectorOut)||(order[0]==ringorder_C)||(order[0]==ringorder_S)||(order[0]==ringorder_s))
3107    {
3108      rSetFirstWv(r, 1, order, block1, wvhdl);
3109    }
3110    else
3111      rSetFirstWv(r, 0, order, block1, wvhdl);
3112
3113    /*the number of orderings:*/
3114    int i = 0;
3115    while (order[++i] != 0);
3116    do
3117    {
3118      i--;
3119      rHighSet(r, order[i],i);
3120    }
3121    while (i != 0);
3122
3123    if ((order[0]!=ringorder_c)
3124        && (order[0]!=ringorder_C)
3125        && (order[0]!=ringorder_S)
3126        && (order[0]!=ringorder_s))
3127    {
3128      r->pLDeg = pLDeg1c;
3129    }
3130    else
3131    {
3132      r->pLDeg = pLDeg1;
3133    }
3134    r->pFDeg = p_WTotaldegree; // may be improved: p_Totaldegree for lp/dp/ls/.. blocks
3135  }
3136
3137  if (rOrd_is_Totaldegree_Ordering(r) || rOrd_is_WeightedDegree_Ordering(r))
3138    r->pFDeg = p_Deg;
3139
3140  r->pFDegOrig = r->pFDeg;
3141  r->pLDegOrig = r->pLDeg;
3142  rOptimizeLDeg(r);
3143}
3144
3145/*2
3146* set NegWeightL_Size, NegWeightL_Offset
3147*/
3148static void rSetNegWeight(ring r)
3149{
3150  int i,l;
3151  if (r->typ!=NULL)
3152  {
3153    l=0;
3154    for(i=0;i<r->OrdSize;i++)
3155    {
3156      if(r->typ[i].ord_typ==ro_wp_neg) l++;
3157    }
3158    if (l>0)
3159    {
3160      r->NegWeightL_Size=l;
3161      r->NegWeightL_Offset=(int *) omAlloc(l*sizeof(int));
3162      l=0;
3163      for(i=0;i<r->OrdSize;i++)
3164      {
3165        if(r->typ[i].ord_typ==ro_wp_neg)
3166        {
3167          r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
3168          l++;
3169        }
3170      }
3171      return;
3172    }
3173  }
3174  r->NegWeightL_Size = 0;
3175  r->NegWeightL_Offset = NULL;
3176}
3177
3178static void rSetOption(ring r)
3179{
3180  // set redthrough
3181  if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
3182    r->options |= Sy_bit(OPT_REDTHROUGH);
3183  else
3184    r->options &= ~Sy_bit(OPT_REDTHROUGH);
3185
3186  // set intStrategy
3187#ifdef HAVE_RINGS
3188  if (
3189         rField_is_Extension(r)
3190      || rField_is_Q(r)
3191      || rField_is_Ring(r))
3192#else
3193  if (rField_is_Extension(r) || rField_is_Q(r))
3194#endif
3195    r->options |= Sy_bit(OPT_INTSTRATEGY);
3196  else
3197    r->options &= ~Sy_bit(OPT_INTSTRATEGY);
3198
3199  // set redTail
3200  if (r->LexOrder || r->OrdSgn == -1 || rField_is_Extension(r))
3201    r->options &= ~Sy_bit(OPT_REDTAIL);
3202  else
3203    r->options |= Sy_bit(OPT_REDTAIL);
3204}
3205
3206static void rCheckOrdSgn(ring r,int i/*current block*/);
3207
3208BOOLEAN rComplete(ring r, int force)
3209{
3210  if (r->VarOffset!=NULL && force == 0) return FALSE;
3211  rSetOutParams(r);
3212  int n=rBlocks(r)-1;
3213  int i;
3214  int bits;
3215  r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
3216  r->BitsPerExp = bits;
3217  r->ExpPerLong = BIT_SIZEOF_LONG / bits;
3218  r->divmask=rGetDivMask(bits);
3219
3220  // will be used for ordsgn:
3221  long *tmp_ordsgn=(long *)omAlloc0(3*(n+r->N)*sizeof(long));
3222  // will be used for VarOffset:
3223  int *v=(int *)omAlloc((r->N+1)*sizeof(int));
3224  for(i=r->N; i>=0 ; i--)
3225  {
3226    v[i]=-1;
3227  }
3228  sro_ord *tmp_typ=(sro_ord *)omAlloc0(3*(n+r->N)*sizeof(sro_ord));
3229  int typ_i=0;
3230  int prev_ordsgn=0;
3231
3232  // fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
3233  int j=0;
3234  int j_bits=BITS_PER_LONG;
3235
3236  BOOLEAN need_to_add_comp=FALSE; // Only for ringorder_s and ringorder_S!
3237
3238  for(i=0;i<n;i++)
3239  {
3240    tmp_typ[typ_i].order_index=i;
3241    switch (r->order[i])
3242    {
3243      case ringorder_a:
3244      case ringorder_aa:
3245        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3246                   r->wvhdl[i]);
3247        typ_i++;
3248        break;
3249
3250      case ringorder_a64:
3251        rO_WDegree64(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3252                     tmp_typ[typ_i], (int64 *)(r->wvhdl[i]));
3253        typ_i++;
3254        break;
3255
3256      case ringorder_c:
3257        rO_Align(j, j_bits);
3258        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3259        break;
3260
3261      case ringorder_C:
3262        rO_Align(j, j_bits);
3263        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3264        break;
3265
3266      case ringorder_M:
3267        {
3268          int k,l;
3269          k=r->block1[i]-r->block0[i]+1; // number of vars
3270          for(l=0;l<k;l++)
3271          {
3272            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3273                       tmp_typ[typ_i],
3274                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
3275            typ_i++;
3276          }
3277          break;
3278        }
3279
3280      case ringorder_lp:
3281        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3282                   tmp_ordsgn,v,bits, -1);
3283        break;
3284
3285      case ringorder_ls:
3286        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3287                       tmp_ordsgn,v, bits, -1);
3288        rCheckOrdSgn(r,i);
3289        break;
3290
3291      case ringorder_rs:
3292        rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3293                       tmp_ordsgn,v, bits, -1);
3294        rCheckOrdSgn(r,i);
3295        break;
3296
3297      case ringorder_rp:
3298        rO_LexVars(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3299                       tmp_ordsgn,v, bits, -1);
3300        break;
3301
3302      case ringorder_dp:
3303        if (r->block0[i]==r->block1[i])
3304        {
3305          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3306                     tmp_ordsgn,v, bits, -1);
3307        }
3308        else
3309        {
3310          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3311                     tmp_typ[typ_i]);
3312          typ_i++;
3313          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3314                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3315        }
3316        break;
3317
3318      case ringorder_Dp:
3319        if (r->block0[i]==r->block1[i])
3320        {
3321          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3322                     tmp_ordsgn,v, bits, -1);
3323        }
3324        else
3325        {
3326          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3327                     tmp_typ[typ_i]);
3328          typ_i++;
3329          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3330                     tmp_ordsgn,v, bits, r->block1[i]);
3331        }
3332        break;
3333
3334      case ringorder_ds:
3335        if (r->block0[i]==r->block1[i])
3336        {
3337          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
3338                         tmp_ordsgn,v,bits, -1);
3339        }
3340        else
3341        {
3342          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3343                         tmp_typ[typ_i]);
3344          typ_i++;
3345          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3346                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3347        }
3348        rCheckOrdSgn(r,i);
3349        break;
3350
3351      case ringorder_Ds:
3352        if (r->block0[i]==r->block1[i])
3353        {
3354          rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
3355                         tmp_ordsgn,v, bits, -1);
3356        }
3357        else
3358        {
3359          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3360                         tmp_typ[typ_i]);
3361          typ_i++;
3362          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3363                     tmp_ordsgn,v, bits, r->block1[i]);
3364        }
3365        rCheckOrdSgn(r,i);
3366        break;
3367
3368      case ringorder_wp:
3369        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3370                   tmp_typ[typ_i], r->wvhdl[i]);
3371        typ_i++;
3372        { // check for weights <=0
3373          int jj;
3374          BOOLEAN have_bad_weights=FALSE;
3375          for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3376          {
3377            if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3378          }
3379          if (have_bad_weights)
3380          {
3381             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3382                                     tmp_typ[typ_i]);
3383             typ_i++;
3384             rCheckOrdSgn(r,i);
3385          }
3386        }
3387        if (r->block1[i]!=r->block0[i])
3388        {
3389          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3390                         tmp_ordsgn, v,bits, r->block0[i]);
3391        }
3392        break;
3393
3394      case ringorder_Wp:
3395        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3396                   tmp_typ[typ_i], r->wvhdl[i]);
3397        typ_i++;
3398        { // check for weights <=0
3399          int jj;
3400          BOOLEAN have_bad_weights=FALSE;
3401          for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3402          {
3403            if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3404          }
3405          if (have_bad_weights)
3406          {
3407             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3408                                     tmp_typ[typ_i]);
3409             typ_i++;
3410             rCheckOrdSgn(r,i);
3411          }
3412        }
3413        if (r->block1[i]!=r->block0[i])
3414        {
3415          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3416                     tmp_ordsgn,v, bits, r->block1[i]);
3417        }
3418        break;
3419
3420      case ringorder_ws:
3421        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3422                       tmp_typ[typ_i], r->wvhdl[i]);
3423        typ_i++;
3424        if (r->block1[i]!=r->block0[i])
3425        {
3426          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3427                         tmp_ordsgn, v,bits, r->block0[i]);
3428        }
3429        rCheckOrdSgn(r,i);
3430        break;
3431
3432      case ringorder_Ws:
3433        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3434                       tmp_typ[typ_i], r->wvhdl[i]);
3435        typ_i++;
3436        if (r->block1[i]!=r->block0[i])
3437        {
3438          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3439                     tmp_ordsgn,v, bits, r->block1[i]);
3440        }
3441        rCheckOrdSgn(r,i);
3442        break;
3443
3444      case ringorder_S:
3445        assume(typ_i == 1); // For LaScala3 only: on the 2nd place ([1])!
3446        // TODO: for K[x]: it is 0...?!
3447        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3448        need_to_add_comp=TRUE;
3449        typ_i++;
3450        break;
3451
3452      case ringorder_s:
3453        assume(typ_i == 0 && j == 0);
3454        rO_Syz(j, j_bits, prev_ordsgn, tmp_ordsgn, tmp_typ[typ_i]); // set syz-limit?
3455        need_to_add_comp=TRUE;
3456        typ_i++;
3457        break;
3458
3459      case ringorder_IS:
3460      {
3461
3462        assume( r->block0[i] == r->block1[i] );
3463        const int s = r->block0[i];
3464        assume( -2 < s && s < 2);
3465
3466        if(s == 0) // Prefix IS
3467          rO_ISPrefix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ[typ_i++]); // What about prev_ordsgn?
3468        else // s = +1 or -1 // Note: typ_i might be incrimented here inside!
3469        {
3470          rO_ISSuffix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ, typ_i, s); // Suffix.
3471          need_to_add_comp=FALSE;
3472        }
3473
3474        break;
3475      }
3476      case ringorder_unspec:
3477      case ringorder_no:
3478      default:
3479        dReportError("undef. ringorder used\n");
3480        break;
3481    }
3482  }
3483
3484  int j0=j; // save j
3485  int j_bits0=j_bits; // save jbits
3486  rO_Align(j,j_bits);
3487  r->CmpL_Size = j;
3488
3489  j_bits=j_bits0; j=j0;
3490
3491  // fill in some empty slots with variables not already covered
3492  // v0 is special, is therefore normally already covered
3493  // now we do have rings without comp...
3494  if((need_to_add_comp) && (v[0]== -1))
3495  {
3496    if (prev_ordsgn==1)
3497    {
3498      rO_Align(j, j_bits);
3499      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3500    }
3501    else
3502    {
3503      rO_Align(j, j_bits);
3504      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3505    }
3506  }
3507  // the variables
3508  for(i=1 ; i<=r->N ; i++)
3509  {
3510    if(v[i]==(-1))
3511    {
3512      if (prev_ordsgn==1)
3513      {
3514        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3515      }
3516      else
3517      {
3518        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3519      }
3520    }
3521  }
3522
3523  rO_Align(j,j_bits);
3524  // ----------------------------
3525  // finished with constructing the monomial, computing sizes:
3526
3527  r->ExpL_Size=j;
3528  r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
3529  assume(r->PolyBin != NULL);
3530
3531  // ----------------------------
3532  // indices and ordsgn vector for comparison
3533  //
3534  // r->pCompHighIndex already set
3535  r->ordsgn=(long *)omAlloc0(r->ExpL_Size*sizeof(long));
3536
3537  for(j=0;j<r->CmpL_Size;j++)
3538  {
3539    r->ordsgn[j] = tmp_ordsgn[j];
3540  }
3541
3542  omFreeSize((ADDRESS)tmp_ordsgn,(3*(n+r->N)*sizeof(long)));
3543
3544  // ----------------------------
3545  // description of orderings for setm:
3546  //
3547  r->OrdSize=typ_i;
3548  if (typ_i==0) r->typ=NULL;
3549  else
3550  {
3551    r->typ=(sro_ord*)omAlloc(typ_i*sizeof(sro_ord));
3552    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3553  }
3554  omFreeSize((ADDRESS)tmp_typ,(3*(n+r->N)*sizeof(sro_ord)));
3555
3556  // ----------------------------
3557  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3558  r->VarOffset=v;
3559
3560  // ----------------------------
3561  // other indicies
3562  r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
3563  i=0; // position
3564  j=0; // index in r->typ
3565  if (i==r->pCompIndex) i++; // IS???
3566  while ((j < r->OrdSize)
3567         && ((r->typ[j].ord_typ==ro_syzcomp) ||
3568             (r->typ[j].ord_typ==ro_syz) || (r->typ[j].ord_typ==ro_isTemp) || (r->typ[j].ord_typ==ro_is) ||
3569             (r->order[r->typ[j].order_index] == ringorder_aa)))
3570  {
3571    i++; j++;
3572  }
3573  // No use of j anymore!!!????
3574
3575  if (i==r->pCompIndex) i++;
3576  r->pOrdIndex=i; // How came it is "i" here???!!!! exp[r->pOrdIndex] is order of a poly... This may be wrong!!! IS
3577
3578  // ----------------------------
3579  rSetDegStuff(r);
3580  rSetOption(r);
3581  // ----------------------------
3582  // r->p_Setm
3583  r->p_Setm = p_GetSetmProc(r);
3584
3585  // ----------------------------
3586  // set VarL_*
3587  rSetVarL(r);
3588
3589  //  ----------------------------
3590  // right-adjust VarOffset
3591  rRightAdjustVarOffset(r);
3592
3593  // ----------------------------
3594  // set NegWeightL*
3595  rSetNegWeight(r);
3596
3597  // ----------------------------
3598  // p_Procs: call AFTER NegWeightL
3599  r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
3600  p_ProcsSet(r, r->p_Procs);
3601  return FALSE;
3602}
3603
3604static void rCheckOrdSgn(ring r,int i/*current block*/)
3605{ // set r->OrdSgn
3606  if ( r->OrdSgn==1)
3607  {
3608    int oo=-1;
3609    int jj;
3610    for(jj=i-1;jj>=0;jj--)
3611    {
3612      if(((r->order[jj]==ringorder_a)
3613        ||(r->order[jj]==ringorder_aa)
3614        ||(r->order[jj]==ringorder_a64))
3615      &&(r->block0[jj]<=r->block0[i])
3616      &&(r->block1[jj]>=r->block1[i]))
3617      { oo=1; break;}
3618    }
3619    r->OrdSgn=oo;
3620  }
3621}
3622
3623
3624void rUnComplete(ring r)
3625{
3626  if (r == NULL) return;
3627  if (r->VarOffset != NULL)
3628  {
3629    if (r->OrdSize!=0 && r->typ != NULL)
3630    {
3631      for(int i = 0; i < r->OrdSize; i++)
3632        if( r->typ[i].ord_typ == ro_is) // Search for suffixes! (prefix have the same VarOffset)
3633        {
3634          id_Delete(&r->typ[i].data.is.F, r);
3635          r->typ[i].data.is.F = NULL; // ?
3636
3637          if( r->typ[i].data.is.componentWeights != NULL )
3638          {
3639            delete r->typ[i].data.is.componentWeights;
3640            r->typ[i].data.is.componentWeights = NULL; // ?
3641          }
3642
3643          if( r->typ[i].data.is.pVarOffset != NULL )
3644          {
3645            omFreeSize((ADDRESS)r->typ[i].data.is.pVarOffset, (r->N +1)*sizeof(int));
3646            r->typ[i].data.is.pVarOffset = NULL; // ?
3647          }
3648        }
3649        else if (r->typ[i].ord_typ == ro_syz)
3650        {
3651          if(r->typ[i].data.syz.limit > 0)
3652            omFreeSize(r->typ[i].data.syz.syz_index, ((r->typ[i].data.syz.limit) +1)*sizeof(int));
3653          r->typ[i].data.syz.syz_index = NULL;
3654        }
3655        else if (r->typ[i].ord_typ == ro_syzcomp)
3656        {
3657          assume( r->typ[i].data.syzcomp.ShiftedComponents == NULL );
3658          assume( r->typ[i].data.syzcomp.Components        == NULL );
3659//          WarnS( "rUnComplete : ord_typ == ro_syzcomp was unhandled!!! Possibly memory leak!!!"  );
3660#ifndef NDEBUG
3661//          assume(0);
3662#endif
3663        }
3664
3665      omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord)); r->typ = NULL;
3666    }
3667
3668    if (r->order != NULL)
3669    {
3670      // delete r->order!!!???
3671    }
3672
3673    if (r->PolyBin != NULL)
3674      omUnGetSpecBin(&(r->PolyBin));
3675
3676    omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3677
3678    if (r->ordsgn != NULL && r->CmpL_Size != 0)
3679      omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
3680    if (r->p_Procs != NULL)
3681      omFreeSize(r->p_Procs, sizeof(p_Procs_s));
3682    omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
3683  }
3684  if (r->NegWeightL_Offset!=NULL)
3685  {
3686    omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
3687    r->NegWeightL_Offset=NULL;
3688  }
3689}
3690
3691// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
3692static void rSetVarL(ring r)
3693{
3694  int  min = INT_MAX, min_j = -1;
3695  int* VarL_Number = (int*) omAlloc0(r->ExpL_Size*sizeof(int));
3696
3697  int i,j;
3698
3699  // count how often a var long is occupied by an exponent
3700  for (i=1; i<=r->N; i++)
3701  {
3702    VarL_Number[r->VarOffset[i] & 0xffffff]++;
3703  }
3704
3705  // determine how many and min
3706  for (i=0, j=0; i<r->ExpL_Size; i++)
3707  {
3708    if (VarL_Number[i] != 0)
3709    {
3710      if (min > VarL_Number[i])
3711      {
3712        min = VarL_Number[i];
3713        min_j = j;
3714      }
3715      j++;
3716    }
3717  }
3718
3719  r->VarL_Size = j; // number of long with exp. entries in
3720                    //  in p->exp
3721  r->VarL_Offset = (int*) omAlloc(r->VarL_Size*sizeof(int));
3722  r->VarL_LowIndex = 0;
3723
3724  // set VarL_Offset
3725  for (i=0, j=0; i<r->ExpL_Size; i++)
3726  {
3727    if (VarL_Number[i] != 0)
3728    {
3729      r->VarL_Offset[j] = i;
3730      if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
3731        r->VarL_LowIndex = -1;
3732      j++;
3733    }
3734  }
3735  if (r->VarL_LowIndex >= 0)
3736    r->VarL_LowIndex = r->VarL_Offset[0];
3737
3738  r->MinExpPerLong = min;
3739  if (min_j != 0)
3740  {
3741    j = r->VarL_Offset[min_j];
3742    r->VarL_Offset[min_j] = r->VarL_Offset[0];
3743    r->VarL_Offset[0] = j;
3744  }
3745  omFree(VarL_Number);
3746}
3747
3748static void rRightAdjustVarOffset(ring r)
3749{
3750  int* shifts = (int*) omAlloc(r->ExpL_Size*sizeof(int));
3751  int i;
3752  // initialize shifts
3753  for (i=0;i<r->ExpL_Size;i++)
3754    shifts[i] = BIT_SIZEOF_LONG;
3755
3756  // find minimal bit shift in each long exp entry
3757  for (i=1;i<=r->N;i++)
3758  {
3759    if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
3760      shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
3761  }
3762  // reset r->VarOffset: set the minimal shift to 0
3763  for (i=1;i<=r->N;i++)
3764  {
3765    if (shifts[r->VarOffset[i] & 0xffffff] != 0)
3766      r->VarOffset[i]
3767        = (r->VarOffset[i] & 0xffffff) |
3768        (((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
3769  }
3770  omFree(shifts);
3771}
3772
3773// get r->divmask depending on bits per exponent
3774static unsigned long rGetDivMask(int bits)
3775{
3776  unsigned long divmask = 1;
3777  int i = bits;
3778
3779  while (i < BIT_SIZEOF_LONG)
3780  {
3781    divmask |= (((unsigned long) 1) << (unsigned long) i);
3782    i += bits;
3783  }
3784  return divmask;
3785}
3786
3787#ifdef RDEBUG
3788void rDebugPrint(ring r)
3789{
3790  if (r==NULL)
3791  {
3792    PrintS("NULL ?\n");
3793    return;
3794  }
3795  // corresponds to ro_typ from ring.h:
3796  const char *TYP[]={"ro_dp","ro_wp","ro_wp64","ro_wp_neg","ro_cp",
3797                     "ro_syzcomp", "ro_syz", "ro_isTemp", "ro_is", "ro_none"};
3798  int i,j;
3799
3800  Print("ExpL_Size:%d ",r->ExpL_Size);
3801  Print("CmpL_Size:%d ",r->CmpL_Size);
3802  Print("VarL_Size:%d\n",r->VarL_Size);
3803  Print("bitmask=0x%lx (expbound=%ld) \n",r->bitmask, r->bitmask);
3804  Print("BitsPerExp=%d ExpPerLong=%d MinExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->MinExpPerLong, r->VarL_Offset[0]);
3805  PrintS("varoffset:\n");
3806  if (r->VarOffset==NULL) PrintS(" NULL\n");
3807  else
3808    for(j=0;j<=r->N;j++)
3809      Print("  v%d at e-pos %d, bit %d\n",
3810            j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
3811  Print("divmask=%lx\n", r->divmask);
3812  PrintS("ordsgn:\n");
3813  for(j=0;j<r->CmpL_Size;j++)
3814    Print("  ordsgn %ld at pos %d\n",r->ordsgn[j],j);
3815  Print("OrdSgn:%d\n",r->OrdSgn);
3816  PrintS("ordrec:\n");
3817  for(j=0;j<r->OrdSize;j++)
3818  {
3819    Print("  typ %s", TYP[r->typ[j].ord_typ]);
3820
3821
3822    if (r->typ[j].ord_typ==ro_syz)
3823    {
3824      const short place = r->typ[j].data.syz.place;
3825      const int limit = r->typ[j].data.syz.limit;
3826      const int curr_index = r->typ[j].data.syz.curr_index;
3827      const int* syz_index = r->typ[j].data.syz.syz_index;
3828
3829      Print("  limit %d (place: %d, curr_index: %d), syz_index: ", limit, place, curr_index);
3830
3831      if( syz_index == NULL )
3832        PrintS("(NULL)");
3833      else
3834      {
3835        Print("{");
3836        for( i=0; i <= limit; i++ )
3837          Print("%d ", syz_index[i]);
3838        Print("}");
3839      }
3840
3841    }
3842    else if (r->typ[j].ord_typ==ro_isTemp)
3843    {
3844      Print("  start (level) %d, suffixpos: %d, VO: ",r->typ[j].data.isTemp.start, r->typ[j].data.isTemp.suffixpos);
3845
3846    }
3847    else if (r->typ[j].ord_typ==ro_is)
3848    {
3849      Print("  start %d, end: %d: ",r->typ[j].data.is.start, r->typ[j].data.is.end);
3850
3851//      for( int k = 0; k <= r->N; k++) if (r->typ[j].data.is.pVarOffset[k] != -1) Print("[%2d]: %04x; ", k, r->typ[j].data.is.pVarOffset[k]);
3852
3853      Print("  limit %d\n",r->typ[j].data.is.limit);
3854      #ifndef NDEBUG
3855      //PrintS("  F: ");idShow(r->typ[j].data.is.F, r, r, 1);
3856      #endif
3857
3858      PrintS("weights: ");
3859
3860      if( r->typ[j].data.is.componentWeights == NULL )
3861        PrintS("NULL == [0,...0]\n");
3862      else
3863      {
3864        (r->typ[j].data.is.componentWeights)->show(); PrintLn();
3865      }
3866    }
3867    else
3868    {
3869      Print("  place %d",r->typ[j].data.dp.place);
3870
3871      if (r->typ[j].ord_typ!=ro_syzcomp  && r->typ[j].ord_typ!=ro_syz)
3872      {
3873        Print("  start %d",r->typ[j].data.dp.start);
3874        Print("  end %d",r->typ[j].data.dp.end);
3875        if ((r->typ[j].ord_typ==ro_wp)
3876        || (r->typ[j].ord_typ==ro_wp_neg))
3877        {
3878          PrintS(" w:");
3879          for(int l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
3880            Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
3881        }
3882        else if (r->typ[j].ord_typ==ro_wp64)
3883        {
3884          PrintS(" w64:");
3885          int l;
3886          for(l=r->typ[j].data.wp64.start;l<=r->typ[j].data.wp64.end;l++)
3887            Print(" %ld",(long)(((int64*)r->typ[j].data.wp64.weights64)+l-r->typ[j].data.wp64.start));
3888          }
3889        }
3890    }
3891    PrintLn();
3892  }
3893  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
3894  Print("OrdSize:%d\n",r->OrdSize);
3895  PrintS("--------------------\n");
3896  for(j=0;j<r->ExpL_Size;j++)
3897  {
3898    Print("L[%d]: ",j);
3899    if (j< r->CmpL_Size)
3900      Print("ordsgn %ld ", r->ordsgn[j]);
3901    else
3902      PrintS("no comp ");
3903    i=1;
3904    for(;i<=r->N;i++)
3905    {
3906      if( (r->VarOffset[i] & 0xffffff) == j )
3907      {  Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
3908                                         r->VarOffset[i] >>24 ); }
3909    }
3910    if( r->pCompIndex==j ) PrintS("v0; ");
3911    for(i=0;i<r->OrdSize;i++)
3912    {
3913      if (r->typ[i].data.dp.place == j)
3914      {
3915        Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
3916          r->typ[i].data.dp.start, r->typ[i].data.dp.end);
3917      }
3918    }
3919
3920    if (j==r->pOrdIndex)
3921      PrintS("pOrdIndex\n");
3922    else
3923      PrintLn();
3924  }
3925  Print("LexOrder:%d, MixedOrder:%d\n",r->LexOrder, r->MixedOrder);
3926
3927  // p_Procs stuff
3928  p_Procs_s proc_names;
3929  const char* field;
3930  const char* length;
3931  const char* ord;
3932  p_Debug_GetProcNames(r, &proc_names); // changes p_Procs!!!
3933  p_Debug_GetSpecNames(r, field, length, ord);
3934
3935  Print("p_Spec  : %s, %s, %s\n", field, length, ord);
3936  PrintS("p_Procs :\n");
3937  for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
3938  {
3939    Print(" %s,\n", ((char**) &proc_names)[i]);
3940  }
3941
3942  {
3943#define pFDeg_CASE(A) if(r->pFDeg == A) PrintS( "" #A "" )
3944    Print("\npFDeg   : ");
3945
3946    pFDeg_CASE(p_Totaldegree); else
3947      pFDeg_CASE(p_WFirstTotalDegree); else
3948      pFDeg_CASE(p_WTotaldegree); else
3949      pFDeg_CASE(p_Deg); else
3950      Print("(%p)", r->pFDeg); // default case
3951
3952    PrintS("\n");
3953#undef pFDeg_CASE
3954  }
3955
3956}
3957
3958void p_DebugPrint(poly p, const ring r)
3959{
3960  int i,j;
3961  p_Write(p,r);
3962  j=2;
3963  while(p!=NULL)
3964  {
3965    Print("\nexp[0..%d]\n",r->ExpL_Size-1);
3966    for(i=0;i<r->ExpL_Size;i++)
3967      Print("%ld ",p->exp[i]);
3968    PrintLn();
3969    Print("v0:%ld ",p_GetComp(p, r));
3970    for(i=1;i<=r->N;i++) Print(" v%d:%ld",i,p_GetExp(p,i, r));
3971    PrintLn();
3972    pIter(p);
3973    j--;
3974    if (j==0) { PrintS("...\n"); break; }
3975  }
3976}
3977
3978#endif // RDEBUG
3979
3980/// debug-print monomial poly/vector p, assuming that it lives in the ring R
3981static inline void m_DebugPrint(const poly p, const ring R)
3982{
3983  Print("\nexp[0..%d]\n", R->ExpL_Size - 1);
3984  for(int i = 0; i < R->ExpL_Size; i++)
3985    Print("%09lx ", p->exp[i]);
3986  PrintLn();
3987  Print("v0:%9ld ", p_GetComp(p, R));
3988  for(int i = 1; i <= R->N; i++) Print(" v%d:%5ld",i, p_GetExp(p, i, R));
3989  PrintLn();
3990}
3991
3992
3993#ifndef NDEBUG
3994/// debug-print at most nTerms (2 by default) terms from poly/vector p,
3995/// assuming that lt(p) lives in lmRing and tail(p) lives in tailRing.
3996void p_DebugPrint(const poly p, const ring lmRing, const ring tailRing, const int nTerms)
3997{
3998  assume( nTerms >= 0 );
3999  if( p != NULL )
4000  {
4001    assume( p != NULL );
4002
4003    p_Write(p, lmRing, tailRing);
4004
4005    if( (p != NULL) && (nTerms > 0) )
4006    {
4007      assume( p != NULL );
4008      assume( nTerms > 0 );
4009
4010      // debug pring leading term
4011      m_DebugPrint(p, lmRing);
4012
4013      poly q = pNext(p); // q = tail(p)
4014
4015      // debug pring tail (at most nTerms-1 terms from it)
4016      for(int j = nTerms - 1; (q !=NULL) && (j > 0); pIter(q), --j)
4017        m_DebugPrint(q, tailRing);
4018
4019      if (q != NULL)
4020        PrintS("...\n");
4021    }
4022  }
4023  else
4024    PrintS("0\n");
4025}
4026#endif
4027
4028
4029//    F = system("ISUpdateComponents", F, V, MIN );
4030//    // replace gen(i) -> gen(MIN + V[i-MIN]) for all i > MIN in all terms from F!
4031void pISUpdateComponents(ideal F, const intvec *const V, const int MIN, const ring r )
4032{
4033  assume( V != NULL );
4034  assume( MIN >= 0 );
4035
4036  if( F == NULL )
4037    return;
4038
4039  for( int j = (F->ncols*F->nrows) - 1; j >= 0; j-- )
4040  {
4041#ifdef PDEBUG
4042    Print("F[%d]:", j);
4043    p_DebugPrint(F->m[j], r, r, 0);
4044#endif
4045
4046    for( poly p = F->m[j]; p != NULL; pIter(p) )
4047    {
4048      int c = p_GetComp(p, r);
4049
4050      if( c > MIN )
4051      {
4052#ifdef PDEBUG
4053        Print("gen[%d] -> gen(%d)\n", c, MIN + (*V)[ c - MIN - 1 ]);
4054#endif
4055
4056        p_SetComp( p, MIN + (*V)[ c - MIN - 1 ], r );
4057      }
4058    }
4059#ifdef PDEBUG
4060    Print("new F[%d]:", j);
4061    p_Test(F->m[j], r);
4062    p_DebugPrint(F->m[j], r, r, 0);
4063#endif
4064  }
4065
4066}
4067
4068
4069
4070
4071/*2
4072* asssume that rComplete was called with r
4073* assume that the first block ist ringorder_S
4074* change the block to reflect the sequence given by appending v
4075*/
4076
4077#ifdef PDEBUG
4078void rDBChangeSComps(int* currComponents,
4079                     long* currShiftedComponents,
4080                     int length,
4081                     ring r)
4082{
4083  assume(r->typ[1].ord_typ == ro_syzcomp);
4084
4085  r->typ[1].data.syzcomp.length = length;
4086  rNChangeSComps( currComponents, currShiftedComponents, r);
4087}
4088void rDBGetSComps(int** currComponents,
4089                 long** currShiftedComponents,
4090                 int *length,
4091                 ring r)
4092{
4093  assume(r->typ[1].ord_typ == ro_syzcomp);
4094
4095  *length = r->typ[1].data.syzcomp.length;
4096  rNGetSComps( currComponents, currShiftedComponents, r);
4097}
4098#endif
4099
4100void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
4101{
4102  assume(r->typ[1].ord_typ == ro_syzcomp);
4103
4104  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
4105  r->typ[1].data.syzcomp.Components = currComponents;
4106}
4107
4108void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
4109{
4110  assume(r->typ[1].ord_typ == ro_syzcomp);
4111
4112  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
4113  *currComponents =   r->typ[1].data.syzcomp.Components;
4114}
4115
4116/////////////////////////////////////////////////////////////////////////////
4117//
4118// The following routines all take as input a ring r, and return R
4119// where R has a certain property. R might be equal r in which case r
4120// had already this property
4121//
4122ring rAssure_SyzComp(const ring r, BOOLEAN complete)
4123{
4124  if ( (r->order[0] == ringorder_s) ) return r;
4125
4126  if ( (r->order[0] == ringorder_IS) )
4127  {
4128#ifndef NDEBUG
4129    WarnS("rAssure_SyzComp: input ring has an IS-ordering!");
4130#endif
4131//    return r;
4132  }
4133  ring res=rCopy0(r, FALSE, FALSE);
4134  int i=rBlocks(r);
4135  int j;
4136
4137  res->order=(int *)omAlloc((i+1)*sizeof(int));
4138  res->block0=(int *)omAlloc0((i+1)*sizeof(int));
4139  res->block1=(int *)omAlloc0((i+1)*sizeof(int));
4140  int ** wvhdl =(int **)omAlloc0((i+1)*sizeof(int**));
4141  for(j=i;j>0;j--)
4142  {
4143    res->order[j]=r->order[j-1];
4144    res->block0[j]=r->block0[j-1];
4145    res->block1[j]=r->block1[j-1];
4146    if (r->wvhdl[j-1] != NULL)
4147    {
4148      wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
4149    }
4150  }
4151  res->order[0]=ringorder_s;
4152
4153  res->wvhdl = wvhdl;
4154
4155  if (complete)
4156  {
4157    rComplete(res, 1);
4158
4159#ifdef HAVE_PLURAL
4160    if (rIsPluralRing(r))
4161    {
4162      if ( nc_rComplete(r, res, false) ) // no qideal!
4163      {
4164#ifndef NDEBUG
4165        WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4166#endif
4167      }
4168    }
4169    assume(rIsPluralRing(r) == rIsPluralRing(res));
4170#endif
4171
4172
4173#ifdef HAVE_PLURAL
4174    ring old_ring = r;
4175#endif
4176
4177    if (r->qideal!=NULL)
4178    {
4179      res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4180
4181      assume(id_RankFreeModule(res->qideal, res) == 0);
4182
4183#ifdef HAVE_PLURAL
4184      if( rIsPluralRing(res) )
4185        if( nc_SetupQuotient(res, r, true) )
4186        {
4187//          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4188        }
4189
4190#endif
4191      assume(id_RankFreeModule(res->qideal, res) == 0);
4192    }
4193
4194#ifdef HAVE_PLURAL
4195    assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4196    assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4197    assume(rIsSCA(res) == rIsSCA(old_ring));
4198    assume(ncRingType(res) == ncRingType(old_ring));
4199#endif
4200  }
4201
4202  return res;
4203}
4204
4205ring rAssure_TDeg(ring r, int start_var, int end_var, int &pos)
4206{
4207  int i;
4208  if (r->typ!=NULL)
4209  {
4210    for(i=r->OrdSize-1;i>=0;i--)
4211    {
4212      if ((r->typ[i].ord_typ==ro_dp)
4213      && (r->typ[i].data.dp.start==start_var)
4214      && (r->typ[i].data.dp.end==end_var))
4215      {
4216        pos=r->typ[i].data.dp.place;
4217        //printf("no change, pos=%d\n",pos);
4218        return r;
4219      }
4220    }
4221  }
4222
4223#ifdef HAVE_PLURAL
4224  nc_struct* save=r->GetNC();
4225  r->GetNC()=NULL;
4226#endif
4227  ring res=rCopy(r);
4228
4229  i=rBlocks(r);
4230  int j;
4231
4232  res->ExpL_Size=r->ExpL_Size+1; // one word more in each monom
4233  res->PolyBin=omGetSpecBin(POLYSIZE + (res->ExpL_Size)*sizeof(long));
4234  omFree((ADDRESS)res->ordsgn);
4235  res->ordsgn=(long *)omAlloc0(res->ExpL_Size*sizeof(long));
4236  for(j=0;j<r->CmpL_Size;j++)
4237  {
4238    res->ordsgn[j] = r->ordsgn[j];
4239  }
4240  res->OrdSize=r->OrdSize+1;   // one block more for pSetm
4241  if (r->typ!=NULL)
4242    omFree((ADDRESS)res->typ);
4243  res->typ=(sro_ord*)omAlloc0(res->OrdSize*sizeof(sro_ord));
4244  if (r->typ!=NULL)
4245    memcpy(res->typ,r->typ,r->OrdSize*sizeof(sro_ord));
4246  // the additional block for pSetm: total degree at the last word
4247  // but not included in the compare part
4248  res->typ[res->OrdSize-1].ord_typ=ro_dp;
4249  res->typ[res->OrdSize-1].data.dp.start=start_var;
4250  res->typ[res->OrdSize-1].data.dp.end=end_var;
4251  res->typ[res->OrdSize-1].data.dp.place=res->ExpL_Size-1;
4252  pos=res->ExpL_Size-1;
4253  //if ((start_var==1) && (end_var==res->N)) res->pOrdIndex=pos;
4254  extern void p_Setm_General(poly p, ring r);
4255  res->p_Setm=p_Setm_General;
4256  // ----------------------------
4257  omFree((ADDRESS)res->p_Procs);
4258  res->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
4259
4260  p_ProcsSet(res, res->p_Procs);
4261  if (res->qideal!=NULL) id_Delete(&res->qideal,res);
4262#ifdef HAVE_PLURAL
4263  r->GetNC()=save;
4264  if (rIsPluralRing(r))
4265  {
4266    if ( nc_rComplete(r, res, false) ) // no qideal!
4267    {
4268#ifndef NDEBUG
4269      WarnS("error in nc_rComplete");
4270#endif
4271      // just go on..
4272    }
4273  }
4274#endif
4275  if (r->qideal!=NULL)
4276  {
4277     res->qideal=idrCopyR_NoSort(r->qideal,r, res);
4278#ifdef HAVE_PLURAL
4279     if (rIsPluralRing(res))
4280     {
4281//       nc_SetupQuotient(res, currRing);
4282       nc_SetupQuotient(res, r); // ?
4283     }
4284     assume((res->qideal==NULL) == (r->qideal==NULL));
4285#endif
4286  }
4287
4288#ifdef HAVE_PLURAL
4289  assume(rIsPluralRing(res) == rIsPluralRing(r));
4290  assume(rIsSCA(res) == rIsSCA(r));
4291  assume(ncRingType(res) == ncRingType(r));
4292#endif
4293
4294  return res;
4295}
4296
4297ring rAssure_HasComp(const ring r)
4298{
4299  int last_block;
4300  int i=0;
4301  do
4302  {
4303     if (r->order[i] == ringorder_c ||
4304        r->order[i] == ringorder_C) return r;
4305     if (r->order[i] == 0)
4306        break;
4307     i++;
4308  } while (1);
4309  //WarnS("re-creating ring with comps");
4310  last_block=i-1;
4311
4312  ring new_r = rCopy0(r, FALSE, FALSE);
4313  i+=2;
4314  new_r->wvhdl=(int **)omAlloc0(i * sizeof(int *));
4315  new_r->order   = (int *) omAlloc0(i * sizeof(int));
4316  new_r->block0   = (int *) omAlloc0(i * sizeof(int));
4317  new_r->block1   = (int *) omAlloc0(i * sizeof(int));
4318  memcpy(new_r->order,r->order,(i-1) * sizeof(int));
4319  memcpy(new_r->block0,r->block0,(i-1) * sizeof(int));
4320  memcpy(new_r->block1,r->block1,(i-1) * sizeof(int));
4321  for (int j=0; j<=last_block; j++)
4322  {
4323    if (r->wvhdl[j]!=NULL)
4324    {
4325      new_r->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
4326    }
4327  }
4328  last_block++;
4329  new_r->order[last_block]=ringorder_C;
4330  //new_r->block0[last_block]=0;
4331  //new_r->block1[last_block]=0;
4332  //new_r->wvhdl[last_block]=NULL;
4333
4334  rComplete(new_r, 1);
4335
4336#ifdef HAVE_PLURAL
4337  if (rIsPluralRing(r))
4338  {
4339    if ( nc_rComplete(r, new_r, false) ) // no qideal!
4340    {
4341#ifndef NDEBUG
4342      WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4343#endif
4344    }
4345  }
4346  assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4347#endif
4348
4349  return new_r;
4350}
4351
4352static ring rAssure_CompLastBlock(ring r, BOOLEAN complete = TRUE)
4353{
4354  int last_block = rBlocks(r) - 2;
4355  if (r->order[last_block] != ringorder_c &&
4356      r->order[last_block] != ringorder_C)
4357  {
4358    int c_pos = 0;
4359    int i;
4360
4361    for (i=0; i< last_block; i++)
4362    {
4363      if (r->order[i] == ringorder_c || r->order[i] == ringorder_C)
4364      {
4365        c_pos = i;
4366        break;
4367      }
4368    }
4369    if (c_pos != -1)
4370    {
4371      ring new_r = rCopy0(r, FALSE, TRUE);
4372      for (i=c_pos+1; i<=last_block; i++)
4373      {
4374        new_r->order[i-1] = new_r->order[i];
4375        new_r->block0[i-1] = new_r->block0[i];
4376        new_r->block1[i-1] = new_r->block1[i];
4377        new_r->wvhdl[i-1] = new_r->wvhdl[i];
4378      }
4379      new_r->order[last_block] = r->order[c_pos];
4380      new_r->block0[last_block] = r->block0[c_pos];
4381      new_r->block1[last_block] = r->block1[c_pos];
4382      new_r->wvhdl[last_block] = r->wvhdl[c_pos];
4383      if (complete)
4384      {
4385        rComplete(new_r, 1);
4386
4387#ifdef HAVE_PLURAL
4388        if (rIsPluralRing(r))
4389        {
4390          if ( nc_rComplete(r, new_r, false) ) // no qideal!
4391          {
4392#ifndef NDEBUG
4393            WarnS("error in nc_rComplete");   // cleanup?//      rDelete(res);//      return r;      // just go on..
4394#endif
4395          }
4396        }
4397        assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4398#endif
4399      }
4400      return new_r;
4401    }
4402  }
4403  return r;
4404}
4405
4406// Moves _c or _C ordering to the last place AND adds _s on the 1st place
4407ring rAssure_SyzComp_CompLastBlock(const ring r)
4408{
4409  ring new_r_1 = rAssure_CompLastBlock(r, FALSE); // due to this FALSE - no completion!
4410  ring new_r = rAssure_SyzComp(new_r_1, FALSE); // new_r_1 is used only here!!!
4411
4412  if (new_r != r)
4413  {
4414    ring old_r = r;
4415    if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
4416    rComplete(new_r, 1);
4417#ifdef HAVE_PLURAL
4418    if (rIsPluralRing(old_r))
4419    {
4420      if ( nc_rComplete(old_r, new_r, false) ) // no qideal!
4421      {
4422#ifndef NDEBUG
4423        WarnS("error in nc_rComplete"); // cleanup?      rDelete(res);       return r;  // just go on...?
4424#endif
4425        }
4426    }
4427    assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4428#endif
4429///?    rChangeCurrRing(new_r);
4430    if (old_r->qideal != NULL)
4431    {
4432      new_r->qideal = idrCopyR(old_r->qideal, old_r, new_r);
4433      //currQuotient = new_r->qideal;
4434
4435#ifdef HAVE_PLURAL
4436      if( rIsPluralRing(old_r) )
4437        if( nc_SetupQuotient(new_r, old_r, true) )
4438        {
4439#ifndef NDEBUG
4440          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4441#endif
4442        }
4443#endif
4444    }
4445
4446#ifdef HAVE_PLURAL
4447    assume((new_r->qideal==NULL) == (old_r->qideal==NULL));
4448    assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4449    assume(rIsSCA(new_r) == rIsSCA(old_r));
4450    assume(ncRingType(new_r) == ncRingType(old_r));
4451#endif
4452
4453    rTest(new_r);
4454    rTest(old_r);
4455  }
4456  return new_r;
4457}
4458
4459// use this for global orderings consisting of two blocks
4460static ring rAssure_Global(rRingOrder_t b1, rRingOrder_t b2, const ring r)
4461{
4462  int r_blocks = rBlocks(r);
4463
4464  assume(b1 == ringorder_c || b1 == ringorder_C ||
4465         b2 == ringorder_c || b2 == ringorder_C ||
4466         b2 == ringorder_S);
4467  if ((r_blocks == 3) &&
4468      (r->order[0] == b1) &&
4469      (r->order[1] == b2) &&
4470      (r->order[2] == 0))
4471    return r;
4472  ring res = rCopy0(r, TRUE, FALSE);
4473  res->order = (int*)omAlloc0(3*sizeof(int));
4474  res->block0 = (int*)omAlloc0(3*sizeof(int));
4475  res->block1 = (int*)omAlloc0(3*sizeof(int));
4476  res->wvhdl = (int**)omAlloc0(3*sizeof(int*));
4477  res->order[0] = b1;
4478  res->order[1] = b2;
4479  if (b1 == ringorder_c || b1 == ringorder_C)
4480  {
4481    res->block0[1] = 1;
4482    res->block1[1] = r->N;
4483  }
4484  else
4485  {
4486    res->block0[0] = 1;
4487    res->block1[0] = r->N;
4488  }
4489  // HANNES: This sould be set in rComplete
4490  res->OrdSgn = 1;
4491  rComplete(res, 1);
4492#ifdef HAVE_PLURAL
4493  if (rIsPluralRing(r))
4494  {
4495    if ( nc_rComplete(r, res, false) ) // no qideal!
4496    {
4497#ifndef NDEBUG
4498      WarnS("error in nc_rComplete");
4499#endif
4500    }
4501  }
4502#endif
4503//  rChangeCurrRing(res);
4504  return res;
4505}
4506
4507ring rAssure_InducedSchreyerOrdering(const ring r, BOOLEAN complete = TRUE, int sgn = 1)
4508{ // TODO: ???? Add leading Syz-comp ordering here...????
4509
4510#if MYTEST
4511    Print("rAssure_InducedSchreyerOrdering(r, complete = %d, sgn = %d): r: \n", complete, sgn);
4512    rWrite(r);
4513#ifdef RDEBUG
4514    rDebugPrint(r);
4515#endif
4516    PrintLn();
4517#endif
4518  assume((sgn == 1) || (sgn == -1));
4519
4520  ring res=rCopy0(r, FALSE, FALSE); // No qideal & ordering copy.
4521
4522  int n = rBlocks(r); // Including trailing zero!
4523
4524  // Create 2 more blocks for prefix/suffix:
4525  res->order=(int *)omAlloc0((n+2)*sizeof(int)); // 0  ..  n+1
4526  res->block0=(int *)omAlloc0((n+2)*sizeof(int));
4527  res->block1=(int *)omAlloc0((n+2)*sizeof(int));
4528  int ** wvhdl =(int **)omAlloc0((n+2)*sizeof(int**));
4529
4530  // Encapsulate all existing blocks between induced Schreyer ordering markers: prefix and suffix!
4531  // Note that prefix and suffix have the same ringorder marker and only differ in block[] parameters!
4532
4533  // new 1st block
4534  int j = 0;
4535  res->order[j] = ringorder_IS; // Prefix
4536  res->block0[j] = res->block1[j] = 0;
4537  // wvhdl[j] = NULL;
4538  j++;
4539
4540  for(int i = 0; (i <= n) && (r->order[i] != 0); i++, j++) // i = [0 .. n-1] <- non-zero old blocks
4541  {
4542    res->order [j] = r->order [i];
4543    res->block0[j] = r->block0[i];
4544    res->block1[j] = r->block1[i];
4545
4546    if (r->wvhdl[i] != NULL)
4547    {
4548      wvhdl[j] = (int*) omMemDup(r->wvhdl[i]);
4549    } // else wvhdl[j] = NULL;
4550  }
4551
4552  // new last block
4553  res->order [j] = ringorder_IS; // Suffix
4554  res->block0[j] = res->block1[j] = sgn; // Sign of v[o]: 1 for C, -1 for c
4555  // wvhdl[j] = NULL;
4556  j++;
4557
4558  // res->order [j] = 0; // The End!
4559  res->wvhdl = wvhdl;
4560
4561  // j == the last zero block now!
4562  assume(j == (n+1));
4563  assume(res->order[0]==ringorder_IS);
4564  assume(res->order[j-1]==ringorder_IS);
4565  assume(res->order[j]==0);
4566
4567
4568  if (complete)
4569  {
4570    rComplete(res, 1);
4571
4572#ifdef HAVE_PLURAL
4573    if (rIsPluralRing(r))
4574    {
4575      if ( nc_rComplete(r, res, false) ) // no qideal!
4576      {
4577#ifndef NDEBUG
4578        WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4579#endif
4580      }
4581    }
4582    assume(rIsPluralRing(r) == rIsPluralRing(res));
4583#endif
4584
4585
4586#ifdef HAVE_PLURAL
4587    ring old_ring = r;
4588#endif
4589
4590    if (r->qideal!=NULL)
4591    {
4592      res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4593
4594      assume(id_RankFreeModule(res->qideal, res) == 0);
4595
4596#ifdef HAVE_PLURAL
4597      if( rIsPluralRing(res) )
4598        if( nc_SetupQuotient(res, r, true) )
4599        {
4600//          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4601        }
4602
4603#endif
4604      assume(id_RankFreeModule(res->qideal, res) == 0);
4605    }
4606
4607#ifdef HAVE_PLURAL
4608    assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4609    assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4610    assume(rIsSCA(res) == rIsSCA(old_ring));
4611    assume(ncRingType(res) == ncRingType(old_ring));
4612#endif
4613  }
4614
4615  return res;
4616}
4617
4618ring rAssure_dp_S(const ring r)
4619{
4620  return rAssure_Global(ringorder_dp, ringorder_S,r);
4621}
4622
4623ring rAssure_dp_C(const ring r)
4624{
4625  return rAssure_Global(ringorder_dp, ringorder_C,r);
4626}
4627
4628ring rAssure_C_dp(const ring r)
4629{
4630  return rAssure_Global(ringorder_C, ringorder_dp,r);
4631}
4632
4633
4634
4635/// Finds p^th IS ordering, and returns its position in r->typ[]
4636/// returns -1 if something went wrong!
4637int rGetISPos(const int p, const ring r)
4638{
4639  // Put the reference set F into the ring -ordering -recor
4640#if MYTEST
4641  Print("rIsIS(p: %d)\nF:", p);
4642  PrintLn();
4643#endif
4644
4645  if (r->typ==NULL)
4646  {
4647    dReportError("'rIsIS:' Error: wrong ring! (typ == NULL)");
4648    return -1;
4649  }
4650
4651  int j = p; // Which IS record to use...
4652  for( int pos = 0; pos < r->OrdSize; pos++ )
4653    if( r->typ[pos].ord_typ == ro_is)
4654      if( j-- == 0 )
4655      {
4656        return pos;
4657      }
4658
4659  return -1;
4660}
4661
4662
4663
4664
4665
4666
4667/// Changes r by setting induced ordering parameters: limit and reference leading terms
4668/// F belong to r, we will DO a copy! (same to componentWeights)
4669/// We will use it AS IS!
4670/// returns true is everything was allright!
4671BOOLEAN rSetISReference(const ring r, const ideal F, const int i, const int p, const intvec * componentWeights)
4672{
4673  // Put the reference set F into the ring -ordering -recor
4674
4675  // TEST THAT THERE ARE DEGs!!!
4676  // assume( componentWeights == NULL  ); // ???
4677  if( componentWeights != NULL )
4678  {
4679//    assure that the ring r has degrees!!!
4680//    Add weights to degrees of F[i]
4681  }
4682
4683  if (r->typ==NULL)
4684  {
4685    dReportError("Error: WRONG USE of rSetISReference: wrong ring! (typ == NULL)");
4686    return FALSE;
4687  }
4688
4689
4690  int pos = rGetISPos(p, r);
4691
4692  if( pos == -1 )
4693  {
4694    dReportError("Error: WRONG USE of rSetISReference: specified ordering block was not found!!!" );
4695    return FALSE;
4696  }
4697
4698#if MYTEST
4699  if( i != r->typ[pos].data.is.limit )
4700    Print("Changing record on pos: %d\nOld limit: %d --->> New Limit: %d\n", pos, r->typ[pos].data.is.limit, i);
4701#endif
4702
4703  const ideal FF = id_Copy(F, r); // idrHeadR(F, r, r);
4704
4705
4706  if( r->typ[pos].data.is.F != NULL)
4707  {
4708#if MYTEST
4709    PrintS("Deleting old reference set F... \n");        // idShow(r->typ[pos].data.is.F, r);         PrintLn();
4710#endif
4711    id_Delete(&r->typ[pos].data.is.F, r);
4712    r->typ[pos].data.is.F = NULL;
4713  }
4714
4715  assume(r->typ[pos].data.is.F == NULL);
4716
4717  r->typ[pos].data.is.F = FF; // F is owened by ring now! TODO: delete at the end!
4718
4719  if(r->typ[pos].data.is.componentWeights != NULL)
4720  {
4721#if MYTEST
4722    PrintS("Deleting old componentWeights: "); r->typ[pos].data.is.componentWeights->show(); PrintLn();
4723#endif
4724    delete r->typ[pos].data.is.componentWeights;
4725    r->typ[pos].data.is.componentWeights = NULL;
4726  }
4727
4728
4729  assume(r->typ[pos].data.is.componentWeights == NULL);
4730
4731  if( componentWeights != NULL )
4732    componentWeights = ivCopy(componentWeights); // componentWeights is owened by ring now! TODO: delete at the end!
4733
4734  r->typ[pos].data.is.componentWeights = componentWeights;
4735
4736  r->typ[pos].data.is.limit = i; // First induced component
4737
4738#if MYTEST
4739  PrintS("New reference set FF : \n");        idShow(FF, r, r, 1);         PrintLn();
4740#endif
4741
4742  return TRUE;
4743}
4744
4745
4746void rSetSyzComp(int k, const ring r)
4747{
4748  if(k < 0)
4749  {
4750    dReportError("rSetSyzComp with negative limit!");
4751    return;
4752  }
4753
4754  assume( k >= 0 );
4755  if (TEST_OPT_PROT) Print("{%d}", k);
4756  if ((r->typ!=NULL) && (r->typ[0].ord_typ==ro_syz))
4757  {
4758    if( k == r->typ[0].data.syz.limit )
4759      return; // nothing to do
4760
4761    int i;
4762    if (r->typ[0].data.syz.limit == 0)
4763    {
4764      r->typ[0].data.syz.syz_index = (int*) omAlloc0((k+1)*sizeof(int));
4765      r->typ[0].data.syz.syz_index[0] = 0;
4766      r->typ[0].data.syz.curr_index = 1;
4767    }
4768    else
4769    {
4770      r->typ[0].data.syz.syz_index = (int*)
4771        omReallocSize(r->typ[0].data.syz.syz_index,
4772                (r->typ[0].data.syz.limit+1)*sizeof(int),
4773                (k+1)*sizeof(int));
4774    }
4775    for (i=r->typ[0].data.syz.limit + 1; i<= k; i++)
4776    {
4777      r->typ[0].data.syz.syz_index[i] =
4778        r->typ[0].data.syz.curr_index;
4779    }
4780    if(k < r->typ[0].data.syz.limit) // ?
4781    {
4782#ifndef NDEBUG
4783      Warn("rSetSyzComp called with smaller limit (%d) as before (%d)", k, r->typ[0].data.syz.limit);
4784#endif
4785      r->typ[0].data.syz.curr_index = 1 + r->typ[0].data.syz.syz_index[k];
4786    }
4787
4788
4789    r->typ[0].data.syz.limit = k;
4790    r->typ[0].data.syz.curr_index++;
4791  }
4792  else if(
4793            (r->typ!=NULL) &&
4794            (r->typ[0].ord_typ==ro_isTemp)
4795           )
4796  {
4797//      (r->typ[currRing->typ[0].data.isTemp.suffixpos].data.is.limit == k)
4798#ifndef NDEBUG
4799    Warn("rSetSyzComp(%d) in an IS ring! Be careful!", k);
4800#endif
4801  }
4802  else
4803  if ((r->order[0]!=ringorder_c) && (k!=0)) // ???
4804  {
4805    dReportError("syzcomp in incompatible ring");
4806  }
4807#ifdef PDEBUG
4808  extern int pDBsyzComp;
4809  pDBsyzComp=k;
4810#endif
4811}
4812
4813// return the max-comonent wchich has syzIndex i
4814int rGetMaxSyzComp(int i, const ring r)
4815{
4816  if ((r->typ!=NULL) && (r->typ[0].ord_typ==ro_syz) &&
4817      r->typ[0].data.syz.limit > 0 && i > 0)
4818  {
4819    assume(i <= r->typ[0].data.syz.limit);
4820    int j;
4821    for (j=0; j<r->typ[0].data.syz.limit; j++)
4822    {
4823      if (r->typ[0].data.syz.syz_index[j] == i  &&
4824          r->typ[0].data.syz.syz_index[j+1] != i)
4825      {
4826        assume(r->typ[0].data.syz.syz_index[j+1] == i+1);
4827        return j;
4828      }
4829    }
4830    return r->typ[0].data.syz.limit;
4831  }
4832  else
4833  {
4834    return 0;
4835  }
4836}
4837
4838BOOLEAN rRing_is_Homog(ring r)
4839{
4840  if (r == NULL) return FALSE;
4841  int i, j, nb = rBlocks(r);
4842  for (i=0; i<nb; i++)
4843  {
4844    if (r->wvhdl[i] != NULL)
4845    {
4846      int length = r->block1[i] - r->block0[i];
4847      int* wvhdl = r->wvhdl[i];
4848      if (r->order[i] == ringorder_M) length *= length;
4849      assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
4850
4851      for (j=0; j< length; j++)
4852      {
4853        if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
4854      }
4855    }
4856  }
4857  return TRUE;
4858}
4859
4860BOOLEAN rRing_has_CompLastBlock(ring r)
4861{
4862  assume(r != NULL);
4863  int lb = rBlocks(r) - 2;
4864  return (r->order[lb] == ringorder_c || r->order[lb] == ringorder_C);
4865}
4866
4867n_coeffType rFieldType(ring r)
4868{
4869  return (r->cf->type);
4870  if (rField_is_Zp(r))     return n_Zp;
4871  if (rField_is_Q(r))      return n_Q;
4872  if (rField_is_R(r))      return n_R;
4873  if (rField_is_GF(r))     return n_GF;
4874  if (rField_is_long_R(r)) return n_long_R;
4875  if (rField_is_Zp_a(r))   return n_Zp_a;
4876  if (rField_is_Q_a(r))    return n_Q_a;
4877  if (rField_is_long_C(r)) return n_long_C;
4878  #ifdef HAVE_RINGS
4879   if (rField_is_Ring_Z(r)) return n_Z;
4880   if (rField_is_Ring_ModN(r)) return n_Zn;
4881   if (rField_is_Ring_PtoM(r)) return n_Zpn;
4882   if (rField_is_Ring_2toM(r)) return  n_Z2m;
4883  #endif
4884
4885  return n_unknown;
4886}
4887
4888int64 * rGetWeightVec(ring r)
4889{
4890  assume(r!=NULL);
4891  assume(r->OrdSize>0);
4892  int i=0;
4893  while((r->typ[i].ord_typ!=ro_wp64) && (r->typ[i].ord_typ>0)) i++;
4894  assume(r->typ[i].ord_typ==ro_wp64);
4895  return (int64*)(r->typ[i].data.wp64.weights64);
4896}
4897
4898void rSetWeightVec(ring r, int64 *wv)
4899{
4900  assume(r!=NULL);
4901  assume(r->OrdSize>0);
4902  assume(r->typ[0].ord_typ==ro_wp64);
4903  memcpy(r->typ[0].data.wp64.weights64,wv,r->N*sizeof(int64));
4904}
4905
4906#include <ctype.h>
4907
4908static int rRealloc1(ring r, int size, int pos)
4909{
4910  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size+1)*sizeof(int));
4911  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size+1)*sizeof(int));
4912  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size+1)*sizeof(int));
4913  r->wvhdl=(int **)omReallocSize(r->wvhdl,size*sizeof(int *), (size+1)*sizeof(int *));
4914  for(int k=size; k>pos; k--) r->wvhdl[k]=r->wvhdl[k-1];
4915  r->order[size]=0;
4916  size++;
4917  return size;
4918}
4919//static int rReallocM1(ring r, ring src, int size, int pos)
4920//{
4921//  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size-1)*sizeof(int));
4922//  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size-1)*sizeof(int));
4923//  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size-1)*sizeof(int));
4924//  r->wvhdl=(int **)omReallocSize(r->wvhdl,size*sizeof(int *), (size-1)*sizeof(int *));
4925//  for(int k=pos+1; k<size; k++) r->wvhdl[k]=r->wvhdl[k+1];
4926//  size--;
4927//  return size;
4928//}
4929static void rOppWeight(int *w, int l)
4930{
4931  int i2=(l+1)/2;
4932  for(int j=0; j<=i2; j++)
4933  {
4934    int t=w[j];
4935    w[j]=w[l-j];
4936    w[l-j]=t;
4937  }
4938}
4939
4940#define rOppVar(R,I) (rVar(R)+1-I)
4941
4942ring rOpposite(ring src)
4943  /* creates an opposite algebra of R */
4944  /* that is R^opp, where f (*^opp) g = g*f  */
4945  /* treats the case of qring */
4946{
4947  if (src == NULL) return(NULL);
4948
4949#ifdef RDEBUG
4950  rTest(src);
4951#endif
4952
4953  //rChangeCurrRing(src);
4954
4955#ifdef RDEBUG
4956  rTest(src);
4957//  rWrite(src);
4958//  rDebugPrint(src);
4959#endif
4960
4961
4962  ring r = rCopy0(src,FALSE); /* qideal will be deleted later on!!! */
4963
4964  // change vars v1..vN -> vN..v1
4965  int i;
4966  int i2 = (rVar(r)-1)/2;
4967  for(i=i2; i>=0; i--)
4968  {
4969    // index: 0..N-1
4970    //Print("ex var names: %d <-> %d\n",i,rOppVar(r,i));
4971    // exchange names
4972    char *p;
4973    p = r->names[rVar(r)-1-i];
4974    r->names[rVar(r)-1-i] = r->names[i];
4975    r->names[i] = p;
4976  }
4977//  i2=(rVar(r)+1)/2;
4978//  for(int i=i2; i>0; i--)
4979//  {
4980//    // index: 1..N
4981//    //Print("ex var places: %d <-> %d\n",i,rVar(r)+1-i);
4982//    // exchange VarOffset
4983//    int t;
4984//    t=r->VarOffset[i];
4985//    r->VarOffset[i]=r->VarOffset[rOppVar(r,i)];
4986//    r->VarOffset[rOppVar(r,i)]=t;
4987//  }
4988  // change names:
4989  for (i=rVar(r)-1; i>=0; i--)
4990  {
4991    char *p=r->names[i];
4992    if(isupper(*p)) *p = tolower(*p);
4993    else            *p = toupper(*p);
4994  }
4995  // change ordering: listing
4996  // change ordering: compare
4997//  for(i=0; i<r->OrdSize; i++)
4998//  {
4999//    int t,tt;
5000//    switch(r->typ[i].ord_typ)
5001//    {
5002//      case ro_dp:
5003//      //
5004//        t=r->typ[i].data.dp.start;
5005//        r->typ[i].data.dp.start=rOppVar(r,r->typ[i].data.dp.end);
5006//        r->typ[i].data.dp.end=rOppVar(r,t);
5007//        break;
5008//      case ro_wp:
5009//      case ro_wp_neg:
5010//      {
5011//        t=r->typ[i].data.wp.start;
5012//        r->typ[i].data.wp.start=rOppVar(r,r->typ[i].data.wp.end);
5013//        r->typ[i].data.wp.end=rOppVar(r,t);
5014//        // invert r->typ[i].data.wp.weights
5015//        rOppWeight(r->typ[i].data.wp.weights,
5016//                   r->typ[i].data.wp.end-r->typ[i].data.wp.start);
5017//        break;
5018//      }
5019//      //case ro_wp64:
5020//      case ro_syzcomp:
5021//      case ro_syz:
5022//         WerrorS("not implemented in rOpposite");
5023//         // should not happen
5024//         break;
5025//
5026//      case ro_cp:
5027//        t=r->typ[i].data.cp.start;
5028//        r->typ[i].data.cp.start=rOppVar(r,r->typ[i].data.cp.end);
5029//        r->typ[i].data.cp.end=rOppVar(r,t);
5030//        break;
5031//      case ro_none:
5032//      default:
5033//       Werror("unknown type in rOpposite(%d)",r->typ[i].ord_typ);
5034//       break;
5035//    }
5036//  }
5037  // Change order/block structures (needed for rPrint, rAdd etc.)
5038  int j=0;
5039  int l=rBlocks(src);
5040  for(i=0; src->order[i]!=0; i++)
5041  {
5042    switch (src->order[i])
5043    {
5044      case ringorder_c: /* c-> c */
5045      case ringorder_C: /* C-> C */
5046      case ringorder_no /*=0*/: /* end-of-block */
5047        r->order[j]=src->order[i];
5048        j++; break;
5049      case ringorder_lp: /* lp -> rp */
5050        r->order[j]=ringorder_rp;
5051        r->block0[j]=rOppVar(r, src->block1[i]);
5052        r->block1[j]=rOppVar(r, src->block0[i]);
5053        break;
5054      case ringorder_rp: /* rp -> lp */
5055        r->order[j]=ringorder_lp;
5056        r->block0[j]=rOppVar(r, src->block1[i]);
5057        r->block1[j]=rOppVar(r, src->block0[i]);
5058        break;
5059      case ringorder_dp: /* dp -> a(1..1),ls */
5060      {
5061        l=rRealloc1(r,l,j);
5062        r->order[j]=ringorder_a;
5063        r->block0[j]=rOppVar(r, src->block1[i]);
5064        r->block1[j]=rOppVar(r, src->block0[i]);
5065        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
5066        for(int k=r->block0[j]; k<=r->block1[j]; k++)
5067          r->wvhdl[j][k-r->block0[j]]=1;
5068        j++;
5069        r->order[j]=ringorder_ls;
5070        r->block0[j]=rOppVar(r, src->block1[i]);
5071        r->block1[j]=rOppVar(r, src->block0[i]);
5072        j++;
5073        break;
5074      }
5075      case ringorder_Dp: /* Dp -> a(1..1),rp */
5076      {
5077        l=rRealloc1(r,l,j);
5078        r->order[j]=ringorder_a;
5079        r->block0[j]=rOppVar(r, src->block1[i]);
5080        r->block1[j]=rOppVar(r, src->block0[i]);
5081        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
5082        for(int k=r->block0[j]; k<=r->block1[j]; k++)
5083          r->wvhdl[j][k-r->block0[j]]=1;
5084        j++;
5085        r->order[j]=ringorder_rp;
5086        r->block0[j]=rOppVar(r, src->block1[i]);
5087        r->block1[j]=rOppVar(r, src->block0[i]);
5088        j++;
5089        break;
5090      }
5091      case ringorder_wp: /* wp -> a(...),ls */
5092      {
5093        l=rRealloc1(r,l,j);
5094        r->order[j]=ringorder_a;
5095        r->block0[j]=rOppVar(r, src->block1[i]);
5096        r->block1[j]=rOppVar(r, src->block0[i]);
5097        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=NULL;
5098        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5099        j++;
5100        r->order[j]=ringorder_ls;
5101        r->block0[j]=rOppVar(r, src->block1[i]);
5102        r->block1[j]=rOppVar(r, src->block0[i]);
5103        j++;
5104        break;
5105      }
5106      case ringorder_Wp: /* Wp -> a(...),rp */
5107      {
5108        l=rRealloc1(r,l,j);
5109        r->order[j]=ringorder_a;
5110        r->block0[j]=rOppVar(r, src->block1[i]);
5111        r->block1[j]=rOppVar(r, src->block0[i]);
5112        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=NULL;
5113        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5114        j++;
5115        r->order[j]=ringorder_rp;
5116        r->block0[j]=rOppVar(r, src->block1[i]);
5117        r->block1[j]=rOppVar(r, src->block0[i]);
5118        j++;
5119        break;
5120      }
5121      case ringorder_M: /* M -> M */
5122      {
5123        r->order[j]=ringorder_M;
5124        r->block0[j]=rOppVar(r, src->block1[i]);
5125        r->block1[j]=rOppVar(r, src->block0[i]);
5126        int n=r->block1[j]-r->block0[j];
5127        /* M is a (n+1)x(n+1) matrix */
5128        for (int nn=0; nn<=n; nn++)
5129        {
5130          rOppWeight(&(r->wvhdl[j][nn*(n+1)]), n /*r->block1[j]-r->block0[j]*/);
5131        }
5132        j++;
5133        break;
5134      }
5135      case ringorder_a: /*  a(...),ls -> wp/dp */
5136      {
5137        r->block0[j]=rOppVar(r, src->block1[i]);
5138        r->block1[j]=rOppVar(r, src->block0[i]);
5139        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5140        if (src->order[i+1]==ringorder_ls)
5141        {
5142          r->order[j]=ringorder_wp;
5143          i++;
5144          //l=rReallocM1(r,src,l,j);
5145        }
5146        else
5147        {
5148          r->order[j]=ringorder_a;
5149        }
5150        j++;
5151        break;
5152      }
5153      // not yet done:
5154      case ringorder_ls:
5155      case ringorder_rs:
5156      case ringorder_ds:
5157      case ringorder_Ds:
5158      case ringorder_ws:
5159      case ringorder_Ws:
5160      // should not occur:
5161      case ringorder_S:
5162      case ringorder_IS:
5163      case ringorder_s:
5164      case ringorder_aa:
5165      case ringorder_L:
5166      case ringorder_unspec:
5167        Werror("order %s not (yet) supported", rSimpleOrdStr(src->order[i]));
5168        break;
5169    }
5170  }
5171  rComplete(r);
5172
5173
5174#ifdef RDEBUG
5175  rTest(r);
5176#endif
5177
5178  //rChangeCurrRing(r);
5179
5180#ifdef RDEBUG
5181  rTest(r);
5182//  rWrite(r);
5183//  rDebugPrint(r);
5184#endif
5185
5186
5187#ifdef HAVE_PLURAL
5188  // now, we initialize a non-comm structure on r
5189  if (rIsPluralRing(src))
5190  {
5191//    assume( currRing == r);
5192
5193    int *perm       = (int *)omAlloc0((rVar(r)+1)*sizeof(int));
5194    int *par_perm   = NULL;
5195    nMapFunc nMap   = n_SetMap(src->cf,r->cf);
5196    int ni,nj;
5197    for(i=1; i<=r->N; i++)
5198    {
5199      perm[i] = rOppVar(r,i);
5200    }
5201
5202    matrix C = mpNew(rVar(r),rVar(r));
5203    matrix D = mpNew(rVar(r),rVar(r));
5204
5205    for (i=1; i< rVar(r); i++)
5206    {
5207      for (j=i+1; j<=rVar(r); j++)
5208      {
5209        ni = r->N +1 - i;
5210        nj = r->N +1 - j; /* i<j ==>   nj < ni */
5211
5212        assume(MATELEM(src->GetNC()->C,i,j) != NULL);
5213        MATELEM(C,nj,ni) = p_PermPoly(MATELEM(src->GetNC()->C,i,j),perm,src,r, nMap,par_perm,rPar(src));
5214
5215        if(MATELEM(src->GetNC()->D,i,j) != NULL)
5216          MATELEM(D,nj,ni) = p_PermPoly(MATELEM(src->GetNC()->D,i,j),perm,src,r, nMap,par_perm,rPar(src));
5217      }
5218    }
5219
5220    id_Test((ideal)C, r);
5221    id_Test((ideal)D, r);
5222
5223    if (nc_CallPlural(C, D, NULL, NULL, r, false, false, true, r)) // no qring setup!
5224      WarnS("Error initializing non-commutative multiplication!");
5225
5226#ifdef RDEBUG
5227    rTest(r);
5228//    rWrite(r);
5229//    rDebugPrint(r);
5230#endif
5231
5232    assume( r->GetNC()->IsSkewConstant == src->GetNC()->IsSkewConstant);
5233
5234    omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
5235  }
5236#endif /* HAVE_PLURAL */
5237
5238  /* now oppose the qideal for qrings */
5239  if (src->qideal != NULL)
5240  {
5241    id_Delete(&(r->qideal), r);
5242
5243#ifdef HAVE_PLURAL
5244    r->qideal = idOppose(src, src->qideal, r); // into the currRing: r
5245#else
5246    r->qideal = id_Copy(src->qideal, r); // ?
5247#endif
5248
5249#ifdef HAVE_PLURAL
5250    if( rIsPluralRing(r) )
5251    {
5252      nc_SetupQuotient(r);
5253#ifdef RDEBUG
5254      rTest(r);
5255//      rWrite(r);
5256//      rDebugPrint(r);
5257#endif
5258    }
5259#endif
5260  }
5261#ifdef HAVE_PLURAL
5262  if( rIsPluralRing(r) )
5263    assume( ncRingType(r) == ncRingType(src) );
5264#endif
5265  rTest(r);
5266
5267  return r;
5268}
5269
5270ring rEnvelope(ring R)
5271  /* creates an enveloping algebra of R */
5272  /* that is R^e = R \tensor_K R^opp */
5273{
5274  ring Ropp = rOpposite(R);
5275  ring Renv = NULL;
5276  int stat = rSum(R, Ropp, Renv); /* takes care of qideals */
5277  if ( stat <=0 )
5278    WarnS("Error in rEnvelope at rSum");
5279  rTest(Renv);
5280  return Renv;
5281}
5282
5283#ifdef HAVE_PLURAL
5284BOOLEAN nc_rComplete(const ring src, ring dest, bool bSetupQuotient)
5285/* returns TRUE is there were errors */
5286/* dest is actualy equals src with the different ordering */
5287/* we map src->nc correctly to dest->src */
5288/* to be executed after rComplete, before rChangeCurrRing */
5289{
5290// NOTE: Originally used only by idElimination to transfer NC structure to dest
5291// ring created by dirty hack (without nc_CallPlural)
5292  rTest(src);
5293
5294  assume(!rIsPluralRing(dest)); // destination must be a newly constructed commutative ring
5295
5296  if (!rIsPluralRing(src))
5297  {
5298    return FALSE;
5299  }
5300
5301  const int N = dest->N;
5302
5303  assume(src->N == N);
5304
5305//  ring save = currRing;
5306
5307//  if (dest != save)
5308//    rChangeCurrRing(dest);
5309
5310  const ring srcBase = src;
5311
5312  assume( n_SetMap(srcBase->cf,dest->cf) == n_SetMap(dest->cf,dest->cf) ); // currRing is important here!
5313
5314  matrix C = mpNew(N,N); // ring independent
5315  matrix D = mpNew(N,N);
5316
5317  matrix C0 = src->GetNC()->C;
5318  matrix D0 = src->GetNC()->D;
5319
5320  // map C and D into dest
5321  for (int i = 1; i < N; i++)
5322  {
5323    for (int j = i + 1; j <= N; j++)
5324    {
5325      const number n = n_Copy(p_GetCoeff(MATELEM(C0,i,j), srcBase), srcBase->cf); // src, mapping for coeffs into currRing = dest!
5326      const poly   p = p_NSet(n, dest);
5327      MATELEM(C,i,j) = p;
5328      if (MATELEM(D0,i,j) != NULL)
5329        MATELEM(D,i,j) = prCopyR(MATELEM(D0,i,j), srcBase, dest); // ?
5330    }
5331  }
5332  /* One must test C and D _only_ in r->GetNC()->basering!!! not in r!!! */
5333
5334  id_Test((ideal)C, dest);
5335  id_Test((ideal)D, dest);
5336
5337  if (nc_CallPlural(C, D, NULL, NULL, dest, bSetupQuotient, false, true, dest)) // also takes care about quotient ideal
5338  {
5339    //WarnS("Error transferring non-commutative structure");
5340    // error message should be in the interpreter interface
5341
5342    mp_Delete(&C, dest);
5343    mp_Delete(&D, dest);
5344
5345//    if (currRing != save)
5346//       rChangeCurrRing(save);
5347
5348    return TRUE;
5349  }
5350
5351//  mp_Delete(&C, dest); // used by nc_CallPlural!
5352//  mp_Delete(&D, dest);
5353
5354//  if (dest != save)
5355//    rChangeCurrRing(save);
5356
5357  assume(rIsPluralRing(dest));
5358  return FALSE;
5359}
5360#endif
5361
5362void rModify_a_to_A(ring r)
5363// to be called BEFORE rComplete:
5364// changes every Block with a(...) to A(...)
5365{
5366   int i=0;
5367   int j;
5368   while(r->order[i]!=0)
5369   {
5370      if (r->order[i]==ringorder_a)
5371      {
5372        r->order[i]=ringorder_a64;
5373        int *w=r->wvhdl[i];
5374        int64 *w64=(int64 *)omAlloc((r->block1[i]-r->block0[i]+1)*sizeof(int64));
5375        for(j=r->block1[i]-r->block0[i];j>=0;j--)
5376                w64[j]=(int64)w[j];
5377        r->wvhdl[i]=(int*)w64;
5378        omFreeSize(w,(r->block1[i]-r->block0[i]+1)*sizeof(int));
5379      }
5380      i++;
5381   }
5382}
Note: See TracBrowser for help on using the repository browser.