source: git/kernel/ring.cc @ 5c990f1

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