source: git/Singular/ring.cc @ 32df82

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