source: git/kernel/ring.cc @ b9642b1

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