source: git/kernel/ring.cc @ 37318d

spielwiese
Last change on this file since 37318d was c90b43, checked in by Hans Schönemann <hannes@…>, 15 years ago
*hannes: HAVE_RINGS only git-svn-id: file:///usr/local/Singular/svn/trunk@11781 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.117 2009-05-06 12:53:49 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  omCheckAddrSize(r->wvhdl,i*sizeof(int *));
2013  for (j=0;j<i; j++)
2014  {
2015    if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
2016  }
2017#endif
2018  if (r->VarOffset == NULL)
2019  {
2020    dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
2021    return FALSE;
2022  }
2023  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
2024
2025  if ((r->OrdSize==0)!=(r->typ==NULL))
2026  {
2027    dReportError("mismatch OrdSize and typ-pointer in %s:%d");
2028    return FALSE;
2029  }
2030  omcheckAddrSize(r->typ,r->OrdSize*sizeof(*(r->typ)));
2031  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(*(r->VarOffset)));
2032  // test assumptions:
2033  for(i=0;i<=r->N;i++)
2034  {
2035    if(r->typ!=NULL)
2036    {
2037      for(j=0;j<r->OrdSize;j++)
2038      {
2039        if (r->typ[j].ord_typ==ro_cp)
2040        {
2041          if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
2042            dReportError("ordrec %d conflicts with var %d",j,i);
2043        }
2044        else
2045          if ((r->typ[j].ord_typ!=ro_syzcomp)
2046          && (r->VarOffset[i] == r->typ[j].data.dp.place))
2047            dReportError("ordrec %d conflicts with var %d",j,i);
2048      }
2049    }
2050    int tmp;
2051      tmp=r->VarOffset[i] & 0xffffff;
2052      #if SIZEOF_LONG == 8
2053        if ((r->VarOffset[i] >> 24) >63)
2054      #else
2055        if ((r->VarOffset[i] >> 24) >31)
2056      #endif
2057          dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
2058      if (i > 0 && ((tmp<0) ||(tmp>r->ExpL_Size-1)))
2059      {
2060        dReportError("varoffset out of range for var %d: %d",i,tmp);
2061      }
2062  }
2063  if(r->typ!=NULL)
2064  {
2065    for(j=0;j<r->OrdSize;j++)
2066    {
2067      if ((r->typ[j].ord_typ==ro_dp)
2068      || (r->typ[j].ord_typ==ro_wp)
2069      || (r->typ[j].ord_typ==ro_wp_neg))
2070      {
2071        if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
2072          dReportError("in ordrec %d: start(%d) > end(%d)",j,
2073            r->typ[j].data.dp.start, r->typ[j].data.dp.end);
2074        if ((r->typ[j].data.dp.start < 1)
2075        || (r->typ[j].data.dp.end > r->N))
2076          dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
2077            r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
2078      }
2079    }
2080  }
2081  if (r->minpoly!=NULL)
2082  {
2083    omCheckAddr(r->minpoly);
2084  }
2085  //assume(r->cf!=NULL);
2086
2087  return TRUE;
2088}
2089#endif
2090
2091static void rO_Align(int &place, int &bitplace)
2092{
2093  // increment place to the next aligned one
2094  // (count as Exponent_t,align as longs)
2095  if (bitplace!=BITS_PER_LONG)
2096  {
2097    place++;
2098    bitplace=BITS_PER_LONG;
2099  }
2100}
2101
2102static void rO_TDegree(int &place, int &bitplace, int start, int end,
2103    long *o, sro_ord &ord_struct)
2104{
2105  // degree (aligned) of variables v_start..v_end, ordsgn 1
2106  rO_Align(place,bitplace);
2107  ord_struct.ord_typ=ro_dp;
2108  ord_struct.data.dp.start=start;
2109  ord_struct.data.dp.end=end;
2110  ord_struct.data.dp.place=place;
2111  o[place]=1;
2112  place++;
2113  rO_Align(place,bitplace);
2114}
2115
2116static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2117    long *o, sro_ord &ord_struct)
2118{
2119  // degree (aligned) of variables v_start..v_end, ordsgn -1
2120  rO_Align(place,bitplace);
2121  ord_struct.ord_typ=ro_dp;
2122  ord_struct.data.dp.start=start;
2123  ord_struct.data.dp.end=end;
2124  ord_struct.data.dp.place=place;
2125  o[place]=-1;
2126  place++;
2127  rO_Align(place,bitplace);
2128}
2129
2130static void rO_WDegree(int &place, int &bitplace, int start, int end,
2131    long *o, sro_ord &ord_struct, int *weights)
2132{
2133  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2134  while((start<end) && (weights[0]==0)) { start++; weights++; }
2135  while((start<end) && (weights[end-start]==0)) { end--; }
2136  int i;
2137  int pure_tdeg=1;
2138  for(i=start;i<=end;i++)
2139  {
2140    if(weights[i-start]!=1)
2141    {
2142      pure_tdeg=0;
2143      break;
2144    }
2145  }
2146  if (pure_tdeg)
2147  {
2148    rO_TDegree(place,bitplace,start,end,o,ord_struct);
2149    return;
2150  }
2151  rO_Align(place,bitplace);
2152  ord_struct.ord_typ=ro_wp;
2153  ord_struct.data.wp.start=start;
2154  ord_struct.data.wp.end=end;
2155  ord_struct.data.wp.place=place;
2156  ord_struct.data.wp.weights=weights;
2157  o[place]=1;
2158  place++;
2159  rO_Align(place,bitplace);
2160  for(i=start;i<=end;i++)
2161  {
2162    if(weights[i-start]<0)
2163    {
2164      ord_struct.ord_typ=ro_wp_neg;
2165      break;
2166    }
2167  }
2168}
2169
2170static void rO_WDegree64(int &place, int &bitplace, int start, int end,
2171    long *o, sro_ord &ord_struct, int64 *weights)
2172{
2173  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1,
2174  // reserved 2 places
2175  rO_Align(place,bitplace);
2176  ord_struct.ord_typ=ro_wp64;
2177  ord_struct.data.wp64.start=start;
2178  ord_struct.data.wp64.end=end;
2179  ord_struct.data.wp64.place=place;
2180  ord_struct.data.wp64.weights64=weights;
2181  o[place]=1;
2182  place++;
2183  o[place]=1;
2184  place++;
2185  rO_Align(place,bitplace);
2186  int i;
2187}
2188
2189static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2190    long *o, sro_ord &ord_struct, int *weights)
2191{
2192  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2193  while((start<end) && (weights[0]==0)) { start++; weights++; }
2194  while((start<end) && (weights[end-start]==0)) { end--; }
2195  rO_Align(place,bitplace);
2196  ord_struct.ord_typ=ro_wp;
2197  ord_struct.data.wp.start=start;
2198  ord_struct.data.wp.end=end;
2199  ord_struct.data.wp.place=place;
2200  ord_struct.data.wp.weights=weights;
2201  o[place]=-1;
2202  place++;
2203  rO_Align(place,bitplace);
2204  int i;
2205  for(i=start;i<=end;i++)
2206  {
2207    if(weights[i-start]<0)
2208    {
2209      ord_struct.ord_typ=ro_wp_neg;
2210      break;
2211    }
2212  }
2213}
2214
2215static void rO_LexVars(int &place, int &bitplace, int start, int end,
2216  int &prev_ord, long *o,int *v, int bits, int opt_var)
2217{
2218  // a block of variables v_start..v_end with lex order, ordsgn 1
2219  int k;
2220  int incr=1;
2221  if(prev_ord==-1) rO_Align(place,bitplace);
2222
2223  if (start>end)
2224  {
2225    incr=-1;
2226  }
2227  for(k=start;;k+=incr)
2228  {
2229    bitplace-=bits;
2230    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2231    o[place]=1;
2232    v[k]= place | (bitplace << 24);
2233    if (k==end) break;
2234  }
2235  prev_ord=1;
2236  if (opt_var!= -1)
2237  {
2238    assume((opt_var == end+1) ||(opt_var == end-1));
2239    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
2240    int save_bitplace=bitplace;
2241    bitplace-=bits;
2242    if (bitplace < 0)
2243    {
2244      bitplace=save_bitplace;
2245      return;
2246    }
2247    // there is enough space for the optional var
2248    v[opt_var]=place | (bitplace << 24);
2249  }
2250}
2251
2252static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2253  int &prev_ord, long *o,int *v, int bits, int opt_var)
2254{
2255  // a block of variables v_start..v_end with lex order, ordsgn -1
2256  int k;
2257  int incr=1;
2258  if(prev_ord==1) rO_Align(place,bitplace);
2259
2260  if (start>end)
2261  {
2262    incr=-1;
2263  }
2264  for(k=start;;k+=incr)
2265  {
2266    bitplace-=bits;
2267    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2268    o[place]=-1;
2269    v[k]=place | (bitplace << 24);
2270    if (k==end) break;
2271  }
2272  prev_ord=-1;
2273//  #if 0
2274  if (opt_var!= -1)
2275  {
2276    assume((opt_var == end+1) ||(opt_var == end-1));
2277    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
2278    int save_bitplace=bitplace;
2279    bitplace-=bits;
2280    if (bitplace < 0)
2281    {
2282      bitplace=save_bitplace;
2283      return;
2284    }
2285    // there is enough space for the optional var
2286    v[opt_var]=place | (bitplace << 24);
2287  }
2288//  #endif
2289}
2290
2291static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2292    long *o, sro_ord &ord_struct)
2293{
2294  // ordering is derived from component number
2295  rO_Align(place,bitplace);
2296  ord_struct.ord_typ=ro_syzcomp;
2297  ord_struct.data.syzcomp.place=place;
2298  ord_struct.data.syzcomp.Components=NULL;
2299  ord_struct.data.syzcomp.ShiftedComponents=NULL;
2300  o[place]=1;
2301  prev_ord=1;
2302  place++;
2303  rO_Align(place,bitplace);
2304}
2305
2306static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2307    long *o, sro_ord &ord_struct)
2308{
2309  // ordering is derived from component number
2310  // let's reserve one Exponent_t for it
2311  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
2312    rO_Align(place,bitplace);
2313  ord_struct.ord_typ=ro_syz;
2314  ord_struct.data.syz.place=place;
2315  ord_struct.data.syz.limit=0;
2316  ord_struct.data.syz.syz_index = NULL;
2317  ord_struct.data.syz.curr_index = 1;
2318  o[place]= -1;
2319  prev_ord=-1;
2320  place++;
2321}
2322
2323static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
2324{
2325  if (bitmask == 0)
2326  {
2327    bits=16; bitmask=0xffff;
2328  }
2329  else if (bitmask <= 1)
2330  {
2331    bits=1; bitmask = 1;
2332  }
2333  else if (bitmask <= 3)
2334  {
2335    bits=2; bitmask = 3;
2336  }
2337  else if (bitmask <= 7)
2338  {
2339    bits=3; bitmask=7;
2340  }
2341  else if (bitmask <= 0xf)
2342  {
2343    bits=4; bitmask=0xf;
2344  }
2345  else if (bitmask <= 0x1f)
2346  {
2347    bits=5; bitmask=0x1f;
2348  }
2349  else if (bitmask <= 0x3f)
2350  {
2351    bits=6; bitmask=0x3f;
2352  }
2353#if SIZEOF_LONG == 8
2354  else if (bitmask <= 0x7f)
2355  {
2356    bits=7; bitmask=0x7f; /* 64 bit longs only */
2357  }
2358#endif
2359  else if (bitmask <= 0xff)
2360  {
2361    bits=8; bitmask=0xff;
2362  }
2363#if SIZEOF_LONG == 8
2364  else if (bitmask <= 0x1ff)
2365  {
2366    bits=9; bitmask=0x1ff; /* 64 bit longs only */
2367  }
2368#endif
2369  else if (bitmask <= 0x3ff)
2370  {
2371    bits=10; bitmask=0x3ff;
2372  }
2373#if SIZEOF_LONG == 8
2374  else if (bitmask <= 0xfff)
2375  {
2376    bits=12; bitmask=0xfff; /* 64 bit longs only */
2377  }
2378#endif
2379  else if (bitmask <= 0xffff)
2380  {
2381    bits=16; bitmask=0xffff;
2382  }
2383#if SIZEOF_LONG == 8
2384  else if (bitmask <= 0xfffff)
2385  {
2386    bits=20; bitmask=0xfffff; /* 64 bit longs only */
2387  }
2388  else if (bitmask <= 0xffffffff)
2389  {
2390    bits=32; bitmask=0xffffffff;
2391  }
2392  else
2393  {
2394    bits=64; bitmask=0xffffffffffffffff;
2395  }
2396#else
2397  else
2398  {
2399    bits=32; bitmask=0xffffffff;
2400  }
2401#endif
2402  return bitmask;
2403}
2404
2405/*2
2406* optimize rGetExpSize for a block of N variables, exp <=bitmask
2407*/
2408static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
2409{
2410  bitmask =rGetExpSize(bitmask, bits);
2411  int vars_per_long=BIT_SIZEOF_LONG/bits;
2412  int bits1;
2413  loop
2414  {
2415    if (bits == BIT_SIZEOF_LONG)
2416    {
2417      bits =  BIT_SIZEOF_LONG - 1;
2418      return LONG_MAX;
2419    }
2420    unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
2421    int vars_per_long1=BIT_SIZEOF_LONG/bits1;
2422    if ((((N+vars_per_long-1)/vars_per_long) ==
2423         ((N+vars_per_long1-1)/vars_per_long1)))
2424    {
2425      vars_per_long=vars_per_long1;
2426      bits=bits1;
2427      bitmask=bitmask1;
2428    }
2429    else
2430    {
2431      return bitmask; /* and bits */
2432    }
2433  }
2434}
2435
2436/*2
2437 * create a copy of the ring r, which must be equivalent to currRing
2438 * used for std computations
2439 * may share data structures with currRing
2440 * DOES CALL rComplete
2441 */
2442ring rModifyRing(ring r, BOOLEAN omit_degree,
2443                         BOOLEAN omit_comp,
2444                         unsigned long exp_limit)
2445{
2446  assume (r != NULL );
2447  assume (exp_limit > 1);
2448  BOOLEAN need_other_ring;
2449  BOOLEAN omitted_degree = FALSE;
2450  int bits;
2451
2452  exp_limit=rGetExpSize(exp_limit, bits, r->N);
2453  need_other_ring = (exp_limit != r->bitmask);
2454
2455  int nblocks=rBlocks(r);
2456  int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2457  int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2458  int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2459  int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
2460
2461  int i=0;
2462  int j=0; /*  i index in r, j index in res */
2463  loop
2464  {
2465    BOOLEAN copy_block_index=TRUE;
2466    int r_ord=r->order[i];
2467    if (r->block0[i]==r->block1[i])
2468    {
2469      switch(r_ord)
2470      {
2471        case ringorder_wp:
2472        case ringorder_dp:
2473        case ringorder_Wp:
2474        case ringorder_Dp:
2475          r_ord=ringorder_lp;
2476          break;
2477        case ringorder_Ws:
2478        case ringorder_Ds:
2479        case ringorder_ws:
2480        case ringorder_ds:
2481          r_ord=ringorder_ls;
2482          break;
2483        default:
2484          break;
2485      }
2486    }
2487    switch(r_ord)
2488    {
2489      case ringorder_C:
2490      case ringorder_c:
2491        if (!omit_comp)
2492        {
2493          order[j]=r_ord; /*r->order[i]*/;
2494        }
2495        else
2496        {
2497          j--;
2498          need_other_ring=TRUE;
2499          omit_comp=FALSE;
2500          copy_block_index=FALSE;
2501        }
2502        break;
2503      case ringorder_wp:
2504      case ringorder_dp:
2505      case ringorder_ws:
2506      case ringorder_ds:
2507        if(!omit_degree)
2508        {
2509          order[j]=r_ord; /*r->order[i]*/;
2510        }
2511        else
2512        {
2513          order[j]=ringorder_rs;
2514          need_other_ring=TRUE;
2515          omit_degree=FALSE;
2516          omitted_degree = TRUE;
2517        }
2518        break;
2519      case ringorder_Wp:
2520      case ringorder_Dp:
2521      case ringorder_Ws:
2522      case ringorder_Ds:
2523        if(!omit_degree)
2524        {
2525          order[j]=r_ord; /*r->order[i];*/
2526        }
2527        else
2528        {
2529          order[j]=ringorder_lp;
2530          need_other_ring=TRUE;
2531          omit_degree=FALSE;
2532          omitted_degree = TRUE;
2533        }
2534        break;
2535      default:
2536        order[j]=r_ord; /*r->order[i];*/
2537        break;
2538    }
2539    if (copy_block_index)
2540    {
2541      block0[j]=r->block0[i];
2542      block1[j]=r->block1[i];
2543      wvhdl[j]=r->wvhdl[i];
2544    }
2545    i++;j++;
2546    // order[j]=ringorder_no; //  done by omAlloc0
2547    if (i==nblocks) break;
2548  }
2549  if(!need_other_ring)
2550  {
2551    omFreeSize(order,(nblocks+1)*sizeof(int));
2552    omFreeSize(block0,(nblocks+1)*sizeof(int));
2553    omFreeSize(block1,(nblocks+1)*sizeof(int));
2554    omFreeSize(wvhdl,(nblocks+1)*sizeof(int_ptr));
2555    return r;
2556  }
2557  ring res=(ring)omAlloc0Bin(ip_sring_bin);
2558  *res = *r;
2559
2560#ifdef HAVE_PLURAL
2561  res->GetNC() = NULL;
2562#endif
2563
2564  // res->qideal, res->idroot ???
2565  res->wvhdl=wvhdl;
2566  res->order=order;
2567  res->block0=block0;
2568  res->block1=block1;
2569  res->bitmask=exp_limit;
2570  int tmpref=r->cf->ref;
2571  rComplete(res, 1);
2572  r->cf->ref=tmpref;
2573
2574  // adjust res->pFDeg: if it was changed globally, then
2575  // it must also be changed for new ring
2576  if (r->pFDegOrig != res->pFDegOrig &&
2577           rOrd_is_WeightedDegree_Ordering(r))
2578  {
2579    // still might need adjustment for weighted orderings
2580    // and omit_degree
2581    res->firstwv = r->firstwv;
2582    res->firstBlockEnds = r->firstBlockEnds;
2583    res->pFDeg = res->pFDegOrig = pWFirstTotalDegree;
2584  }
2585  if (omitted_degree)
2586    res->pLDeg = res->pLDegOrig = r->pLDegOrig;
2587
2588  rOptimizeLDeg(res);
2589
2590  // set syzcomp
2591  if (res->typ != NULL && res->typ[0].ord_typ == ro_syz)
2592  {
2593    res->typ[0] = r->typ[0];
2594    if (r->typ[0].data.syz.limit > 0)
2595    {
2596      res->typ[0].data.syz.syz_index
2597        = (int*) omAlloc((r->typ[0].data.syz.limit +1)*sizeof(int));
2598      memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2599             (r->typ[0].data.syz.limit +1)*sizeof(int));
2600    }
2601  }
2602  // the special case: homog (omit_degree) and 1 block rs: that is global:
2603  // it comes from dp
2604  res->OrdSgn=r->OrdSgn;
2605
2606
2607#ifdef HAVE_PLURAL
2608  if (rIsPluralRing(r))
2609  {
2610    if ( nc_rComplete(r, res, false) ) // no qideal!
2611    {
2612      WarnS("error in nc_rComplete");
2613      // cleanup?
2614
2615//      rDelete(res);
2616//      return r;
2617
2618      // just go on..
2619    }
2620  }
2621#endif
2622
2623  return res;
2624}
2625
2626// construct Wp,C ring
2627ring rModifyRing_Wp(ring r, int* weights)
2628{
2629  ring res=(ring)omAlloc0Bin(ip_sring_bin);
2630  *res = *r;
2631#ifdef HAVE_PLURAL
2632  res->GetNC() = NULL;
2633#endif
2634
2635  /*weights: entries for 3 blocks: NULL*/
2636  res->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
2637  /*order: Wp,C,0*/
2638  res->order = (int *) omAlloc(3 * sizeof(int *));
2639  res->block0 = (int *)omAlloc0(3 * sizeof(int *));
2640  res->block1 = (int *)omAlloc0(3 * sizeof(int *));
2641  /* ringorder Wp for the first block: var 1..r->N */
2642  res->order[0]  = ringorder_Wp;
2643  res->block0[0] = 1;
2644  res->block1[0] = r->N;
2645  res->wvhdl[0] = weights;
2646  /* ringorder C for the second block: no vars */
2647  res->order[1]  = ringorder_C;
2648  /* the last block: everything is 0 */
2649  res->order[2]  = 0;
2650  /*polynomial ring*/
2651  res->OrdSgn    = 1;
2652
2653  int tmpref=r->cf->ref;
2654  rComplete(res, 1);
2655  r->cf->ref=tmpref;
2656#ifdef HAVE_PLURAL
2657  if (rIsPluralRing(r))
2658  {
2659    if ( nc_rComplete(r, res, false) ) // no qideal!
2660    {
2661      WarnS("error in nc_rComplete");
2662      // cleanup?
2663
2664//      rDelete(res);
2665//      return r;
2666
2667      // just go on..
2668    }
2669  }
2670#endif
2671  return res;
2672}
2673
2674// construct lp ring with r->N variables, r->names vars....
2675ring rModifyRing_Simple(ring r, BOOLEAN ommit_degree, BOOLEAN ommit_comp, unsigned long exp_limit, BOOLEAN &simple)
2676{
2677  simple=TRUE;
2678  if (!rHasSimpleOrder(r))
2679  {
2680    simple=FALSE; // sorting needed
2681    assume (r != NULL );
2682    assume (exp_limit > 1);
2683    BOOLEAN omitted_degree = FALSE;
2684    int bits;
2685
2686    exp_limit=rGetExpSize(exp_limit, bits, r->N);
2687
2688    int nblocks=1+(ommit_comp!=0);
2689    int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2690    int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2691    int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2692    int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
2693
2694    order[0]=ringorder_lp;
2695    block0[0]=1;
2696    block1[0]=r->N;
2697    if (!ommit_comp)
2698    {
2699      order[1]=ringorder_C;
2700    }
2701    ring res=(ring)omAlloc0Bin(ip_sring_bin);
2702    *res = *r;
2703#ifdef HAVE_PLURAL
2704    res->GetNC() = NULL;
2705#endif
2706    // res->qideal, res->idroot ???
2707    res->wvhdl=wvhdl;
2708    res->order=order;
2709    res->block0=block0;
2710    res->block1=block1;
2711    res->bitmask=exp_limit;
2712    int tmpref=r->cf->ref;
2713    rComplete(res, 1);
2714    r->cf->ref=tmpref;
2715
2716#ifdef HAVE_PLURAL
2717    if (rIsPluralRing(r))
2718    {
2719      if ( nc_rComplete(r, res, false) ) // no qideal!
2720      {
2721        WarnS("error in nc_rComplete");
2722      // cleanup?
2723
2724//      rDelete(res);
2725//      return r;
2726
2727      // just go on..
2728      }
2729    }
2730#endif
2731
2732    rOptimizeLDeg(res);
2733
2734    return res;
2735  }
2736  return rModifyRing(r, ommit_degree, ommit_comp, exp_limit);
2737}
2738
2739void rKillModifiedRing_Simple(ring r)
2740{
2741  rKillModifiedRing(r);
2742}
2743
2744
2745void rKillModifiedRing(ring r)
2746{
2747  rUnComplete(r);
2748  omFree(r->order);
2749  omFree(r->block0);
2750  omFree(r->block1);
2751  omFree(r->wvhdl);
2752  omFreeBin(r,ip_sring_bin);
2753}
2754
2755void rKillModified_Wp_Ring(ring r)
2756{
2757  rUnComplete(r);
2758  omFree(r->order);
2759  omFree(r->block0);
2760  omFree(r->block1);
2761  omFree(r->wvhdl[0]);
2762  omFree(r->wvhdl);
2763  omFreeBin(r,ip_sring_bin);
2764}
2765
2766static void rSetOutParams(ring r)
2767{
2768  r->VectorOut = (r->order[0] == ringorder_c);
2769  r->ShortOut = TRUE;
2770#ifdef HAVE_TCL
2771  if (tcllmode)
2772  {
2773    r->ShortOut = FALSE;
2774  }
2775  else
2776#endif
2777  {
2778    int i;
2779    if ((r->parameter!=NULL) && (r->ch<2))
2780    {
2781      for (i=0;i<rPar(r);i++)
2782      {
2783        if(strlen(r->parameter[i])>1)
2784        {
2785          r->ShortOut=FALSE;
2786          break;
2787        }
2788      }
2789    }
2790    if (r->ShortOut)
2791    {
2792      // Hmm... sometimes (e.g., from maGetPreimage) new variables
2793      // are intorduced, but their names are never set
2794      // hence, we do the following awkward trick
2795      int N = omSizeWOfAddr(r->names);
2796      if (r->N < N) N = r->N;
2797
2798      for (i=(N-1);i>=0;i--)
2799      {
2800        if(r->names[i] != NULL && strlen(r->names[i])>1)
2801        {
2802          r->ShortOut=FALSE;
2803          break;
2804        }
2805      }
2806    }
2807  }
2808  r->CanShortOut = r->ShortOut;
2809}
2810
2811/*2
2812* sets pMixedOrder and pComponentOrder for orderings with more than one block
2813* block of variables (ip is the block number, o_r the number of the ordering)
2814* o is the position of the orderingering in r
2815*/
2816static void rHighSet(ring r, int o_r, int o)
2817{
2818  switch(o_r)
2819  {
2820    case ringorder_lp:
2821    case ringorder_dp:
2822    case ringorder_Dp:
2823    case ringorder_wp:
2824    case ringorder_Wp:
2825    case ringorder_rp:
2826    case ringorder_a:
2827    case ringorder_aa:
2828    case ringorder_a64:
2829      if (r->OrdSgn==-1) r->MixedOrder=TRUE;
2830      break;
2831    case ringorder_ls:
2832    case ringorder_rs:
2833    case ringorder_ds:
2834    case ringorder_Ds:
2835    case ringorder_s:
2836      break;
2837    case ringorder_ws:
2838    case ringorder_Ws:
2839      if (r->wvhdl[o]!=NULL)
2840      {
2841        int i;
2842        for(i=r->block1[o]-r->block0[o];i>=0;i--)
2843          if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
2844      }
2845      break;
2846    case ringorder_c:
2847      r->ComponentOrder=1;
2848      break;
2849    case ringorder_C:
2850    case ringorder_S:
2851      r->ComponentOrder=-1;
2852      break;
2853    case ringorder_M:
2854      r->MixedOrder=TRUE;
2855      break;
2856    default:
2857      dReportError("wrong internal ordering:%d at %s, l:%d\n",o_r,__FILE__,__LINE__);
2858  }
2859}
2860
2861static void rSetFirstWv(ring r, int i, int* order, int* block1, int** wvhdl)
2862{
2863  // cheat for ringorder_aa
2864  if (order[i] == ringorder_aa)
2865    i++;
2866  if(block1[i]!=r->N) r->LexOrder=TRUE;
2867  r->firstBlockEnds=block1[i];
2868  r->firstwv = wvhdl[i];
2869  if ((order[i]== ringorder_ws)
2870  || (order[i]==ringorder_Ws)
2871  || (order[i]== ringorder_wp)
2872  || (order[i]==ringorder_Wp)
2873  || (order[i]== ringorder_a)
2874   /*|| (order[i]==ringorder_A)*/)
2875  {
2876    int j;
2877    for(j=block1[i]-r->block0[i];j>=0;j--)
2878    {
2879      if (r->firstwv[j]<0) r->MixedOrder=TRUE;
2880      if (r->firstwv[j]==0) r->LexOrder=TRUE;
2881    }
2882  }
2883  else if (order[i]==ringorder_a64)
2884  {
2885    int j;
2886    int64 *w=rGetWeightVec(r);
2887    for(j=block1[i]-r->block0[i];j>=0;j--)
2888    {
2889      if (w[j]==0) r->LexOrder=TRUE;
2890    }
2891  }
2892}
2893
2894static void rOptimizeLDeg(ring r)
2895{
2896  if (r->pFDeg == pDeg)
2897  {
2898    if (r->pLDeg == pLDeg1)
2899      r->pLDeg = pLDeg1_Deg;
2900    if (r->pLDeg == pLDeg1c)
2901      r->pLDeg = pLDeg1c_Deg;
2902  }
2903  else if (r->pFDeg == pTotaldegree)
2904  {
2905    if (r->pLDeg == pLDeg1)
2906      r->pLDeg = pLDeg1_Totaldegree;
2907    if (r->pLDeg == pLDeg1c)
2908      r->pLDeg = pLDeg1c_Totaldegree;
2909  }
2910  else if (r->pFDeg == pWFirstTotalDegree)
2911  {
2912    if (r->pLDeg == pLDeg1)
2913      r->pLDeg = pLDeg1_WFirstTotalDegree;
2914    if (r->pLDeg == pLDeg1c)
2915      r->pLDeg = pLDeg1c_WFirstTotalDegree;
2916  }
2917}
2918
2919// set pFDeg, pLDeg, MixOrder, ComponentOrder, etc
2920static void rSetDegStuff(ring r)
2921{
2922  int* order = r->order;
2923  int* block0 = r->block0;
2924  int* block1 = r->block1;
2925  int** wvhdl = r->wvhdl;
2926
2927  if (order[0]==ringorder_S ||order[0]==ringorder_s)
2928  {
2929    order++;
2930    block0++;
2931    block1++;
2932    wvhdl++;
2933  }
2934  r->LexOrder = FALSE;
2935  r->MixedOrder = FALSE;
2936  r->ComponentOrder = 1;
2937  r->pFDeg = pTotaldegree;
2938  r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
2939
2940  /*======== ordering type is (_,c) =========================*/
2941  if ((order[0]==ringorder_unspec) || (order[1] == 0)
2942      ||(
2943    ((order[1]==ringorder_c)||(order[1]==ringorder_C)
2944     ||(order[1]==ringorder_S)
2945     ||(order[1]==ringorder_s))
2946    && (order[0]!=ringorder_M)
2947    && (order[2]==0))
2948    )
2949  {
2950    if ((order[0]!=ringorder_unspec)
2951    && ((order[1]==ringorder_C)||(order[1]==ringorder_S)||
2952        (order[1]==ringorder_s)))
2953      r->ComponentOrder=-1;
2954    if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
2955    if ((order[0] == ringorder_lp)
2956    || (order[0] == ringorder_ls)
2957    || (order[0] == ringorder_rp)
2958    || (order[0] == ringorder_rs))
2959    {
2960      r->LexOrder=TRUE;
2961      r->pLDeg = pLDeg1c;
2962      r->pFDeg = pTotaldegree;
2963    }
2964    if ((order[0] == ringorder_a)
2965    || (order[0] == ringorder_wp)
2966    || (order[0] == ringorder_Wp)
2967    || (order[0] == ringorder_ws)
2968    || (order[0] == ringorder_Ws))
2969      r->pFDeg = pWFirstTotalDegree;
2970    r->firstBlockEnds=block1[0];
2971    r->firstwv = wvhdl[0];
2972  }
2973  /*======== ordering type is (c,_) =========================*/
2974  else if (((order[0]==ringorder_c)
2975            ||(order[0]==ringorder_C)
2976            ||(order[0]==ringorder_S)
2977            ||(order[0]==ringorder_s))
2978  && (order[1]!=ringorder_M)
2979  &&  (order[2]==0))
2980  {
2981    if ((order[0]==ringorder_C)||(order[0]==ringorder_S)||
2982        order[0]==ringorder_s)
2983      r->ComponentOrder=-1;
2984    if ((order[1] == ringorder_lp)
2985    || (order[1] == ringorder_ls)
2986    || (order[1] == ringorder_rp)
2987    || order[1] == ringorder_rs)
2988    {
2989      r->LexOrder=TRUE;
2990      r->pLDeg = pLDeg1c;
2991      r->pFDeg = pTotaldegree;
2992    }
2993    r->firstBlockEnds=block1[1];
2994    r->firstwv = wvhdl[1];
2995    if ((order[1] == ringorder_a)
2996    || (order[1] == ringorder_wp)
2997    || (order[1] == ringorder_Wp)
2998    || (order[1] == ringorder_ws)
2999    || (order[1] == ringorder_Ws))
3000      r->pFDeg = pWFirstTotalDegree;
3001  }
3002  /*------- more than one block ----------------------*/
3003  else
3004  {
3005    if ((r->VectorOut)||(order[0]==ringorder_C)||(order[0]==ringorder_S)||(order[0]==ringorder_s))
3006    {
3007      rSetFirstWv(r, 1, order, block1, wvhdl);
3008    }
3009    else
3010      rSetFirstWv(r, 0, order, block1, wvhdl);
3011
3012    /*the number of orderings:*/
3013    int i = 0;
3014    while (order[++i] != 0);
3015    do
3016    {
3017      i--;
3018      rHighSet(r, order[i],i);
3019    }
3020    while (i != 0);
3021
3022    if ((order[0]!=ringorder_c)
3023        && (order[0]!=ringorder_C)
3024        && (order[0]!=ringorder_S)
3025        && (order[0]!=ringorder_s))
3026    {
3027      r->pLDeg = pLDeg1c;
3028    }
3029    else
3030    {
3031      r->pLDeg = pLDeg1;
3032    }
3033    r->pFDeg = pWTotaldegree; // may be improved: pTotaldegree for lp/dp/ls/.. blocks
3034  }
3035  if (rOrd_is_Totaldegree_Ordering(r) || rOrd_is_WeightedDegree_Ordering(r))
3036    r->pFDeg = pDeg;
3037
3038  r->pFDegOrig = r->pFDeg;
3039  r->pLDegOrig = r->pLDeg;
3040  rOptimizeLDeg(r);
3041}
3042
3043/*2
3044* set NegWeightL_Size, NegWeightL_Offset
3045*/
3046static void rSetNegWeight(ring r)
3047{
3048  int i,l;
3049  if (r->typ!=NULL)
3050  {
3051    l=0;
3052    for(i=0;i<r->OrdSize;i++)
3053    {
3054      if(r->typ[i].ord_typ==ro_wp_neg) l++;
3055    }
3056    if (l>0)
3057    {
3058      r->NegWeightL_Size=l;
3059      r->NegWeightL_Offset=(int *) omAlloc(l*sizeof(int));
3060      l=0;
3061      for(i=0;i<r->OrdSize;i++)
3062      {
3063        if(r->typ[i].ord_typ==ro_wp_neg)
3064        {
3065          r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
3066          l++;
3067        }
3068      }
3069      return;
3070    }
3071  }
3072  r->NegWeightL_Size = 0;
3073  r->NegWeightL_Offset = NULL;
3074}
3075
3076static void rSetOption(ring r)
3077{
3078  // set redthrough
3079  if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
3080    r->options |= Sy_bit(OPT_REDTHROUGH);
3081  else
3082    r->options &= ~Sy_bit(OPT_REDTHROUGH);
3083
3084  // set intStrategy
3085#ifdef HAVE_RINGS
3086  if (rField_is_Extension(r) || rField_is_Q(r) || rField_is_Ring(r))
3087#else
3088  if (rField_is_Extension(r) || rField_is_Q(r))
3089#endif
3090    r->options |= Sy_bit(OPT_INTSTRATEGY);
3091  else
3092    r->options &= ~Sy_bit(OPT_INTSTRATEGY);
3093
3094  // set redTail
3095  if (r->LexOrder || r->OrdSgn == -1 || rField_is_Extension(r))
3096    r->options &= ~Sy_bit(OPT_REDTAIL);
3097  else
3098    r->options |= Sy_bit(OPT_REDTAIL);
3099}
3100
3101BOOLEAN rComplete(ring r, int force)
3102{
3103  if (r->VarOffset!=NULL && force == 0) return FALSE;
3104  nInitChar(r);
3105  rSetOutParams(r);
3106  int n=rBlocks(r)-1;
3107  int i;
3108  int bits;
3109  r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
3110  r->BitsPerExp = bits;
3111  r->ExpPerLong = BIT_SIZEOF_LONG / bits;
3112  r->divmask=rGetDivMask(bits);
3113
3114  // will be used for ordsgn:
3115  long *tmp_ordsgn=(long *)omAlloc0(3*(n+r->N)*sizeof(long));
3116  // will be used for VarOffset:
3117  int *v=(int *)omAlloc((r->N+1)*sizeof(int));
3118  for(i=r->N; i>=0 ; i--)
3119  {
3120    v[i]=-1;
3121  }
3122  sro_ord *tmp_typ=(sro_ord *)omAlloc0(3*(n+r->N)*sizeof(sro_ord));
3123  int typ_i=0;
3124  int prev_ordsgn=0;
3125
3126  // fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
3127  int j=0;
3128  int j_bits=BITS_PER_LONG;
3129  BOOLEAN need_to_add_comp=FALSE;
3130  for(i=0;i<n;i++)
3131  {
3132    tmp_typ[typ_i].order_index=i;
3133    switch (r->order[i])
3134    {
3135      case ringorder_a:
3136      case ringorder_aa:
3137        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3138                   r->wvhdl[i]);
3139        typ_i++;
3140        break;
3141
3142      case ringorder_a64:
3143        rO_WDegree64(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3144                     tmp_typ[typ_i], (int64 *)(r->wvhdl[i]));
3145        typ_i++;
3146        break;
3147
3148      case ringorder_c:
3149        rO_Align(j, j_bits);
3150        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3151        break;
3152
3153      case ringorder_C:
3154        rO_Align(j, j_bits);
3155        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3156        break;
3157
3158      case ringorder_M:
3159        {
3160          int k,l;
3161          k=r->block1[i]-r->block0[i]+1; // number of vars
3162          for(l=0;l<k;l++)
3163          {
3164            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3165                       tmp_typ[typ_i],
3166                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
3167            typ_i++;
3168          }
3169          break;
3170        }
3171
3172      case ringorder_lp:
3173        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3174                   tmp_ordsgn,v,bits, -1);
3175        break;
3176
3177      case ringorder_ls:
3178        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3179                       tmp_ordsgn,v, bits, -1);
3180        break;
3181
3182      case ringorder_rs:
3183        rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3184                       tmp_ordsgn,v, bits, -1);
3185        break;
3186
3187      case ringorder_rp:
3188        rO_LexVars(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3189                       tmp_ordsgn,v, bits, -1);
3190        break;
3191
3192      case ringorder_dp:
3193        if (r->block0[i]==r->block1[i])
3194        {
3195          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3196                     tmp_ordsgn,v, bits, -1);
3197        }
3198        else
3199        {
3200          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3201                     tmp_typ[typ_i]);
3202          typ_i++;
3203          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3204                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3205        }
3206        break;
3207
3208      case ringorder_Dp:
3209        if (r->block0[i]==r->block1[i])
3210        {
3211          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3212                     tmp_ordsgn,v, bits, -1);
3213        }
3214        else
3215        {
3216          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3217                     tmp_typ[typ_i]);
3218          typ_i++;
3219          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3220                     tmp_ordsgn,v, bits, r->block1[i]);
3221        }
3222        break;
3223
3224      case ringorder_ds:
3225        if (r->block0[i]==r->block1[i])
3226        {
3227          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
3228                         tmp_ordsgn,v,bits, -1);
3229        }
3230        else
3231        {
3232          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3233                         tmp_typ[typ_i]);
3234          typ_i++;
3235          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3236                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3237        }
3238        break;
3239
3240      case ringorder_Ds:
3241        if (r->block0[i]==r->block1[i])
3242        {
3243          rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
3244                         tmp_ordsgn,v, bits, -1);
3245        }
3246        else
3247        {
3248          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3249                         tmp_typ[typ_i]);
3250          typ_i++;
3251          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3252                     tmp_ordsgn,v, bits, r->block1[i]);
3253        }
3254        break;
3255
3256      case ringorder_wp:
3257        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3258                   tmp_typ[typ_i], r->wvhdl[i]);
3259        typ_i++;
3260        { // check for weights <=0
3261          int jj;
3262          BOOLEAN have_bad_weights=FALSE;
3263          for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3264          {
3265            if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3266          }
3267          if (have_bad_weights)
3268          {
3269             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3270                                     tmp_typ[typ_i]);
3271             typ_i++;
3272          }
3273        }
3274        if (r->block1[i]!=r->block0[i])
3275        {
3276          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3277                         tmp_ordsgn, v,bits, r->block0[i]);
3278        }
3279        break;
3280
3281      case ringorder_Wp:
3282        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3283                   tmp_typ[typ_i], r->wvhdl[i]);
3284        typ_i++;
3285        { // check for weights <=0
3286          int j;
3287          BOOLEAN have_bad_weights=FALSE;
3288          for(j=r->block1[i]-r->block0[i];j>=0; j--)
3289          {
3290            if (r->wvhdl[i][j]<=0) have_bad_weights=TRUE;
3291          }
3292          if (have_bad_weights)
3293          {
3294             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3295                                     tmp_typ[typ_i]);
3296             typ_i++;
3297          }
3298        }
3299        if (r->block1[i]!=r->block0[i])
3300        {
3301          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3302                     tmp_ordsgn,v, bits, r->block1[i]);
3303        }
3304        break;
3305
3306      case ringorder_ws:
3307        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3308                       tmp_typ[typ_i], r->wvhdl[i]);
3309        typ_i++;
3310        if (r->block1[i]!=r->block0[i])
3311        {
3312          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3313                         tmp_ordsgn, v,bits, r->block0[i]);
3314        }
3315        break;
3316
3317      case ringorder_Ws:
3318        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3319                       tmp_typ[typ_i], r->wvhdl[i]);
3320        typ_i++;
3321        if (r->block1[i]!=r->block0[i])
3322        {
3323          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3324                     tmp_ordsgn,v, bits, r->block1[i]);
3325        }
3326        break;
3327
3328      case ringorder_S:
3329        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3330        need_to_add_comp=TRUE;
3331        typ_i++;
3332        break;
3333
3334      case ringorder_s:
3335        rO_Syz(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3336        need_to_add_comp=TRUE;
3337        typ_i++;
3338        break;
3339
3340      case ringorder_unspec:
3341      case ringorder_no:
3342      default:
3343        dReportError("undef. ringorder used\n");
3344        break;
3345    }
3346  }
3347
3348  int j0=j; // save j
3349  int j_bits0=j_bits; // save jbits
3350  rO_Align(j,j_bits);
3351  r->CmpL_Size = j;
3352
3353  j_bits=j_bits0; j=j0;
3354
3355  // fill in some empty slots with variables not already covered
3356  // v0 is special, is therefore normally already covered
3357  // now we do have rings without comp...
3358  if((need_to_add_comp) && (v[0]== -1))
3359  {
3360    if (prev_ordsgn==1)
3361    {
3362      rO_Align(j, j_bits);
3363      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3364    }
3365    else
3366    {
3367      rO_Align(j, j_bits);
3368      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3369    }
3370  }
3371  // the variables
3372  for(i=1 ; i<=r->N ; i++)
3373  {
3374    if(v[i]==(-1))
3375    {
3376      if (prev_ordsgn==1)
3377      {
3378        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3379      }
3380      else
3381      {
3382        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3383      }
3384    }
3385  }
3386
3387  rO_Align(j,j_bits);
3388  // ----------------------------
3389  // finished with constructing the monomial, computing sizes:
3390
3391  r->ExpL_Size=j;
3392  r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
3393  assume(r->PolyBin != NULL);
3394
3395  // ----------------------------
3396  // indices and ordsgn vector for comparison
3397  //
3398  // r->pCompHighIndex already set
3399  r->ordsgn=(long *)omAlloc0(r->ExpL_Size*sizeof(long));
3400
3401  for(j=0;j<r->CmpL_Size;j++)
3402  {
3403    r->ordsgn[j] = tmp_ordsgn[j];
3404  }
3405
3406  omFreeSize((ADDRESS)tmp_ordsgn,(3*(n+r->N)*sizeof(long)));
3407
3408  // ----------------------------
3409  // description of orderings for setm:
3410  //
3411  r->OrdSize=typ_i;
3412  if (typ_i==0) r->typ=NULL;
3413  else
3414  {
3415    r->typ=(sro_ord*)omAlloc(typ_i*sizeof(sro_ord));
3416    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3417  }
3418  omFreeSize((ADDRESS)tmp_typ,(3*(n+r->N)*sizeof(sro_ord)));
3419
3420  // ----------------------------
3421  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3422  r->VarOffset=v;
3423
3424  // ----------------------------
3425  // other indicies
3426  r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
3427  i=0; // position
3428  j=0; // index in r->typ
3429  if (i==r->pCompIndex) i++;
3430  while ((j < r->OrdSize)
3431         && ((r->typ[j].ord_typ==ro_syzcomp) ||
3432             (r->typ[j].ord_typ==ro_syz) ||
3433             (r->order[r->typ[j].order_index] == ringorder_aa)))
3434  {
3435    i++; j++;
3436  }
3437  if (i==r->pCompIndex) i++;
3438  r->pOrdIndex=i;
3439
3440  // ----------------------------
3441  rSetDegStuff(r);
3442  rSetOption(r);
3443  // ----------------------------
3444  // r->p_Setm
3445  r->p_Setm = p_GetSetmProc(r);
3446
3447  // ----------------------------
3448  // set VarL_*
3449  rSetVarL(r);
3450
3451  //  ----------------------------
3452  // right-adjust VarOffset
3453  rRightAdjustVarOffset(r);
3454
3455  // ----------------------------
3456  // set NegWeightL*
3457  rSetNegWeight(r);
3458
3459  // ----------------------------
3460  // p_Procs: call AFTER NegWeightL
3461  r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
3462  p_ProcsSet(r, r->p_Procs);
3463  return FALSE;
3464}
3465
3466void rUnComplete(ring r)
3467{
3468  if (r == NULL) return;
3469  if (r->VarOffset != NULL)
3470  {
3471    if (r->PolyBin != NULL)
3472      omUnGetSpecBin(&(r->PolyBin));
3473
3474    omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3475    if (r->order != NULL)
3476    {
3477      if (r->order[0] == ringorder_s && r->typ[0].data.syz.limit > 0)
3478      {
3479        omFreeSize(r->typ[0].data.syz.syz_index,
3480             (r->typ[0].data.syz.limit +1)*sizeof(int));
3481      }
3482    }
3483    if (r->OrdSize!=0 && r->typ != NULL)
3484    {
3485      omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord));
3486    }
3487    if (r->ordsgn != NULL && r->CmpL_Size != 0)
3488      omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
3489    if (r->p_Procs != NULL)
3490      omFreeSize(r->p_Procs, sizeof(p_Procs_s));
3491    omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
3492  }
3493  if (r->NegWeightL_Offset!=NULL)
3494  {
3495    omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
3496    r->NegWeightL_Offset=NULL;
3497  }
3498}
3499
3500// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
3501static void rSetVarL(ring r)
3502{
3503  int  min = INT_MAX, min_j = -1;
3504  int* VarL_Number = (int*) omAlloc0(r->ExpL_Size*sizeof(int));
3505
3506  int i,j;
3507
3508  // count how often a var long is occupied by an exponent
3509  for (i=1; i<=r->N; i++)
3510  {
3511    VarL_Number[r->VarOffset[i] & 0xffffff]++;
3512  }
3513
3514  // determine how many and min
3515  for (i=0, j=0; i<r->ExpL_Size; i++)
3516  {
3517    if (VarL_Number[i] != 0)
3518    {
3519      if (min > VarL_Number[i])
3520      {
3521        min = VarL_Number[i];
3522        min_j = j;
3523      }
3524      j++;
3525    }
3526  }
3527
3528  r->VarL_Size = j; // number of long with exp. entries in
3529                    //  in p->exp
3530  r->VarL_Offset = (int*) omAlloc(r->VarL_Size*sizeof(int));
3531  r->VarL_LowIndex = 0;
3532
3533  // set VarL_Offset
3534  for (i=0, j=0; i<r->ExpL_Size; i++)
3535  {
3536    if (VarL_Number[i] != 0)
3537    {
3538      r->VarL_Offset[j] = i;
3539      if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
3540        r->VarL_LowIndex = -1;
3541      j++;
3542    }
3543  }
3544  if (r->VarL_LowIndex >= 0)
3545    r->VarL_LowIndex = r->VarL_Offset[0];
3546
3547  r->MinExpPerLong = min;
3548  if (min_j != 0)
3549  {
3550    j = r->VarL_Offset[min_j];
3551    r->VarL_Offset[min_j] = r->VarL_Offset[0];
3552    r->VarL_Offset[0] = j;
3553  }
3554  omFree(VarL_Number);
3555}
3556
3557static void rRightAdjustVarOffset(ring r)
3558{
3559  int* shifts = (int*) omAlloc(r->ExpL_Size*sizeof(int));
3560  int i;
3561  // initialize shifts
3562  for (i=0;i<r->ExpL_Size;i++)
3563    shifts[i] = BIT_SIZEOF_LONG;
3564
3565  // find minimal bit shift in each long exp entry
3566  for (i=1;i<=r->N;i++)
3567  {
3568    if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
3569      shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
3570  }
3571  // reset r->VarOffset: set the minimal shift to 0
3572  for (i=1;i<=r->N;i++)
3573  {
3574    if (shifts[r->VarOffset[i] & 0xffffff] != 0)
3575      r->VarOffset[i]
3576        = (r->VarOffset[i] & 0xffffff) |
3577        (((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
3578  }
3579  omFree(shifts);
3580}
3581
3582// get r->divmask depending on bits per exponent
3583static unsigned long rGetDivMask(int bits)
3584{
3585  unsigned long divmask = 1;
3586  int i = bits;
3587
3588  while (i < BIT_SIZEOF_LONG)
3589  {
3590    divmask |= (((unsigned long) 1) << (unsigned long) i);
3591    i += bits;
3592  }
3593  return divmask;
3594}
3595
3596#ifdef RDEBUG
3597void rDebugPrint(ring r)
3598{
3599  if (r==NULL)
3600  {
3601    PrintS("NULL ?\n");
3602    return;
3603  }
3604  // corresponds to ro_typ from ring.h:
3605  const char *TYP[]={"ro_dp","ro_wp","ro_wp64","ro_wp_neg","ro_cp",
3606                     "ro_syzcomp", "ro_syz", "ro_none"};
3607  int i,j;
3608
3609  Print("ExpL_Size:%d ",r->ExpL_Size);
3610  Print("CmpL_Size:%d ",r->CmpL_Size);
3611  Print("VarL_Size:%d\n",r->VarL_Size);
3612  Print("bitmask=0x%x (expbound=%d) \n",r->bitmask, r->bitmask);
3613  Print("BitsPerExp=%d ExpPerLong=%d MinExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->MinExpPerLong, r->VarL_Offset[0]);
3614  PrintS("varoffset:\n");
3615  if (r->VarOffset==NULL) PrintS(" NULL\n");
3616  else
3617    for(j=0;j<=r->N;j++)
3618      Print("  v%d at e-pos %d, bit %d\n",
3619            j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
3620  Print("divmask=%p\n", r->divmask);
3621  PrintS("ordsgn:\n");
3622  for(j=0;j<r->CmpL_Size;j++)
3623    Print("  ordsgn %d at pos %d\n",r->ordsgn[j],j);
3624  Print("OrdSgn:%d\n",r->OrdSgn);
3625  PrintS("ordrec:\n");
3626  for(j=0;j<r->OrdSize;j++)
3627  {
3628    Print("  typ %s",TYP[r->typ[j].ord_typ]);
3629    Print("  place %d",r->typ[j].data.dp.place);
3630    if (r->typ[j].ord_typ!=ro_syzcomp)
3631    {
3632      Print("  start %d",r->typ[j].data.dp.start);
3633      Print("  end %d",r->typ[j].data.dp.end);
3634      if ((r->typ[j].ord_typ==ro_wp)
3635      || (r->typ[j].ord_typ==ro_wp_neg))
3636      {
3637        Print(" w:");
3638        int l;
3639        for(l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
3640          Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
3641      }
3642      else if (r->typ[j].ord_typ==ro_wp64)
3643      {
3644        Print(" w64:");
3645        int l;
3646        for(l=r->typ[j].data.wp64.start;l<=r->typ[j].data.wp64.end;l++)
3647          Print(" %l",(long)(((int64*)r->typ[j].data.wp64.weights64)+l-r->typ[j].data.wp64.start));
3648      }
3649    }
3650    PrintLn();
3651  }
3652  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
3653  Print("OrdSize:%d\n",r->OrdSize);
3654  PrintS("--------------------\n");
3655  for(j=0;j<r->ExpL_Size;j++)
3656  {
3657    Print("L[%d]: ",j);
3658    if (j< r->CmpL_Size)
3659      Print("ordsgn %d ", r->ordsgn[j]);
3660    else
3661      PrintS("no comp ");
3662    i=1;
3663    for(;i<=r->N;i++)
3664    {
3665      if( (r->VarOffset[i] & 0xffffff) == j )
3666      {  Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
3667                                         r->VarOffset[i] >>24 ); }
3668    }
3669    if( r->pCompIndex==j ) PrintS("v0; ");
3670    for(i=0;i<r->OrdSize;i++)
3671    {
3672      if (r->typ[i].data.dp.place == j)
3673      {
3674        Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
3675          r->typ[i].data.dp.start, r->typ[i].data.dp.end);
3676      }
3677    }
3678
3679    if (j==r->pOrdIndex)
3680      PrintS("pOrdIndex\n");
3681    else
3682      PrintLn();
3683  }
3684
3685  // p_Procs stuff
3686  p_Procs_s proc_names;
3687  const char* field;
3688  const char* length;
3689  const char* ord;
3690  p_Debug_GetProcNames(r, &proc_names); // changes p_Procs!!!
3691  p_Debug_GetSpecNames(r, field, length, ord);
3692
3693  Print("p_Spec  : %s, %s, %s\n", field, length, ord);
3694  PrintS("p_Procs :\n");
3695  for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
3696  {
3697    Print(" %s,\n", ((char**) &proc_names)[i]);
3698  }
3699}
3700
3701void p_DebugPrint(poly p, const ring r)
3702{
3703  int i,j;
3704  p_Write(p,r);
3705  j=2;
3706  while(p!=NULL)
3707  {
3708    Print("\nexp[0..%d]\n",r->ExpL_Size-1);
3709    for(i=0;i<r->ExpL_Size;i++)
3710      Print("%ld ",p->exp[i]);
3711    PrintLn();
3712    Print("v0:%d ",p_GetComp(p, r));
3713    for(i=1;i<=r->N;i++) Print(" v%d:%d",i,p_GetExp(p,i, r));
3714    PrintLn();
3715    pIter(p);
3716    j--;
3717    if (j==0) { PrintS("...\n"); break; }
3718  }
3719}
3720
3721void pDebugPrint(poly p)
3722{
3723  p_DebugPrint(p, currRing);
3724}
3725#endif // RDEBUG
3726
3727
3728/*2
3729* asssume that rComplete was called with r
3730* assume that the first block ist ringorder_S
3731* change the block to reflect the sequence given by appending v
3732*/
3733
3734#ifdef PDEBUG
3735void rDBChangeSComps(int* currComponents,
3736                     long* currShiftedComponents,
3737                     int length,
3738                     ring r)
3739{
3740  r->typ[1].data.syzcomp.length = length;
3741  rNChangeSComps( currComponents, currShiftedComponents, r);
3742}
3743void rDBGetSComps(int** currComponents,
3744                 long** currShiftedComponents,
3745                 int *length,
3746                 ring r)
3747{
3748  *length = r->typ[1].data.syzcomp.length;
3749  rNGetSComps( currComponents, currShiftedComponents, r);
3750}
3751#endif
3752
3753void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
3754{
3755  assume(r->order[1]==ringorder_S);
3756
3757  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
3758  r->typ[1].data.syzcomp.Components = currComponents;
3759}
3760
3761void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
3762{
3763  assume(r->order[1]==ringorder_S);
3764
3765  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
3766  *currComponents =   r->typ[1].data.syzcomp.Components;
3767}
3768
3769/////////////////////////////////////////////////////////////////////////////
3770//
3771// The following routines all take as input a ring r, and return R
3772// where R has a certain property. R might be equal r in which case r
3773// had already this property
3774//
3775// Without argument, these functions work on currRing and change it,
3776// if necessary
3777
3778// for the time being, this is still here
3779static ring rAssure_SyzComp(ring r, BOOLEAN complete = TRUE);
3780
3781#define MYTEST 0
3782
3783ring rCurrRingAssure_SyzComp()
3784{
3785#ifdef HAVE_PLURAL
3786#if MYTEST
3787  PrintS("rCurrRingAssure_SyzComp(), currRing:  \n");
3788  rWrite(currRing);
3789#ifdef RDEBUG
3790  rDebugPrint(currRing);
3791#endif
3792#endif
3793#endif
3794
3795  ring r = rAssure_SyzComp(currRing);
3796
3797  if (r != currRing)
3798  {
3799    ring old_ring = currRing;
3800    rChangeCurrRing(r);
3801    assume(currRing == r);
3802
3803#ifdef HAVE_PLURAL
3804#if MYTEST
3805    PrintS("rCurrRingAssure_SyzComp(): currRing': ");
3806    rWrite(currRing);
3807#ifdef RDEBUG
3808    rDebugPrint(currRing);
3809#endif
3810#endif
3811#endif
3812
3813
3814    if (old_ring->qideal != NULL)
3815    {
3816      r->qideal = idrCopyR_NoSort(old_ring->qideal, old_ring);
3817      assume(idRankFreeModule(r->qideal) == 0);
3818      currQuotient = r->qideal;
3819
3820#ifdef HAVE_PLURAL
3821      if( rIsPluralRing(r) )
3822        if( nc_SetupQuotient(r, old_ring, true) )
3823        {
3824//          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
3825        }
3826#endif
3827    }
3828
3829#ifdef HAVE_PLURAL
3830    assume((r->qideal==NULL) == (old_ring->qideal==NULL));
3831    assume(rIsPluralRing(r) == rIsPluralRing(old_ring));
3832    assume(rIsSCA(r) == rIsSCA(old_ring));
3833    assume(ncRingType(r) == ncRingType(old_ring));
3834#endif
3835
3836  }
3837
3838  assume(currRing == r);
3839
3840
3841#ifdef HAVE_PLURAL
3842#if MYTEST
3843  PrintS("\nrCurrRingAssure_SyzComp(): new currRing: \n");
3844  rWrite(currRing);
3845#ifdef RDEBUG
3846  rDebugPrint(currRing);
3847#endif
3848#endif
3849#endif
3850
3851  return r;
3852}
3853
3854static ring rAssure_SyzComp(ring r, BOOLEAN complete)
3855{
3856  if (r->order[0] == ringorder_s) return r;
3857  ring res=rCopy0(r, FALSE, FALSE);
3858  int i=rBlocks(r);
3859  int j;
3860
3861  res->order=(int *)omAlloc((i+1)*sizeof(int));
3862  res->block0=(int *)omAlloc0((i+1)*sizeof(int));
3863  res->block1=(int *)omAlloc0((i+1)*sizeof(int));
3864  int ** wvhdl =(int **)omAlloc0((i+1)*sizeof(int**));
3865  for(j=i;j>0;j--)
3866  {
3867    res->order[j]=r->order[j-1];
3868    res->block0[j]=r->block0[j-1];
3869    res->block1[j]=r->block1[j-1];
3870    if (r->wvhdl[j-1] != NULL)
3871    {
3872      wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
3873    }
3874  }
3875  res->order[0]=ringorder_s;
3876
3877  res->wvhdl = wvhdl;
3878
3879  if (complete)
3880  {
3881    rComplete(res, 1);
3882
3883#ifdef HAVE_PLURAL
3884    if (rIsPluralRing(r))
3885    {
3886      if ( nc_rComplete(r, res, false) ) // no qideal!
3887      {
3888        WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
3889      }
3890    }
3891    assume(rIsPluralRing(r) == rIsPluralRing(res));
3892#endif
3893  }
3894  return res;
3895}
3896
3897ring rAssure_TDeg(ring r, int start_var, int end_var, int &pos)
3898{
3899  int i;
3900  if (r->typ!=NULL)
3901  {
3902    for(i=r->OrdSize-1;i>=0;i--)
3903    {
3904      if ((r->typ[i].ord_typ==ro_dp)
3905      && (r->typ[i].data.dp.start==start_var)
3906      && (r->typ[i].data.dp.end==end_var))
3907      {
3908        pos=r->typ[i].data.dp.place;
3909        //printf("no change, pos=%d\n",pos);
3910        return r;
3911      }
3912    }
3913  }
3914
3915#ifdef HAVE_PLURAL
3916  nc_struct* save=r->GetNC();
3917  r->GetNC()=NULL;
3918#endif
3919  ring res=rCopy(r);
3920
3921  i=rBlocks(r);
3922  int j;
3923
3924  res->ExpL_Size=r->ExpL_Size+1; // one word more in each monom
3925  res->PolyBin=omGetSpecBin(POLYSIZE + (res->ExpL_Size)*sizeof(long));
3926  omFree((ADDRESS)res->ordsgn);
3927  res->ordsgn=(long *)omAlloc0(res->ExpL_Size*sizeof(long));
3928  for(j=0;j<r->CmpL_Size;j++)
3929  {
3930    res->ordsgn[j] = r->ordsgn[j];
3931  }
3932  res->OrdSize=r->OrdSize+1;   // one block more for pSetm
3933  if (r->typ!=NULL)
3934    omFree((ADDRESS)res->typ);
3935  res->typ=(sro_ord*)omAlloc0(res->OrdSize*sizeof(sro_ord));
3936  if (r->typ!=NULL)
3937    memcpy(res->typ,r->typ,r->OrdSize*sizeof(sro_ord));
3938  // the additional block for pSetm: total degree at the last word
3939  // but not included in the compare part
3940  res->typ[res->OrdSize-1].ord_typ=ro_dp;
3941  res->typ[res->OrdSize-1].data.dp.start=start_var;
3942  res->typ[res->OrdSize-1].data.dp.end=end_var;
3943  res->typ[res->OrdSize-1].data.dp.place=res->ExpL_Size-1;
3944  pos=res->ExpL_Size-1;
3945  //if ((start_var==1) && (end_var==res->N)) res->pOrdIndex=pos;
3946  extern void p_Setm_General(poly p, ring r);
3947  res->p_Setm=p_Setm_General;
3948  // ----------------------------
3949  omFree((ADDRESS)res->p_Procs);
3950  res->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
3951
3952  p_ProcsSet(res, res->p_Procs);
3953  if (res->qideal!=NULL) id_Delete(&res->qideal,res);
3954#ifdef HAVE_PLURAL
3955  r->GetNC()=save;
3956  if (rIsPluralRing(r))
3957  {
3958    if ( nc_rComplete(r, res, false) ) // no qideal!
3959    {
3960      WarnS("error in nc_rComplete");
3961    // just go on..
3962    }
3963  }
3964#endif
3965  if (r->qideal!=NULL)
3966  {
3967     res->qideal=idrCopyR_NoSort(r->qideal,r);
3968#ifdef HAVE_PLURAL
3969     if (rIsPluralRing(res))
3970     {
3971       nc_SetupQuotient(res, currRing);
3972     }
3973     assume((res->qideal==NULL) == (r->qideal==NULL));
3974#endif
3975  }
3976
3977#ifdef HAVE_PLURAL
3978  assume(rIsPluralRing(res) == rIsPluralRing(r));
3979  assume(rIsSCA(res) == rIsSCA(r));
3980  assume(ncRingType(res) == ncRingType(r));
3981#endif
3982
3983  return res;
3984}
3985
3986ring rAssure_HasComp(ring r)
3987{
3988  int last_block;
3989  int i=0;
3990  do
3991  {
3992     if (r->order[i] == ringorder_c ||
3993        r->order[i] == ringorder_C) return r;
3994     if (r->order[i] == 0)
3995        break;
3996     i++;
3997  } while (1);
3998  //WarnS("re-creating ring with comps");
3999  last_block=i-1;
4000
4001  ring new_r = rCopy0(r, FALSE, FALSE);
4002  i+=2;
4003  new_r->wvhdl=(int **)omAlloc0(i * sizeof(int_ptr));
4004  new_r->order   = (int *) omAlloc0(i * sizeof(int));
4005  new_r->block0   = (int *) omAlloc0(i * sizeof(int));
4006  new_r->block1   = (int *) omAlloc0(i * sizeof(int));
4007  memcpy4(new_r->order,r->order,(i-1) * sizeof(int));
4008  memcpy4(new_r->block0,r->block0,(i-1) * sizeof(int));
4009  memcpy4(new_r->block1,r->block1,(i-1) * sizeof(int));
4010  for (int j=0; j<=last_block; j++)
4011  {
4012    if (r->wvhdl[j]!=NULL)
4013    {
4014      new_r->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
4015    }
4016  }
4017  last_block++;
4018  new_r->order[last_block]=ringorder_C;
4019  //new_r->block0[last_block]=0;
4020  //new_r->block1[last_block]=0;
4021  //new_r->wvhdl[last_block]=NULL;
4022
4023  rComplete(new_r, 1);
4024
4025#ifdef HAVE_PLURAL
4026  if (rIsPluralRing(r))
4027  {
4028    if ( nc_rComplete(r, new_r, false) ) // no qideal!
4029    {
4030      WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4031    }
4032  }
4033  assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4034#endif
4035
4036  return new_r;
4037}
4038
4039static ring rAssure_CompLastBlock(ring r, BOOLEAN complete = TRUE)
4040{
4041  int last_block = rBlocks(r) - 2;
4042  if (r->order[last_block] != ringorder_c &&
4043      r->order[last_block] != ringorder_C)
4044  {
4045    int c_pos = 0;
4046    int i;
4047
4048    for (i=0; i< last_block; i++)
4049    {
4050      if (r->order[i] == ringorder_c || r->order[i] == ringorder_C)
4051      {
4052        c_pos = i;
4053        break;
4054      }
4055    }
4056    if (c_pos != -1)
4057    {
4058      ring new_r = rCopy0(r, FALSE, TRUE);
4059      for (i=c_pos+1; i<=last_block; i++)
4060      {
4061        new_r->order[i-1] = new_r->order[i];
4062        new_r->block0[i-1] = new_r->block0[i];
4063        new_r->block1[i-1] = new_r->block1[i];
4064        new_r->wvhdl[i-1] = new_r->wvhdl[i];
4065      }
4066      new_r->order[last_block] = r->order[c_pos];
4067      new_r->block0[last_block] = r->block0[c_pos];
4068      new_r->block1[last_block] = r->block1[c_pos];
4069      new_r->wvhdl[last_block] = r->wvhdl[c_pos];
4070      if (complete)
4071      {
4072        rComplete(new_r, 1);
4073
4074#ifdef HAVE_PLURAL
4075        if (rIsPluralRing(r))
4076        {
4077          if ( nc_rComplete(r, new_r, false) ) // no qideal!
4078          {
4079            WarnS("error in nc_rComplete");   // cleanup?//      rDelete(res);//      return r;      // just go on..
4080          }
4081        }
4082        assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4083#endif
4084      }
4085      return new_r;
4086    }
4087  }
4088  return r;
4089}
4090
4091ring rCurrRingAssure_CompLastBlock()
4092{
4093  ring new_r = rAssure_CompLastBlock(currRing);
4094  if (currRing != new_r)
4095  {
4096    ring old_r = currRing;
4097    rChangeCurrRing(new_r);
4098    if (old_r->qideal != NULL)
4099    {
4100      new_r->qideal = idrCopyR(old_r->qideal, old_r);
4101      currQuotient = new_r->qideal;
4102#ifdef HAVE_PLURAL
4103      if( rIsPluralRing(new_r) )
4104        if( nc_SetupQuotient(new_r, old_r, true) )
4105        {
4106          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4107        }
4108      assume((new_r->qideal==NULL) == (old_r->qideal==NULL));
4109      assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4110      assume(rIsSCA(new_r) == rIsSCA(old_r));
4111      assume(ncRingType(new_r) == ncRingType(old_r));
4112#endif
4113    }
4114    rTest(new_r);
4115    rTest(old_r);
4116  }
4117  return new_r;
4118}
4119
4120ring rCurrRingAssure_SyzComp_CompLastBlock()
4121{
4122  ring new_r_1 = rAssure_CompLastBlock(currRing, FALSE);
4123  ring new_r = rAssure_SyzComp(new_r_1, FALSE);
4124
4125  if (new_r != currRing)
4126  {
4127    ring old_r = currRing;
4128    if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
4129    rComplete(new_r, 1);
4130#ifdef HAVE_PLURAL
4131    if (rIsPluralRing(old_r))
4132    {
4133      if ( nc_rComplete(old_r, new_r, false) ) // no qideal!
4134      {
4135        WarnS("error in nc_rComplete"); // cleanup?      rDelete(res);       return r;  // just go on...?
4136      }
4137    }
4138    assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4139#endif
4140    rChangeCurrRing(new_r);
4141    if (old_r->qideal != NULL)
4142    {
4143      new_r->qideal = idrCopyR(old_r->qideal, old_r);
4144      currQuotient = new_r->qideal;
4145
4146#ifdef HAVE_PLURAL
4147      if( rIsPluralRing(old_r) )
4148        if( nc_SetupQuotient(new_r, old_r, true) )
4149        {
4150          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4151        }
4152      assume((new_r->qideal==NULL) == (old_r->qideal==NULL));
4153      assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4154      assume(rIsSCA(new_r) == rIsSCA(old_r));
4155      assume(ncRingType(new_r) == ncRingType(old_r));
4156#endif
4157    }
4158    rTest(new_r);
4159    rTest(old_r);
4160  }
4161  return new_r;
4162}
4163
4164// use this for global orderings consisting of two blocks
4165static ring rCurrRingAssure_Global(rRingOrder_t b1, rRingOrder_t b2)
4166{
4167  int r_blocks = rBlocks(currRing);
4168  int i;
4169
4170  assume(b1 == ringorder_c || b1 == ringorder_C ||
4171         b2 == ringorder_c || b2 == ringorder_C ||
4172         b2 == ringorder_S);
4173  if ((r_blocks == 3) &&
4174      (currRing->order[0] == b1) &&
4175      (currRing->order[1] == b2) &&
4176      (currRing->order[2] == 0))
4177    return currRing;
4178  ring res = rCopy0(currRing, TRUE, FALSE);
4179  res->order = (int*)omAlloc0(3*sizeof(int));
4180  res->block0 = (int*)omAlloc0(3*sizeof(int));
4181  res->block1 = (int*)omAlloc0(3*sizeof(int));
4182  res->wvhdl = (int**)omAlloc0(3*sizeof(int*));
4183  res->order[0] = b1;
4184  res->order[1] = b2;
4185  if (b1 == ringorder_c || b1 == ringorder_C)
4186  {
4187    res->block0[1] = 1;
4188    res->block1[1] = currRing->N;
4189  }
4190  else
4191  {
4192    res->block0[0] = 1;
4193    res->block1[0] = currRing->N;
4194  }
4195  // HANNES: This sould be set in rComplete
4196  res->OrdSgn = 1;
4197  rComplete(res, 1);
4198  rChangeCurrRing(res);
4199  return res;
4200}
4201
4202
4203ring rCurrRingAssure_dp_S()
4204{
4205  return rCurrRingAssure_Global(ringorder_dp, ringorder_S);
4206}
4207
4208ring rCurrRingAssure_dp_C()
4209{
4210  return rCurrRingAssure_Global(ringorder_dp, ringorder_C);
4211}
4212
4213ring rCurrRingAssure_C_dp()
4214{
4215  return rCurrRingAssure_Global(ringorder_C, ringorder_dp);
4216}
4217
4218
4219void rSetSyzComp(int k)
4220{
4221  if (TEST_OPT_PROT) Print("{%d}", k);
4222  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz))
4223  {
4224    assume(k > currRing->typ[0].data.syz.limit);
4225    int i;
4226    if (currRing->typ[0].data.syz.limit == 0)
4227    {
4228      currRing->typ[0].data.syz.syz_index = (int*) omAlloc0((k+1)*sizeof(int));
4229      currRing->typ[0].data.syz.syz_index[0] = 0;
4230      currRing->typ[0].data.syz.curr_index = 1;
4231    }
4232    else
4233    {
4234      currRing->typ[0].data.syz.syz_index = (int*)
4235        omReallocSize(currRing->typ[0].data.syz.syz_index,
4236                (currRing->typ[0].data.syz.limit+1)*sizeof(int),
4237                (k+1)*sizeof(int));
4238    }
4239    for (i=currRing->typ[0].data.syz.limit + 1; i<= k; i++)
4240    {
4241      currRing->typ[0].data.syz.syz_index[i] =
4242        currRing->typ[0].data.syz.curr_index;
4243    }
4244    currRing->typ[0].data.syz.limit = k;
4245    currRing->typ[0].data.syz.curr_index++;
4246  }
4247  else if ((currRing->order[0]!=ringorder_c) && (k!=0))
4248  {
4249    dReportError("syzcomp in incompatible ring");
4250  }
4251#ifdef PDEBUG
4252  extern int pDBsyzComp;
4253  pDBsyzComp=k;
4254#endif
4255}
4256
4257// return the max-comonent wchich has syzIndex i
4258int rGetMaxSyzComp(int i)
4259{
4260  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz) &&
4261      currRing->typ[0].data.syz.limit > 0 && i > 0)
4262  {
4263    assume(i <= currRing->typ[0].data.syz.limit);
4264    int j;
4265    for (j=0; j<currRing->typ[0].data.syz.limit; j++)
4266    {
4267      if (currRing->typ[0].data.syz.syz_index[j] == i  &&
4268          currRing->typ[0].data.syz.syz_index[j+1] != i)
4269      {
4270        assume(currRing->typ[0].data.syz.syz_index[j+1] == i+1);
4271        return j;
4272      }
4273    }
4274    return currRing->typ[0].data.syz.limit;
4275  }
4276  else
4277  {
4278    return 0;
4279  }
4280}
4281
4282BOOLEAN rRing_is_Homog(ring r)
4283{
4284  if (r == NULL) return FALSE;
4285  int i, j, nb = rBlocks(r);
4286  for (i=0; i<nb; i++)
4287  {
4288    if (r->wvhdl[i] != NULL)
4289    {
4290      int length = r->block1[i] - r->block0[i];
4291      int* wvhdl = r->wvhdl[i];
4292      if (r->order[i] == ringorder_M) length *= length;
4293      assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
4294
4295      for (j=0; j< length; j++)
4296      {
4297        if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
4298      }
4299    }
4300  }
4301  return TRUE;
4302}
4303
4304BOOLEAN rRing_has_CompLastBlock(ring r)
4305{
4306  assume(r != NULL);
4307  int lb = rBlocks(r) - 2;
4308  return (r->order[lb] == ringorder_c || r->order[lb] == ringorder_C);
4309}
4310
4311n_coeffType rFieldType(ring r)
4312{
4313  if (rField_is_Zp(r))     return n_Zp;
4314  if (rField_is_Q(r))      return n_Q;
4315  if (rField_is_R(r))      return n_R;
4316  if (rField_is_GF(r))     return n_GF;
4317  if (rField_is_long_R(r)) return n_long_R;
4318  if (rField_is_Zp_a(r))   return n_Zp_a;
4319  if (rField_is_Q_a(r))    return n_Q_a;
4320  if (rField_is_long_C(r)) return n_long_C;
4321  return n_unknown;
4322}
4323
4324int64 * rGetWeightVec(ring r)
4325{
4326  assume(r!=NULL);
4327  assume(r->OrdSize>0);
4328  int i=0;
4329  while((r->typ[i].ord_typ!=ro_wp64) && (r->typ[i].ord_typ>0)) i++;
4330  assume(r->typ[i].ord_typ==ro_wp64);
4331  return (int64*)(r->typ[i].data.wp64.weights64);
4332}
4333
4334void rSetWeightVec(ring r, int64 *wv)
4335{
4336  assume(r!=NULL);
4337  assume(r->OrdSize>0);
4338  assume(r->typ[0].ord_typ==ro_wp64);
4339  memcpy(r->typ[0].data.wp64.weights64,wv,r->N*sizeof(int64));
4340}
4341
4342#include <ctype.h>
4343
4344static int rRealloc1(ring r, ring src, int size, int pos)
4345{
4346  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size+1)*sizeof(int));
4347  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size+1)*sizeof(int));
4348  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size+1)*sizeof(int));
4349  r->wvhdl=(int_ptr*)omReallocSize(r->wvhdl,size*sizeof(int_ptr), (size+1)*sizeof(int_ptr));
4350  for(int k=size; k>pos; k--) r->wvhdl[k]=r->wvhdl[k-1];
4351  r->order[size]=0;
4352  size++;
4353  return size;
4354}
4355static int rReallocM1(ring r, ring src, int size, int pos)
4356{
4357  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size-1)*sizeof(int));
4358  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size-1)*sizeof(int));
4359  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size-1)*sizeof(int));
4360  r->wvhdl=(int_ptr*)omReallocSize(r->wvhdl,size*sizeof(int_ptr), (size-1)*sizeof(int_ptr));
4361  for(int k=pos+1; k<size; k++) r->wvhdl[k]=r->wvhdl[k+1];
4362  size--;
4363  return size;
4364}
4365static void rOppWeight(int *w, int l)
4366{
4367  int i2=(l+1)/2;
4368  for(int j=0; j<=i2; j++)
4369  {
4370    int t=w[j];
4371    w[j]=w[l-j];
4372    w[l-j]=t;
4373  }
4374}
4375
4376#define rOppVar(R,I) (rVar(R)+1-I)
4377
4378ring rOpposite(ring src)
4379  /* creates an opposite algebra of R */
4380  /* that is R^opp, where f (*^opp) g = g*f  */
4381  /* treats the case of qring */
4382{
4383  if (src == NULL) return(NULL);
4384
4385#ifdef RDEBUG
4386  rTest(src);
4387#endif
4388
4389  ring save = currRing;
4390  rChangeCurrRing(src);
4391
4392#ifdef RDEBUG
4393  rTest(src);
4394//  rWrite(src);
4395//  rDebugPrint(src);
4396#endif
4397
4398
4399//  ring r = rCopy0(src,TRUE); /* TRUE for copy the qideal: Why??? */
4400  ring r = rCopy0(src,FALSE); /* qideal will be deleted later on!!! */
4401
4402  /*  rChangeCurrRing(r); */
4403  // change vars v1..vN -> vN..v1
4404  int i;
4405  int i2 = (rVar(r)-1)/2;
4406  for(i=i2; i>=0; i--)
4407  {
4408    // index: 0..N-1
4409    //Print("ex var names: %d <-> %d\n",i,rOppVar(r,i));
4410    // exchange names
4411    char *p;
4412    p = r->names[rVar(r)-1-i];
4413    r->names[rVar(r)-1-i] = r->names[i];
4414    r->names[i] = p;
4415  }
4416//  i2=(rVar(r)+1)/2;
4417//  for(int i=i2; i>0; i--)
4418//  {
4419//    // index: 1..N
4420//    //Print("ex var places: %d <-> %d\n",i,rVar(r)+1-i);
4421//    // exchange VarOffset
4422//    int t;
4423//    t=r->VarOffset[i];
4424//    r->VarOffset[i]=r->VarOffset[rOppVar(r,i)];
4425//    r->VarOffset[rOppVar(r,i)]=t;
4426//  }
4427  // change names:
4428  for (i=rVar(r)-1; i>=0; i--)
4429  {
4430    char *p=r->names[i];
4431    if(isupper(*p)) *p = tolower(*p);
4432    else            *p = toupper(*p);
4433  }
4434  // change ordering: listing
4435  // change ordering: compare
4436//  for(i=0; i<r->OrdSize; i++)
4437//  {
4438//    int t,tt;
4439//    switch(r->typ[i].ord_typ)
4440//    {
4441//      case ro_dp:
4442//      //
4443//        t=r->typ[i].data.dp.start;
4444//        r->typ[i].data.dp.start=rOppVar(r,r->typ[i].data.dp.end);
4445//        r->typ[i].data.dp.end=rOppVar(r,t);
4446//        break;
4447//      case ro_wp:
4448//      case ro_wp_neg:
4449//      {
4450//        t=r->typ[i].data.wp.start;
4451//        r->typ[i].data.wp.start=rOppVar(r,r->typ[i].data.wp.end);
4452//        r->typ[i].data.wp.end=rOppVar(r,t);
4453//        // invert r->typ[i].data.wp.weights
4454//        rOppWeight(r->typ[i].data.wp.weights,
4455//                   r->typ[i].data.wp.end-r->typ[i].data.wp.start);
4456//        break;
4457//      }
4458//      //case ro_wp64:
4459//      case ro_syzcomp:
4460//      case ro_syz:
4461//         WerrorS("not implemented in rOpposite");
4462//         // should not happen
4463//         break;
4464//
4465//      case ro_cp:
4466//        t=r->typ[i].data.cp.start;
4467//        r->typ[i].data.cp.start=rOppVar(r,r->typ[i].data.cp.end);
4468//        r->typ[i].data.cp.end=rOppVar(r,t);
4469//        break;
4470//      case ro_none:
4471//      default:
4472//       Werror("unknown type in rOpposite(%d)",r->typ[i].ord_typ);
4473//       break;
4474//    }
4475//  }
4476  // Change order/block structures (needed for rPrint, rAdd etc.)
4477  int j=0;
4478  int l=rBlocks(src);
4479  for(i=0; src->order[i]!=0; i++)
4480  {
4481    switch (src->order[i])
4482    {
4483      case ringorder_c: /* c-> c */
4484      case ringorder_C: /* C-> C */
4485      case ringorder_no /*=0*/: /* end-of-block */
4486        r->order[j]=src->order[i];
4487        j++; break;
4488      case ringorder_lp: /* lp -> rp */
4489        r->order[j]=ringorder_rp;
4490        r->block0[j]=rOppVar(r, src->block1[i]);
4491        r->block1[j]=rOppVar(r, src->block0[i]);
4492        break;
4493      case ringorder_rp: /* rp -> lp */
4494        r->order[j]=ringorder_lp;
4495        r->block0[j]=rOppVar(r, src->block1[i]);
4496        r->block1[j]=rOppVar(r, src->block0[i]);
4497        break;
4498      case ringorder_dp: /* dp -> a(1..1),ls */
4499      {
4500        l=rRealloc1(r,src,l,j);
4501        r->order[j]=ringorder_a;
4502        r->block0[j]=rOppVar(r, src->block1[i]);
4503        r->block1[j]=rOppVar(r, src->block0[i]);
4504        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
4505        for(int k=r->block0[j]; k<=r->block1[j]; k++)
4506          r->wvhdl[j][k-r->block0[j]]=1;
4507        j++;
4508        r->order[j]=ringorder_ls;
4509        r->block0[j]=rOppVar(r, src->block1[i]);
4510        r->block1[j]=rOppVar(r, src->block0[i]);
4511        j++;
4512        break;
4513      }
4514      case ringorder_Dp: /* Dp -> a(1..1),rp */
4515      {
4516        l=rRealloc1(r,src,l,j);
4517        r->order[j]=ringorder_a;
4518        r->block0[j]=rOppVar(r, src->block1[i]);
4519        r->block1[j]=rOppVar(r, src->block0[i]);
4520        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
4521        for(int k=r->block0[j]; k<=r->block1[j]; k++)
4522          r->wvhdl[j][k-r->block0[j]]=1;
4523        j++;
4524        r->order[j]=ringorder_rp;
4525        r->block0[j]=rOppVar(r, src->block1[i]);
4526        r->block1[j]=rOppVar(r, src->block0[i]);
4527        j++;
4528        break;
4529      }
4530      case ringorder_wp: /* wp -> a(...),ls */
4531      {
4532        l=rRealloc1(r,src,l,j);
4533        r->order[j]=ringorder_a;
4534        r->block0[j]=rOppVar(r, src->block1[i]);
4535        r->block1[j]=rOppVar(r, src->block0[i]);
4536        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=r->wvhdl[j+1]=NULL;
4537        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
4538        j++;
4539        r->order[j]=ringorder_ls;
4540        r->block0[j]=rOppVar(r, src->block1[i]);
4541        r->block1[j]=rOppVar(r, src->block0[i]);
4542        j++;
4543        break;
4544      }
4545      case ringorder_Wp: /* Wp -> a(...),rp */
4546      {
4547        l=rRealloc1(r,src,l,j);
4548        r->order[j]=ringorder_a;
4549        r->block0[j]=rOppVar(r, src->block1[i]);
4550        r->block1[j]=rOppVar(r, src->block0[i]);
4551        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=r->wvhdl[j+1]=NULL;
4552        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
4553        j++;
4554        r->order[j]=ringorder_rp;
4555        r->block0[j]=rOppVar(r, src->block1[i]);
4556        r->block1[j]=rOppVar(r, src->block0[i]);
4557        j++;
4558        break;
4559      }
4560      case ringorder_M: /* M -> M */
4561      {
4562        r->order[j]=ringorder_M;
4563        r->block0[j]=rOppVar(r, src->block1[i]);
4564        r->block1[j]=rOppVar(r, src->block0[i]);
4565        int n=r->block1[j]-r->block0[j];
4566        /* M is a (n+1)x(n+1) matrix */
4567        for (int nn=0; nn<=n; nn++)
4568        {
4569          rOppWeight(&(r->wvhdl[j][nn*(n+1)]), n /*r->block1[j]-r->block0[j]*/);
4570        }
4571        j++;
4572        break;
4573      }
4574      case ringorder_a: /*  a(...),ls -> wp/dp */
4575      {
4576        r->block0[j]=rOppVar(r, src->block1[i]);
4577        r->block1[j]=rOppVar(r, src->block0[i]);
4578        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
4579        if (src->order[i+1]==ringorder_ls)
4580        {
4581          r->order[j]=ringorder_wp;
4582          i++;
4583          //l=rReallocM1(r,src,l,j);
4584        }
4585        else
4586        {
4587          r->order[j]=ringorder_a;
4588        }
4589        j++;
4590        break;
4591      }
4592      // not yet done:
4593      case ringorder_ls:
4594      case ringorder_rs:
4595      case ringorder_ds:
4596      case ringorder_Ds:
4597      case ringorder_ws:
4598      case ringorder_Ws:
4599      // should not occur:
4600      case ringorder_S:
4601      case ringorder_s:
4602      case ringorder_aa:
4603      case ringorder_L:
4604      case ringorder_unspec:
4605        Werror("order %s not (yet) supported", rSimpleOrdStr(src->order[i]));
4606        break;
4607    }
4608  }
4609  rComplete(r);
4610
4611
4612#ifdef RDEBUG
4613  rTest(r);
4614#endif
4615
4616  rChangeCurrRing(r);
4617
4618#ifdef RDEBUG
4619  rTest(r);
4620//  rWrite(r);
4621//  rDebugPrint(r);
4622#endif
4623
4624
4625#ifdef HAVE_PLURAL
4626  // now, we initialize a non-comm structure on r
4627  if (rIsPluralRing(src))
4628  {
4629    assume( currRing == r);
4630
4631    int *perm       = (int *)omAlloc0((rVar(r)+1)*sizeof(int));
4632    int *par_perm   = NULL;
4633    nMapFunc nMap   = nSetMap(src);
4634    int ni,nj;
4635    for(i=1; i<=r->N; i++)
4636    {
4637      perm[i] = rOppVar(r,i);
4638    }
4639
4640    matrix C = mpNew(rVar(r),rVar(r));
4641    matrix D = mpNew(rVar(r),rVar(r));
4642
4643    for (i=1; i< rVar(r); i++)
4644    {
4645      for (j=i+1; j<=rVar(r); j++)
4646      {
4647        ni = r->N +1 - i;
4648        nj = r->N +1 - j; /* i<j ==>   nj < ni */
4649
4650        assume(MATELEM(src->GetNC()->C,i,j) != NULL);
4651        MATELEM(C,nj,ni) = pPermPoly(MATELEM(src->GetNC()->C,i,j),perm,src,nMap,par_perm,src->P);
4652
4653        if(MATELEM(src->GetNC()->D,i,j) != NULL)
4654          MATELEM(D,nj,ni) = pPermPoly(MATELEM(src->GetNC()->D,i,j),perm,src,nMap,par_perm,src->P);
4655      }
4656    }
4657
4658    idTest((ideal)C);
4659    idTest((ideal)D);
4660
4661    if (nc_CallPlural(C, D, NULL, NULL, r, false, false, true, r)) // no qring setup!
4662      WarnS("Error initializing non-commutative multiplication!");
4663
4664#ifdef RDEBUG
4665    rTest(r);
4666//    rWrite(r);
4667//    rDebugPrint(r);
4668#endif
4669
4670    assume( r->GetNC()->IsSkewConstant == src->GetNC()->IsSkewConstant);
4671
4672    omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
4673  }
4674#endif /* HAVE_PLURAL */
4675
4676  /* now oppose the qideal for qrings */
4677  if (src->qideal != NULL)
4678  {
4679    idDelete(&(r->qideal));
4680
4681#ifdef HAVE_PLURAL
4682    r->qideal = idOppose(src, src->qideal); // into the currRing: r
4683#else
4684    r->qideal = id_Copy(src->qideal, currRing); // ?
4685#endif
4686
4687#ifdef HAVE_PLURAL
4688    if( rIsPluralRing(r) )
4689    {
4690      nc_SetupQuotient(r);
4691#ifdef RDEBUG
4692      rTest(r);
4693//      rWrite(r);
4694//      rDebugPrint(r);
4695#endif
4696    }
4697#endif
4698  }
4699#ifdef HAVE_PLURAL
4700  if( rIsPluralRing(r) )
4701    assume( ncRingType(r) == ncRingType(src) );
4702#endif
4703  rTest(r);
4704
4705  rChangeCurrRing(save);
4706  return r;
4707}
4708
4709ring rEnvelope(ring R)
4710  /* creates an enveloping algebra of R */
4711  /* that is R^e = R \tensor_K R^opp */
4712{
4713  ring Ropp = rOpposite(R);
4714  ring Renv = NULL;
4715  int stat = rSum(R, Ropp, Renv); /* takes care of qideals */
4716  if ( stat <=0 )
4717    WarnS("Error in rEnvelope at rSum");
4718  rTest(Renv);
4719  return Renv;
4720}
4721
4722#ifdef HAVE_PLURAL
4723BOOLEAN nc_rComplete(const ring src, ring dest, bool bSetupQuotient)
4724/* returns TRUE is there were errors */
4725/* dest is actualy equals src with the different ordering */
4726/* we map src->nc correctly to dest->src */
4727/* to be executed after rComplete, before rChangeCurrRing */
4728{
4729// NOTE: Originally used only by idElimination to transfer NC structure to dest
4730// ring created by dirty hack (without nc_CallPlural)
4731  rTest(src);
4732
4733  assume(!rIsPluralRing(dest)); // destination must be a newly constructed commutative ring
4734
4735  if (!rIsPluralRing(src))
4736  {
4737    return FALSE;
4738  }
4739
4740  const int N = dest->N;
4741
4742  assume(src->N == N);
4743
4744  ring save = currRing;
4745
4746  if (dest != save)
4747    rChangeCurrRing(dest);
4748
4749  const ring srcBase = src->GetNC()->basering;
4750
4751  assume( nSetMap(srcBase) == nSetMap(currRing) ); // currRing is important here!
4752
4753  matrix C = mpNew(N,N); // ring independent
4754  matrix D = mpNew(N,N);
4755
4756  matrix C0 = src->GetNC()->C;
4757  matrix D0 = src->GetNC()->D;
4758
4759
4760  poly p = NULL;
4761  number n = NULL;
4762
4763  // map C and D into dest
4764  for (int i = 1; i < N; i++)
4765  {
4766    for (int j = i + 1; j <= N; j++)
4767    {
4768      const number n = n_Copy(p_GetCoeff(MATELEM(C0,i,j), srcBase), srcBase); // src, mapping for coeffs into currRing = dest!
4769      const poly   p = p_NSet(n, dest);
4770      MATELEM(C,i,j) = p;
4771      if (MATELEM(D0,i,j) != NULL)
4772        MATELEM(D,i,j) = prCopyR(MATELEM(D0,i,j), srcBase, dest); // ?
4773    }
4774  }
4775  /* One must test C and D _only_ in r->GetNC()->basering!!! not in r!!! */
4776
4777  idTest((ideal)C); // in dest!
4778  idTest((ideal)D);
4779
4780  if (nc_CallPlural(C, D, NULL, NULL, dest, bSetupQuotient, false, true, dest)) // also takes care about quotient ideal
4781  {
4782    //WarnS("Error transferring non-commutative structure");
4783    // error message should be in the interpreter interface
4784
4785    mpDelete(&C, dest);
4786    mpDelete(&D, dest);
4787
4788    if (currRing != save)
4789       rChangeCurrRing(save);
4790
4791    return TRUE;
4792  }
4793
4794//  mpDelete(&C, dest); // used by nc_CallPlural!
4795//  mpDelete(&D, dest);
4796
4797  if (dest != save)
4798    rChangeCurrRing(save);
4799
4800  assume(rIsPluralRing(dest));
4801  return FALSE;
4802}
4803#endif
4804
4805void rModify_a_to_A(ring r)
4806// to be called BEFORE rComplete:
4807// changes every Block with a(...) to A(...)
4808{
4809   int i=0;
4810   int j;
4811   while(r->order[i]!=0)
4812   {
4813      if (r->order[i]==ringorder_a)
4814      {
4815        r->order[i]=ringorder_a64;
4816        int *w=r->wvhdl[i];
4817        int64 *w64=(int64 *)omAlloc((r->block1[i]-r->block0[i]+1)*sizeof(int64));
4818        for(j=r->block1[i]-r->block0[i];j>=0;j--)
4819                w64[j]=(int64)w[j];
4820        r->wvhdl[i]=(int*)w64;
4821        omFreeSize(w,(r->block1[i]-r->block0[i]+1)*sizeof(int));
4822      }
4823      i++;
4824   }
4825}
Note: See TracBrowser for help on using the repository browser.