source: git/kernel/ring.cc @ 6e3f48

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