source: git/kernel/ring.cc @ d5564f8

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