source: git/kernel/ring.cc @ eab144e

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