source: git/kernel/ring.cc @ 689733

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