source: git/Singular/ring.cc @ 437e2c2

spielwiese
Last change on this file since 437e2c2 was 437e2c2, checked in by Hans Schönemann <hannes@…>, 26 years ago
* hannes: added HAVE_TCL to ring.cc git-svn-id: file:///usr/local/Singular/svn/trunk@1144 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 35.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.15 1998-02-16 09:46:55 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 "mmemory.h"
14#include "tok.h"
15#include "polys.h"
16#include "numbers.h"
17#include "febase.h"
18#include "ipid.h"
19#include "ipshell.h"
20#include "ipconv.h"
21#include "intvec.h"
22#include "longalg.h"
23#include "ffields.h"
24#include "spolys.h"
25#include "subexpr.h"
26#include "ideals.h"
27#include "lists.h"
28#include "ring.h"
29
30/* global variables */
31#ifdef RDEBUG
32short rNumber=0;
33#endif
34
35/*0 implementation*/
36int rBlocks(ring r)
37{
38  int i=0;
39  while (r->order[i]!=0) i++;
40  return i+1;
41}
42
43// internally changes the gloabl ring and resets the relevant
44// global variables:
45// complete == FALSE : only delete operations are enabled
46// complete == TRUE  : full reset of all variables
47void rChangeCurrRing(ring r, BOOLEAN complete)
48{
49  if (r != NULL)
50  {
51    /*------------ set redTail, except reset by nSetChar or pChangeRing */
52    test |= Sy_bit(OPT_REDTAIL); 
53
54    /*------------ global variables related to coefficients ------------*/
55    nSetChar(r->ch, complete, r->parameter, r->P);
56
57    /*------------ global variables related to polys -------------------*/
58    pSetGlobals(r, complete);
59
60    /*------------ set naMinimalPoly -----------------------------------*/
61    if (r->minpoly!=NULL)
62    {
63      naMinimalPoly=((lnumber)r->minpoly)->z;
64    }
65   
66    /*------------ set global ring vars --------------------------------*/
67    currRing = r;
68    currQuotient=r->qideal;
69
70#ifdef DRING
71    pDRING=FALSE;
72    pSDRING=FALSE;
73    if (hasFlag(h,FLAG_DRING)) rDSet();
74#endif // DRING
75
76#ifdef SRING
77    if ((currRing->partN<=currRing->N)
78#ifdef DRING
79        && (!hasFlag(h,FLAG_DRING))
80#endif
81        )
82    {
83      pAltVars=currRing->partN;
84      pSRING=TRUE;
85      pSDRING=TRUE;
86    }
87    else
88    {
89      pAltVars=currRing->N+1;
90    }
91#endif // SRING
92
93    /*------------ set spolys ------------------------------------------*/
94    if (complete) spSet(r);
95  }
96}
97 
98void rSetHdl(idhdl h, BOOLEAN complete)
99{
100  int i;
101  ring rg = NULL;
102  if (h!=NULL)
103  {
104    rg = IDRING(h);
105    mmTestP((ADDRESS)h,sizeof(idrec));
106    mmTestLP((ADDRESS)IDID(h));
107    mmTestP(rg,sizeof(ip_sring));
108#ifdef MDEBUG
109    i=rBlocks(rg);
110#endif
111    mmTestP(rg->order,i*sizeof(int));
112    mmTestP(rg->block0,i*sizeof(int));
113    mmTestP(rg->block1,i*sizeof(int));
114    mmTestP(rg->wvhdl,i*sizeof(short *));
115  }
116  else complete=FALSE;
117   
118  // clean up history
119    if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
120        || ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
121    {
122      sLastPrinted.CleanUp();
123      memset(&sLastPrinted,0,sizeof(sleftv));
124    }
125 
126   /*------------ change the global ring -----------------------*/
127  rChangeCurrRing(rg,complete);
128  currRingHdl = h;
129
130    /*------------ set pShortOut -----------------------*/
131  if (complete /*&&(h!=NULL)*/)
132  {
133    #ifdef HAVE_TCL
134    if (tclmode)
135    {
136      PrintTCLS('R',IDID(h));
137      pShortOut=(int)FALSE;
138    }
139    else
140    #endif
141    {
142      pShortOut=(int)TRUE;
143      if ((rg->parameter!=NULL) && (rg->ch<2))
144      {
145        for (i=0;i<rg->P;i++)
146        {
147          if(strlen(rg->parameter[i])>1)
148          {
149            pShortOut=(int)FALSE;
150            break;
151          }
152        }
153      }
154      if (pShortOut)
155      {
156        for (i=(rg->N-1);i>=0;i--)
157        {
158          if(strlen(rg->names[i])>1)
159          {
160            pShortOut=(int)FALSE;
161            break;
162          }
163        }
164      }
165    }
166  }
167 
168}
169
170idhdl rDefault(char *s)
171{
172  idhdl tmp=NULL;
173 
174  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &idroot);
175  if (tmp==NULL) return NULL;
176 
177  if (ppNoether!=NULL) pDelete(&ppNoether);
178  if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
179  {
180    sLastPrinted.CleanUp();
181    memset(&sLastPrinted,0,sizeof(sleftv));
182  }
183 
184  currRing = IDRING(tmp);
185 
186  currRing->ch    = 32003;
187  currRing->N     = 3;
188  /*currRing->P     = 0; Alloc0 in idhdl::set, ipid.cc*/
189#ifdef RDEBUG
190  currRing->no    =rNumber; rNumber++;
191#endif
192#ifdef SRING
193  currRing->partN = 4;
194#endif
195  /*names*/
196  currRing->names = (char **) Alloc(3 * sizeof(char *));
197  currRing->names[0]  = mstrdup("x");
198  currRing->names[1]  = mstrdup("y");
199  currRing->names[2]  = mstrdup("z");
200  /*weights: entries for 3 blocks: NULL*/
201  currRing->wvhdl = (short **)Alloc0(3 * sizeof(short *));
202  /*order: dp,C,0*/
203  currRing->order = (int *) Alloc(3 * sizeof(int *));
204  currRing->block0 = (int *)Alloc(3 * sizeof(int *));
205  currRing->block1 = (int *)Alloc(3 * sizeof(int *));
206  /* ringorder dp for the first block: var 1..3 */
207  currRing->order[0]  = ringorder_dp;
208  currRing->block0[0] = 1;
209  currRing->block1[0] = 3;
210  /* ringorder C for the second block: no vars */
211  currRing->order[1]  = ringorder_C;
212  currRing->block0[1] = 0;
213  currRing->block1[1] = 0;
214  /* the last block: everything is 0 */
215  currRing->order[2]  = 0;
216  currRing->block0[2] = 0;
217  currRing->block1[2] = 0;
218  /*polynomial ring*/
219  currRing->OrdSgn    = 1;
220 
221  /* complete ring intializations */
222#ifdef COMP_FAST   
223  rComplete(currRing);
224#endif   
225  rSetHdl(tmp,TRUE);
226  return currRingHdl;
227}
228
229/*2
230 *check intvec, describing the ordering
231 */
232BOOLEAN rCheckIV(intvec *iv)
233{
234  if ((iv->length()!=2)&&(iv->length()!=3))
235  {
236    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
237    return TRUE;
238  }
239  return FALSE;
240}
241
242static int rTypeOfMatrixOrder(intvec * order)
243{
244  int i=0,j,typ=1;
245  int sz = (int)sqrt((double)(order->length()-2));
246 
247  while ((i<sz) && (typ==1))
248  {
249    j=0;
250    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
251    if (j>=sz)
252    {
253      typ = 0;
254      WerrorS("Matrix order not complete");
255    }
256    else if ((*order)[j*sz+i+2]<0)
257      typ = -1;
258    else
259      i++;
260  }
261  return typ;
262}
263
264/*2
265 * define a new ring from the data:
266 *s: name, chr: ch, parameter names (or NULL): pn,
267 *varnames: rv, ordering: ord, typ: typ
268 */
269idhdl rInit(char *s, sleftv* pn, sleftv* rv, sleftv* ord,
270            BOOLEAN isDRing)
271{
272  int ch;
273  if (pn->Typ()==INT_CMD)
274  {
275    ch=(int)pn->Data();
276  }
277  else if (strcmp(pn->name,"real")==0)
278  {
279    ch=-1;
280  }
281  else
282  {
283    pn->CleanUp();
284    rv->CleanUp();
285    ord->CleanUp();
286    return NULL;
287  }
288  pn=pn->next;
289 
290  int l, last;
291  int typ = 1;
292  sleftv * sl;
293  idhdl tmp;
294  ip_sring tmpR;
295  BOOLEAN ffChar=FALSE;
296  /*every entry in the new ring is initialized to 0*/
297 
298  /* characteristic -----------------------------------------------*/
299  /* input: 0 ch=0 : Q     parameter=NULL    ffChar=FALSE
300   *         0    1 : Q(a,...)        *names         FALSE
301   *         0   -1 : R               NULL           FALSE
302   *         p    p : Fp              NULL           FALSE
303   *         p   -p : Fp(a)           *names         FALSE
304   *         q    q : GF(q=p^n)       *names         TRUE
305   */
306  if (ch!=-1)
307  {
308    if ((ch!=0) &&((ch<2) || (ch > 32003)))
309    {
310      ch=32003;
311    }
312    l=0;
313    if (pn!=NULL)
314    {
315      while ((ch!=fftable[l]) && (fftable[l])) l++;
316      if (fftable[l]==0)
317      {
318        ch = IsPrime(ch);
319      } 
320      else
321      {
322        char *m[1]={(char *)sNoName};
323        nfSetChar(ch,m);
324        if(errorreported)
325        {
326          errorreported=0;
327          ch=IsPrime(ch);
328        }
329        else
330        {
331          ffChar=TRUE;
332        } 
333      }
334    }
335    else
336    {
337      ch = IsPrime(ch);
338    }
339  }
340  memset(&tmpR,0,sizeof(tmpR));
341 
342  tmpR.ch = ch;
343 
344  /* parameter -------------------------------------------------------*/
345  sleftv* hs;
346  const char* h;
347 
348  if ((pn!=NULL)&& (ffChar||(ch==-1)))
349  {
350    if((ffChar && (pn->next!=NULL))
351       || (ch==-1))
352    {
353      WarnS("too many parameters");
354      if (ffChar) hs=pn->next; 
355      else hs=pn;
356      hs->CleanUp();
357      if (ffChar) 
358      {
359        pn->next=NULL;
360        Free((ADDRESS)hs,sizeof(sleftv));
361      } 
362      else pn=NULL;
363    }
364  }
365  /* a tempory pointer for typ conversion
366   * and for deallocating sleftv*-lists:
367   *  don't deallocate the first but all other entries*/
368 
369  if (pn!=NULL)
370  {
371    tmpR.P=pn->listLength();
372    if((ffChar && (tmpR.P>1))
373       || ((ch==-1) && (tmpR.P>0)))
374    {
375      tmpR.P=ffChar; /* GF(q): 1, R: 0 */
376      WarnS("too many parameters");
377      if (ffChar) hs=pn->next; 
378      else hs=pn;
379      hs->CleanUp();
380      Free((ADDRESS)hs,sizeof(sleftv));
381      if (ffChar) pn->next=NULL;
382      else pn=NULL;
383    }
384    tmpR.parameter=(char**)Alloc(tmpR.P*sizeof(char *));
385    sl=pn;
386    char** p=tmpR.parameter;
387    while(sl!=NULL)
388    {
389      hs=NULL;
390      h=sl->Name();
391      if ((h==sNoName)&&(sl->Typ()==POLY_CMD))
392      {
393        hs=(leftv)Alloc(sizeof(sleftv));
394        iiConvert(POLY_CMD,ANY_TYPE,-1,sl,hs);
395        sl->next=hs->next;
396        hs->next=NULL;
397        h=hs->Name();
398      }
399      if (h==sNoName)
400      {
401        WerrorS("parameter expected");
402        pn->CleanUp();
403        rv->CleanUp();
404        ord->CleanUp();
405        return NULL;
406      }
407      *p=mstrdup(h);
408      p++;
409      if (hs!=NULL)
410      {
411        hs->CleanUp();
412        Free((ADDRESS)hs,sizeof(sleftv));
413      }
414      hs=sl;
415      sl=sl->next;
416      hs->next=NULL;
417      hs->CleanUp();
418      if (hs!=pn) Free((ADDRESS)hs,sizeof(sleftv));
419    }
420    if ((ch>1) && /*(pn!=NULL) &&*/ (!ffChar)) tmpR.ch=-tmpR.ch;
421    if (ch==0) tmpR.ch=1;
422  }
423 
424  /* names and number of variables-------------------------------------*/
425  {
426    int i, n;
427    sl = rv;
428#ifdef DRING
429    char *tmpname=NULL;
430#endif
431    n=rv->listLength();
432    tmpR.N = n;
433#ifdef SDRING
434    tmpR.partN=n+1-isDRing; // set to N+1 for SRING, N for DRING
435      if (isDRing) n=2*n+1;
436#endif
437    tmpR.N = n;
438    tmpR.names   = (char **)Alloc(n * sizeof(char *));
439    for (sl=rv, i=0; i<n; i++)
440    {
441      hs=NULL;
442#ifdef DRING
443      if (sl==NULL)
444      {
445        if (i==tmpR.N-1)
446          tmpname=mstrdup("");
447        else
448        {
449          tmpname=(char*)AllocL(strlen(tmpR.names[i-tmpR.partN])+2);
450          strcpy(tmpname,"d");
451          strcat(tmpname,tmpR.names[i-tmpR.partN]);
452        }
453        h=tmpname;
454      }
455      else
456#endif
457        h=sl->Name();
458      if ((h==sNoName)&&(sl->Typ()==POLY_CMD))
459      {
460        hs=(leftv)Alloc(sizeof(sleftv));
461        iiConvert(POLY_CMD,ANY_TYPE,-1,sl,hs);
462        sl->next=hs->next;
463        hs->next=NULL;
464        h=hs->Name();
465      }
466      if (h==sNoName)
467      {
468        WerrorS("expected name of ring variable");
469        sl->CleanUp();
470        ord->CleanUp();
471        return NULL;
472      }
473      tmpR.names[i] = mstrdup(h);
474      if (hs!=NULL)
475      {
476        hs->CleanUp();
477        Free((ADDRESS)hs,sizeof(sleftv));
478      }
479      hs=sl;
480#ifdef DRING
481      if (sl!=NULL)
482      {
483#endif
484        sl=sl->next;
485        hs->next=NULL;
486        hs->CleanUp();
487        if (hs!=rv) Free((ADDRESS)hs,sizeof(sleftv));
488#ifdef DRING
489      }
490      if (tmpname!=NULL)
491      {
492        FreeL((ADDRESS)tmpname);
493        tmpname=NULL;
494      }
495#endif
496    }
497   
498    /* ordering -------------------------------------------------------------*/
499    sl = ord;
500    /* the number of orderings*/
501    n = 1; i=0;
502    int o=0;
503    while (sl!=NULL)
504    {
505      intvec *iv = (intvec *)(sl->data);
506      if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C)) i++;
507      else if ((*iv)[1]!=ringorder_a) o++;
508      n++;
509      sl=sl->next;
510    }
511    if (o==0)
512    {
513      WerrorS("invalid combination of orderings");
514      ord->CleanUp();
515      return NULL;
516    }
517    if (i==0) n++;
518    else if (i!=1)
519      WarnS("more than one ordering c/C -- ignored");
520   
521    /* allocating */
522    tmpR.order=(int *)Alloc0(n*sizeof(int));
523    tmpR.block0=(int *)Alloc0(n*sizeof(int));
524    tmpR.block1=(int *)Alloc0(n*sizeof(int));
525    tmpR.wvhdl=(short**)Alloc0(n*sizeof(short*));
526   
527    /* init orders */
528    sl=ord;
529    n=0;
530    last=0;
531    while (sl!=NULL)
532    {
533      intvec *iv;
534      iv = (intvec *)(sl->data);
535     
536      /* the format of an ordering:
537       *  iv[0]: factor
538       *  iv[1]: ordering
539       *  iv[2..end]: weights
540       */
541      tmpR.order[n] = (*iv)[1];
542      switch ((*iv)[1])
543      {
544      case ringorder_ws:
545      case ringorder_Ws:
546        typ=-1;
547      case ringorder_wp:
548      case ringorder_Wp:
549        tmpR.wvhdl[n]=(short*)AllocL((iv->length()-1)*sizeof(short));
550        for (l=2;l<iv->length();l++)
551          tmpR.wvhdl[n][l-2]=(short)(*iv)[l];
552        tmpR.block0[n]=last+1;
553        last+=iv->length()-2;
554        tmpR.block1[n]=last;
555        break;
556      case ringorder_ls:
557      case ringorder_ds:
558      case ringorder_Ds:
559        typ=-1;
560      case ringorder_lp:
561      case ringorder_dp:
562      case ringorder_Dp:
563        tmpR.block0[n]=last+1;
564        //last+=(*iv)[0];
565        if (iv->length()==3) last+=(*iv)[2];
566        else last+=(*iv)[0];
567        tmpR.block1[n]=last;
568        if (rCheckIV(iv)) return NULL;
569        break;
570      case ringorder_c:
571      case ringorder_C:
572        if (rCheckIV(iv)) return NULL;
573        break;
574      case ringorder_a:
575        tmpR.block0[n]=last+1;
576        tmpR.block1[n]=last+iv->length()-2;
577        tmpR.wvhdl[n]=(short*)AllocL((iv->length()-1)*sizeof(short));
578        for (l=2;l<iv->length();l++)
579        {
580          tmpR.wvhdl[n][l-2]=(short)(*iv)[l];
581          if ((*iv)[l]<0) typ=-1;
582        }
583        break;
584      case ringorder_M:
585        {
586          int Mtyp=rTypeOfMatrixOrder(iv);
587          if (Mtyp==0) return NULL;
588          if (Mtyp==-1) typ=-1;
589          tmpR.wvhdl[n]=(short*)AllocL((iv->length()-1)*sizeof(short));
590          for (l=2;l<iv->length();l++)
591            tmpR.wvhdl[n][l-2]=(short)(*iv)[l];
592          tmpR.block0[n]=last+1;
593          last+=(int)sqrt((double)(iv->length()-2));
594          tmpR.block1[n]=last;
595          break;
596        }
597#ifdef TEST
598      default:
599        Print("order ??? %d\n",(*iv)[1]);
600        break;
601#endif
602      }
603      sl=sl->next;
604      n++;
605    }
606    ord->CleanUp();
607    if (i==0)
608    {
609      /*there is no c/C-ordering, so append it at the end*/
610      tmpR.order[n]=ringorder_C;
611    }
612    else n--;
613    while ((tmpR.order[n]==ringorder_c)
614           ||(tmpR.order[n]==ringorder_C))
615      n--;
616    if (tmpR.block1[n]!=tmpR.N)
617    {
618      if ((tmpR.order[n]==ringorder_dp) ||
619          (tmpR.order[n]==ringorder_ds) ||
620          (tmpR.order[n]==ringorder_Dp) ||
621          (tmpR.order[n]==ringorder_Ds) ||
622          (tmpR.order[n]==ringorder_lp) ||
623          (tmpR.order[n]==ringorder_ls))
624      {
625        tmpR.block1[n]=tmpR.N;
626        if (tmpR.block0[n]>tmpR.N/*tmpR.block1[n]*/)
627        {
628          tmpR.block1[n]=tmpR.block0[n];
629          goto ord_mismatch;
630          //Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
631          //  tmpR.N,tmpR.block0[n]);
632          //return NULL;
633        }
634      }
635      else
636      {
637      ord_mismatch:
638        Werror("mismatch of number of vars (%d) and ordering (%d vars)",
639               tmpR.N,tmpR.block1[n]);
640        return NULL;
641      }
642    }
643  }
644  tmpR.OrdSgn = typ;
645#ifdef COMP_FAST 
646  // Complete the initialization
647    rComplete(&tmpR);
648#endif 
649  /* try to enter the ring into the name list*/
650  if ((tmp = enterid(s, myynest, RING_CMD, &idroot))==NULL)
651  {
652    return NULL;
653  }
654 
655  memcpy(IDRING(tmp),&tmpR,sizeof(tmpR));
656  rSetHdl(tmp,TRUE);
657 
658#ifdef RDEBUG
659  currRing->no    =rNumber; rNumber++;
660#endif
661 
662  return currRingHdl;
663}
664
665#ifdef COMP_FAST
666// set those fields of the ring, which can be computed from other fields:
667// More particularly, set:
668// r->VarOffset, r->CompIndex
669
670void rComplete(ring r)
671{
672  int dummy, VarOffset, CompIndex;
673  pGetVarIndicies(r, VarOffset, CompIndex, dummy, dummy);
674  r->VarOffset = (short) VarOffset;
675  r->CompIndex = (short) CompIndex;
676}
677#endif
678 
679/*2
680 * set a new ring from the data:
681 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
682 */
683#ifdef DRING
684void rDSet()
685{
686  pDRING=TRUE;
687  pSDRING=TRUE;
688  pdN=currRing->partN;
689  pdK=pVariables-pdN*2-1;
690}
691#endif
692 
693int rIsRingVar(char *n)
694{
695  if ((currRing!=NULL) && (currRing->names!=NULL))
696  {
697    for (int i=0; i<currRing->N; i++)
698    {
699      if (currRing->names[i]==NULL) return -1;
700      if (strcmp(n,currRing->names[i]) == 0) return (int)i;
701    }
702  }
703  return -1;
704}
705
706char* RingVar(short i)
707{
708  return currRing->names[i];
709}
710
711void rWrite(ring r)
712{
713  if ((r==NULL)||(r->order==NULL))
714    return; /*to avoid printing after errors....*/
715 
716  int nblocks=rBlocks(r);
717 
718  mmTestP(r,sizeof(ip_sring));
719  mmTestP(r->order,nblocks*sizeof(int));
720  mmTestP(r->block0,nblocks*sizeof(int));
721  mmTestP(r->block1,nblocks*sizeof(int));
722  mmTestP(r->wvhdl,nblocks*sizeof(short *));
723  mmTestP(r->names,r->N*sizeof(char *));
724 
725  nblocks--;
726 
727 
728  if ((r->parameter!=NULL)&&(r->ch>1))
729    PrintS("//   # ground field : ");
730  else
731    PrintS("//   characteristic : ");
732  if (r->ch==-1)     Print ("0 (real)\n");  /* R */
733  else if (r->ch<0)  Print ("%d\n",-r->ch); /* Fp(a) */
734  else if (r->ch==1) PrintS("0\n");         /* Q(a)  */
735  else               Print ("%d\n",r->ch);  /* Fq, Fp, Q */
736  if (r->parameter!=NULL)
737  {
738    if (r->ch<2)
739    {
740      Print ("//   %d parameter    : ",rPar(r));
741      char **sp=r->parameter;
742      int nop=0;
743      while (nop<r->P)
744      {
745        PrintS(*sp);
746        PrintS(" ");
747        sp++; nop++;
748      }
749      PrintS("\n//   minpoly        : ");
750      if (r==currRing)
751      {
752        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
753      }
754      else if (r->minpoly==NULL)
755      {
756        PrintS("0\n");
757      }
758      else
759      {
760        PrintS("...\n");
761      }
762    }
763    else
764    {
765      Print("//   primitive element : %s\n", r->parameter[0]);
766      if (r==currRing) 
767      {
768        StringSetS("//   minpoly        : ");
769        nfShowMipo();PrintS(StringAppend("\n"));
770      } 
771    } 
772  }
773  Print("//   number of vars : %d",r->N);
774 
775  //for (nblocks=0; r->order[nblocks]; nblocks++);
776  nblocks=rBlocks(r)-1;
777 
778  for (int l=0, nlen=0 ; l<nblocks; l++)
779  {
780    int i;
781    Print("\n//        block %3d : ",l+1);
782   
783    Print("ordering %c", (" acCMldDwWldDwWu")[r->order[l]]);
784    if ((r->order[l]>=ringorder_lp)&&(r->order[l]!=ringorder_unspec))
785    {
786      if (r->order[l]>=ringorder_ls)
787        PrintS("s");
788      else
789        PrintS("p");
790    }
791   
792    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
793    {
794      PrintS("\n//                  : names    ");
795      for (i = r->block0[l]-1; i<r->block1[l]; i++)
796      {
797        nlen = strlen(r->names[i]);
798        Print("%s ",r->names[i]);
799      }
800    }
801   
802    if (r->wvhdl[l]!=NULL)
803    {
804      for (int j= 0;
805           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
806           j+=i)
807      {
808        PrintS("\n//                  : weights  ");
809        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
810        {
811          Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
812        }
813        if (r->order[l]!=ringorder_M) break;
814      }
815    }
816  }
817  if (r->qideal!=NULL)
818  {
819    PrintS("\n// quotient ring from ideal");
820    if (r==currRing)
821    {
822      PrintLn();
823      iiWriteMatrix((matrix)r->qideal,"_",1);
824    }
825    else PrintS(" ...");
826  }
827}
828
829void rKill(ring r)
830{
831  if ((r->ref<=0)&&(r->order!=NULL))
832  {
833#ifdef RDEBUG
834    if (traceit &TRACE_SHOW_RINGS) Print("kill ring %d\n",r->no);
835#endif
836    if (r==currRing)
837    {
838      if (r->qideal!=NULL)
839      {
840        idDelete(&r->qideal);
841        r->qideal=NULL;
842        currQuotient=NULL;
843      }
844      if (ppNoether!=NULL) pDelete(&ppNoether);
845      if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
846      {
847        sLastPrinted.CleanUp();
848        memset(&sLastPrinted,0,sizeof(sleftv));
849      }
850      currRing=NULL;
851      currRingHdl=NULL;
852    }
853    else if (r->qideal!=NULL)
854    {
855      ring savecurrRing = currRing;
856      rChangeCurrRing((ring)r,FALSE);
857      idDelete(&r->qideal);
858      r->qideal=NULL;
859      if (savecurrRing!=NULL) rChangeCurrRing(savecurrRing,FALSE);
860    }
861    int i=1;
862    int j;
863    int *pi=r->order;
864    for (j=0;j<iiRETURNEXPR_len;j++)
865    {
866      if (iiLocalRing[j]==r)
867      {
868        if (j<myynest) Warn("killing the basering for level %d",j);
869        iiLocalRing[j]=NULL;
870      }
871    }
872    if (pi!=NULL)
873    {
874      //while(*pi!=0) { pi++;i++; }
875      i=rBlocks(r);
876      Free((ADDRESS)r->order,i*sizeof(int));
877      Free((ADDRESS)r->block0,i*sizeof(int));
878      Free((ADDRESS)r->block1,i*sizeof(int));
879      for (j=0; j<i; j++)
880      {
881        if (r->wvhdl[j]!=NULL)
882          FreeL(r->wvhdl[j]);
883      }
884      Free((ADDRESS)r->wvhdl,i*sizeof(short *));
885      if(r->names!=NULL)
886      {
887        for (i=0; i<r->N; i++)
888        {
889          FreeL((ADDRESS)r->names[i]);
890        }
891        Free((ADDRESS)r->names,r->N*sizeof(char *));
892      }
893      if (r->parameter!=NULL)
894      {
895        int len=0;
896        char **s=r->parameter;
897        while (len<r->P)
898        {
899          FreeL((ADDRESS)*s);
900          s++;
901          len++;
902        }
903        Free((ADDRESS)r->parameter,r->P*sizeof(char *));
904      }
905    }
906#ifdef TEST
907    else
908      PrintS("internal error: ring structure destroyed\n");
909    memset(r,0,sizeof(ip_sring));
910#endif
911    Free((ADDRESS)r,sizeof(ip_sring));
912    return;
913  }
914  r->ref--;
915}
916
917void rKill(idhdl h)
918{
919  ring r = IDRING(h);
920  if (r!=NULL) rKill(r);
921  if (h==currRingHdl)
922  {
923    currRingHdl=idroot;
924    while (currRingHdl!=NULL)
925    {
926      if ((currRingHdl!=h)
927          && (IDTYP(currRingHdl)==IDTYP(h))
928          && (h->data.uring==currRingHdl->data.uring))
929        break;
930      currRingHdl=IDNEXT(currRingHdl);
931    }
932  }
933}
934
935idhdl rFindHdl(ring r, idhdl n)
936{
937  idhdl h=idroot;
938  while (h!=NULL)
939  {
940    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
941        && (h->data.uring==r)
942        && (h!=n))
943      return h;
944    h=IDNEXT(h);
945  }
946  return NULL;
947}
948
949int rOrderName(char * ordername)
950{
951  int order=0;
952 
953  switch (*ordername)
954  {
955  case 'l':
956    if (*(ordername+1)=='p') order = ringorder_lp;
957    else if (*(ordername+1)=='s') order = ringorder_ls;
958    break;
959  case 'd':
960    if (*(ordername+1)=='p') order = ringorder_dp;
961    else if (*(ordername+1)=='s') order = ringorder_ds;
962    break;
963  case 'w':
964    if (*(ordername+1)=='p') order = ringorder_wp;
965    else if (*(ordername+1)=='s') order = ringorder_ws;
966    break;
967  case 'D':
968    if (*(ordername+1)=='p') order = ringorder_Dp;
969    else if (*(ordername+1)=='s') order = ringorder_Ds;
970    break;
971  case 'W':
972    if (*(ordername+1)=='p') order = ringorder_Wp;
973    else if (*(ordername+1)=='s') order = ringorder_Ws;
974    break;
975  case 'c': order = ringorder_c; break;
976  case 'C': order = ringorder_C; break;
977  case 'a': order = ringorder_a; break;
978  case 'M': order = ringorder_M; break;
979  default: break;
980  }
981  if (order==0) Werror("wrong ring order `%s`",ordername);
982  FreeL((ADDRESS)ordername);
983  return order;
984}
985
986char * rOrdStr(ring r)
987{
988  int nblocks,l,i;
989 
990  for (nblocks=0; r->order[nblocks]; nblocks++);
991  nblocks--;
992 
993  StringSetS("");
994  for (l=0; ; l++)
995  {
996    StringAppend("%c",(" acCMldDwWldDwW")[r->order[l]]);
997    if (r->order[l]>=ringorder_lp)
998    {
999      if (r->order[l]>=ringorder_ls)
1000        StringAppendS("s");
1001      else
1002        StringAppendS("p");
1003    }
1004    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
1005    {
1006      if (r->wvhdl[l]!=NULL)
1007      {
1008        StringAppendS("(");
1009        for (int j= 0;
1010             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
1011             j+=i+1)
1012        {
1013          char c=',';
1014          for (i = 0; i<r->block1[l]-r->block0[l]; i++)
1015          {
1016            StringAppend("%d," ,r->wvhdl[l][i+j]);
1017          }
1018          if (r->order[l]!=ringorder_M)
1019          {
1020            StringAppend("%d)" ,r->wvhdl[l][i+j]);
1021            break;
1022          }
1023          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
1024            c=')';
1025          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
1026        }
1027      }
1028      else
1029        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
1030    }
1031    if (l==nblocks) return mstrdup(StringAppendS(""));
1032    StringAppendS(",");
1033  }
1034}
1035
1036char * rVarStr(ring r)
1037{
1038  int i;
1039  int l=2;
1040  char *s;
1041 
1042  for (i=0; i<r->N; i++)
1043  {
1044    l+=strlen(r->names[i])+1;
1045  }
1046  s=(char *)AllocL(l);
1047  s[0]='\0';
1048  for (i=0; i<r->N-1; i++)
1049  {
1050    strcat(s,r->names[i]);
1051    strcat(s,",");
1052  }
1053  strcat(s,r->names[i]);
1054  return s;
1055}
1056
1057char * rCharStr(ring r)
1058{
1059  char *s;
1060  int i;
1061 
1062  if (r->parameter==NULL)
1063  {
1064    i=r->ch;
1065    if(i==-1)
1066      s=mstrdup("real");                    /* R */
1067    else
1068    {
1069      s=(char *)AllocL(6);
1070      sprintf(s,"%d",i);                   /* Q, Z/p */
1071    }
1072    return s;
1073  }
1074  int l=0;
1075  for(i=0; i<r->P;i++)
1076  {
1077    l+=(strlen(r->parameter[i])+1);
1078  }
1079  s=(char *)AllocL(l+6);
1080  s[0]='\0';
1081  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
1082  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
1083  else
1084  {
1085    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq  */
1086    return s;
1087  }
1088  char tt[2];
1089  tt[0]=',';
1090  tt[1]='\0';
1091  for(i=0; i<r->P;i++)
1092  {
1093    strcat(s,tt);
1094    strcat(s,r->parameter[i]);
1095  }
1096  return s;
1097}
1098
1099char * rParStr(ring r)
1100{
1101  if (r->parameter==NULL) return mstrdup("");
1102 
1103  int i;
1104  int l=2;
1105 
1106  for (i=0; i<r->P; i++)
1107  {
1108    l+=strlen(r->parameter[i])+1;
1109  }
1110  char *s=(char *)AllocL(l);
1111  s[0]='\0';
1112  for (i=0; i<r->P-1; i++)
1113  {
1114    strcat(s,r->parameter[i]);
1115    strcat(s,",");
1116  }
1117  strcat(s,r->parameter[i]);
1118  return s;
1119}
1120
1121char * rString(ring r)
1122{
1123  char *ch=rCharStr(r);
1124  char *var=rVarStr(r);
1125  char *ord=rOrdStr(r);
1126  char *res=(char *)AllocL(strlen(ch)+strlen(var)+strlen(ord)+9);
1127  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
1128  FreeL((ADDRESS)ch);
1129  FreeL((ADDRESS)var);
1130  FreeL((ADDRESS)ord);
1131  return res;
1132} 
1133
1134int rChar(ring r)
1135{
1136  if (r->ch==-1)
1137    return 0;
1138  if (r->parameter==NULL) /* Q, Fp */
1139    return r->ch;
1140  if (r->ch<0)           /* Fp(a)  */
1141    return -r->ch;
1142  if (r->ch==1)          /* Q(a)  */
1143    return 0;
1144  /*else*/               /* GF(p,n) */
1145  {
1146    if ((r->ch & 1)==0) return 2;
1147    int i=3;
1148    while ((r->ch % i)!=0) i+=2;
1149    return i;
1150  }
1151}
1152
1153int    rIsExtension(ring r)
1154{
1155  if (r->parameter==NULL) /* Q, Fp */
1156    return FALSE;
1157  else
1158    return TRUE;
1159}
1160
1161int    rIsExtension()
1162{
1163  return rIsExtension( currRing );
1164}
1165
1166/*2
1167 *returns -1 for not compatible, (sum is undefined)
1168 *         0 for equal, (and sum)
1169 *         1 for compatible (and sum)
1170 */
1171int rSum(ring r1, ring r2, ring &sum)
1172{
1173  if (r1==r2)
1174  {
1175    sum=r1;
1176    r1->ref++;
1177    return 0;
1178  }
1179  ip_sring tmpR;
1180  memset(&tmpR,0,sizeof(tmpR));
1181  /* check coeff. field =====================================================*/
1182  if (r1->ch==r2->ch)
1183  {
1184    tmpR.ch=r1->ch;
1185    if ((r1->ch==0)||(r1->ch>=2)) /* Q, Z/p, GF(p,n) */
1186    {
1187      if (r1->parameter!=NULL)
1188      {
1189        if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1190        {
1191          tmpR.parameter=(char **)Alloc(sizeof(char *));
1192          tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1193          tmpR.P=1;
1194        }
1195        else
1196        {
1197          WerrorS("GF(p,n)+GF(p,n)");
1198          return -1;
1199        }
1200      }
1201    }
1202    else if ((r1->ch==1)||(r1->ch<-1)) /* Q(a),Z/p(a) */
1203    {
1204      if (r1->minpoly!=NULL)
1205      {
1206        if (r2->minpoly!=NULL)
1207        {
1208          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1209          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1210              && naEqual(r1->minpoly,r2->minpoly))
1211          {
1212            tmpR.parameter=(char **)Alloc(sizeof(char *));
1213            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1214            tmpR.minpoly=naCopy(r1->minpoly);
1215            tmpR.P=1;
1216            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1217          }
1218          else
1219          {
1220            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1221            WerrorS("different minpolys");
1222            return -1;
1223          }
1224        }
1225        else
1226        {
1227          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1228              && (r2->P==1))
1229          {
1230            tmpR.parameter=(char **)Alloc0(sizeof(char *));
1231            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1232            tmpR.P=1;
1233            nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1234            tmpR.minpoly=naCopy(r1->minpoly);
1235            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1236          }
1237          else
1238          {
1239            WerrorS("different parameters and minpoly!=0");
1240            return -1;
1241          }
1242        }
1243      }
1244      else /* r1->minpoly==NULL */
1245      {
1246        if (r2->minpoly!=NULL)
1247        {
1248          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1249              && (r1->P==1))
1250          {
1251            tmpR.parameter=(char **)Alloc(sizeof(char *));
1252            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1253            tmpR.P=1;
1254            nSetChar(r2->ch,TRUE,r2->parameter,r2->P);
1255            tmpR.minpoly=naCopy(r2->minpoly);
1256            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1257          }
1258          else
1259          {
1260            WerrorS("different parameters and minpoly!=0");
1261            return -1;
1262          }
1263        }
1264        else
1265        {
1266          int len=rPar(r1)+rPar(r2);
1267          tmpR.parameter=(char **)Alloc(len*sizeof(char *));
1268          int i;
1269          for (i=0;i<r1->P;i++)
1270          {
1271            tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1272          }
1273          int j,l;
1274          for(j=0;j<r2->P;j++)
1275          {
1276            for(l=0;l<i;l++)
1277            {
1278              if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
1279                break;
1280            }
1281            if (l==i)
1282            {
1283              tmpR.parameter[i]=mstrdup(r2->parameter[j]);
1284              i++;
1285            }
1286          }
1287          if (i!=len)
1288          {
1289            ReAlloc(tmpR.parameter,len*sizeof(char *),i*sizeof(char *));
1290          }
1291        }
1292      }
1293    }
1294  }
1295  else /* r1->ch!=r2->ch */
1296  {
1297    if (r1->ch<-1) /* Z/p(a) */
1298    {
1299      if ((r2->ch==0) /* Q */
1300          || (r2->ch==-r1->ch)) /* Z/p */
1301      {
1302        tmpR.ch=r1->ch;
1303        tmpR.parameter=(char **)Alloc(rPar(r1)*sizeof(char *));
1304        tmpR.P=r1->P;
1305        memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char *));
1306        if (r1->minpoly!=NULL)
1307        {
1308          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1309          tmpR.minpoly=naCopy(r1->minpoly);
1310          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1311        }
1312      }
1313      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
1314      {
1315        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
1316        return -1;
1317      }
1318    }
1319    else if (r1->ch==-1) /* R */
1320    {
1321      WerrorS("R+..");
1322      return -1;
1323    }
1324    else if (r1->ch==0) /* Q */
1325    {
1326      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
1327      {
1328        tmpR.ch=r2->ch;
1329        tmpR.P=r2->P;
1330        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1331        memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char *));
1332        if (r2->minpoly!=NULL)
1333        {
1334          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1335          tmpR.minpoly=naCopy(r2->minpoly);
1336          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1337        }
1338      }
1339      else if (r2->ch>1) /* Z/p,GF(p,n) */
1340      {
1341        tmpR.ch=r2->ch;
1342        if (r2->parameter!=NULL)
1343        {
1344          tmpR.parameter=(char **)Alloc(sizeof(char *));
1345          tmpR.P=1;
1346          tmpR.parameter[0]=mstrdup(r2->parameter[0]);
1347        }
1348      }
1349      else
1350      {
1351        WerrorS("Q+R");
1352        return -1; /* R */
1353      }
1354    }
1355    else if (r1->ch==1) /* Q(a) */
1356    {
1357      if (r2->ch==0) /* Q */
1358      {
1359        tmpR.ch=r1->ch;
1360        tmpR.P=rPar(r1);
1361        tmpR.parameter=(char **)Alloc0(rPar(r1)*sizeof(char *));
1362        int i;
1363        for(i=0;i<r1->P;i++)
1364        {
1365          tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1366        }
1367        if (r1->minpoly!=NULL)
1368        {
1369          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1370          tmpR.minpoly=naCopy(r1->minpoly);
1371          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1372        }
1373      }
1374      else  /* R, Z/p,GF(p,n) */
1375      {
1376        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1377        return -1;
1378      }
1379    }
1380    else /* r1->ch >=2 , Z/p */
1381    {
1382      if (r2->ch==0) /* Q */
1383      {
1384        tmpR.ch=r1->ch;
1385      }
1386      else if (r2->ch==-r1->ch) /* Z/p(a) */
1387      {
1388        tmpR.ch=r2->ch;
1389        tmpR.P=rPar(r2);
1390        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1391        int i;
1392        for(i=0;i<r2->P;i++)
1393        {
1394          tmpR.parameter[i]=mstrdup(r2->parameter[i]);
1395        }
1396        if (r2->minpoly!=NULL)
1397        {
1398          nSetChar(r2->ch,TRUE,r2->parameter,r2->P);
1399          tmpR.minpoly=naCopy(r2->minpoly);
1400          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1401        }
1402      }
1403      else
1404      {
1405        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1406        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1407      }
1408    }
1409  }
1410  /* variable names ========================================================*/
1411  int i,j,k;
1412  int l=r1->N+r2->N;
1413  char **names=(char **)Alloc0(l*sizeof(char*));
1414  k=0;
1415 
1416  // collect all varnames from r1, except those which are parameters
1417  // of r2, or those which are the empty string
1418  for (i=0;i<r1->N;i++)
1419  {
1420    BOOLEAN b=TRUE;
1421   
1422    if (*(r1->names[i]) == '\0')
1423      b = FALSE;
1424    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1425    {
1426      for(j=0;j<r2->P;j++)
1427      {
1428        if (strcmp(r1->names[i],r2->parameter[j])==0)
1429        {
1430          b=FALSE;
1431          break;
1432        }
1433      }
1434    }
1435   
1436    if (b)
1437    {
1438      //Print("name : %d: %s\n",k,r1->names[i]);
1439      names[k]=mstrdup(r1->names[i]);
1440      k++;
1441    }
1442    //else
1443    //  Print("no name (par1) %s\n",r1->names[i]);
1444  }
1445  // Add variables from r2, except those which are parameters of r1
1446  // those which are empty strings, and those which equal a var of r1
1447  for(i=0;i<r2->N;i++)
1448  {
1449    BOOLEAN b=TRUE;
1450   
1451    if (*(r2->names[i]) == '\0')
1452      b = FALSE;
1453    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1454    {
1455      for(j=0;j<r1->P;j++)
1456      {
1457        if (strcmp(r2->names[i],r1->parameter[j])==0)
1458        {
1459          b=FALSE;
1460          break;
1461        }
1462      }
1463    }
1464   
1465    if (b)
1466    {
1467      for(j=0;j<r1->N;j++)
1468      {
1469        if (strcmp(r1->names[j],r2->names[i])==0)
1470        {
1471          b=FALSE;
1472          break;
1473        }
1474      }
1475      if (b)
1476      {
1477        names[k]=mstrdup(r2->names[i]);
1478        //Print("name : %d : %s\n",k,r2->names[i]);
1479        k++;
1480      }
1481      //else
1482      //  Print("no name (var): %s\n",r2->names[i]);
1483    }
1484    //else
1485    //  Print("no name (par): %s\n",r2->names[i]);
1486  }
1487  // check whether we found any vars at all
1488  if (k == 0)
1489  {
1490    names[k]=mstrdup("");
1491    k=1;
1492  }
1493  tmpR.N=k;
1494  tmpR.names=names;
1495  /* ordering *======================================================== */
1496  tmpR.OrdSgn=1;
1497  if ((r1->order[0]==ringorder_unspec)
1498      && (r2->order[0]==ringorder_unspec))
1499  {
1500    tmpR.order=(int*)Alloc(3*sizeof(int));
1501    tmpR.block0=(int*)Alloc(3*sizeof(int));
1502    tmpR.block1=(int*)Alloc(3*sizeof(int));
1503    tmpR.wvhdl=(short**)Alloc0(3*sizeof(short*));
1504    tmpR.order[0]=ringorder_unspec;
1505    tmpR.order[1]=ringorder_C;
1506    tmpR.order[2]=0;
1507    tmpR.block0[0]=1;
1508    tmpR.block1[0]=tmpR.N;
1509  }
1510  else if (l==k) /* r3=r1+r2 */
1511  {
1512    int b;
1513    ring rb;
1514    if (r1->order[0]==ringorder_unspec)
1515    {
1516      /* extend order of r2 to r3 */
1517      b=rBlocks(r2);
1518      rb=r2;
1519      tmpR.OrdSgn=r2->OrdSgn;
1520    }
1521    else if (r2->order[0]==ringorder_unspec)
1522    {
1523      /* extend order of r1 to r3 */
1524      b=rBlocks(r1);
1525      rb=r1;
1526      tmpR.OrdSgn=r1->OrdSgn;
1527    }
1528    else
1529    {
1530      b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1531      rb=NULL;
1532    }
1533    tmpR.order=(int*)Alloc0(b*sizeof(int));
1534    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1535    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1536    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1537    /* weights not implemented yet ...*/
1538    if (rb!=NULL)
1539    {
1540      for (i=0;i<b;i++)
1541      {
1542        tmpR.order[i]=rb->order[i];
1543        tmpR.block0[i]=rb->block0[i];
1544        tmpR.block1[i]=rb->block1[i];
1545      }
1546      tmpR.block0[0]=1;
1547    }
1548    else /* ring sum for complete rings */
1549    {
1550      for (i=0;r1->order[i]!=0;i++)
1551      {
1552        tmpR.order[i]=r1->order[i];
1553        tmpR.block0[i]=r1->block0[i];
1554        tmpR.block1[i]=r1->block1[i];
1555      }
1556      j=i;
1557      i--;
1558      if ((r1->order[i]==ringorder_c)
1559          ||(r1->order[i]==ringorder_C))
1560      {
1561        j--;
1562        tmpR.order[b-2]=r1->order[i];
1563      }
1564      for (i=0;r2->order[i]!=0;i++,j++)
1565      {
1566        if ((r2->order[i]!=ringorder_c)
1567            &&(r2->order[i]!=ringorder_C))
1568        {
1569          tmpR.order[j]=r2->order[i];
1570          tmpR.block0[j]=r2->block0[i]+r1->N;
1571          tmpR.block1[j]=r2->block1[i]+r1->N;
1572        }
1573      }
1574      if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1575        tmpR.OrdSgn=-1;
1576    }
1577  }
1578  else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1579    /* copy r1, because we have the variables from r1 */
1580  {
1581    int b=rBlocks(r1);
1582   
1583    tmpR.order=(int*)Alloc0(b*sizeof(int));
1584    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1585    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1586    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1587    /* weights not implemented yet ...*/
1588    for (i=0;i<b;i++)
1589    {
1590      tmpR.order[i]=r1->order[i];
1591      tmpR.block0[i]=r1->block0[i];
1592      tmpR.block1[i]=r1->block1[i];
1593    }
1594    tmpR.OrdSgn=r1->OrdSgn;
1595  }
1596  else
1597  {
1598    for(i=0;i<k;i++) FreeL((ADDRESS)tmpR.names[i]);
1599    Free((ADDRESS)names,tmpR.N*sizeof(char *));
1600    Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1601    return -1;
1602  }
1603  sum=(ring)Alloc(sizeof(ip_sring));
1604  memcpy(sum,&tmpR,sizeof(ip_sring));
1605#ifdef COMP_FAST 
1606  rComplete(sum);
1607#endif 
1608  return 1;
1609}
1610
1611/*2
1612 * create a copy of the ring r, which must be equivalent to currRing
1613 * used for qring definition,..
1614 * (i.e.: normal rings: same nCopy as currRing;
1615 *        qring:        same nCopy, same idCopy as currRing)
1616 */
1617ring rCopy(ring r)
1618{
1619  int i,j;
1620  int *pi;
1621  ring res=(ring)Alloc(sizeof(ip_sring));
1622 
1623  memcpy4(res,r,sizeof(ip_sring));
1624  if (r->parameter!=NULL)
1625  {
1626    res->minpoly=nCopy(r->minpoly);
1627    int l=rPar(r);
1628    res->parameter=(char **)Alloc(l*sizeof(char *));
1629    int i;
1630    for(i=0;i<r->P;i++)
1631    {
1632      res->parameter[i]=mstrdup(r->parameter[i]);
1633    }
1634  }
1635  res->names   = (char **)Alloc(r->N * sizeof(char *));
1636  i=1;
1637  pi=r->order;
1638  while ((*pi)!=0) { i++;pi++; }
1639  res->wvhdl   = (short **)Alloc(i * sizeof(short *));
1640  res->order   = (int *)   Alloc(i * sizeof(int));
1641  res->block0  = (int *)   Alloc(i * sizeof(int));
1642  res->block1  = (int *)   Alloc(i * sizeof(int));
1643  for (j=0; j<i; j++)
1644  {
1645    if (r->wvhdl[j]!=NULL)
1646    {
1647      res->wvhdl[j]=(short*)AllocL(mmSizeL((ADDRESS)r->wvhdl[j]));
1648      memcpy(res->wvhdl[j],r->wvhdl[j],mmSizeL((ADDRESS)r->wvhdl[j]));
1649    }
1650    else
1651      res->wvhdl[j]=NULL;
1652  }
1653  memcpy4(res->order,r->order,i * sizeof(int));
1654  memcpy4(res->block0,r->block0,i * sizeof(int));
1655  memcpy4(res->block1,r->block1,i * sizeof(int));
1656  for (i=0; i<res->N; i++)
1657  {
1658    res->names[i] = mstrdup(r->names[i]);
1659  }
1660  res->idroot = NULL;
1661  if (r->qideal!=NULL) res->qideal= idCopy(r->qideal);
1662#ifdef RDEBUG
1663  res->no=rNumber; rNumber++;
1664#endif
1665  return res;
1666}
Note: See TracBrowser for help on using the repository browser.