source: git/Singular/ring.cc @ 18dd47

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