source: git/Singular/ipshell.cc @ 5480da

fieker-DuValspielwiese
Last change on this file since 5480da was fca547, checked in by Hans Schönemann <hannes@…>, 26 years ago
*** empty log message *** git-svn-id: file:///usr/local/Singular/svn/trunk@1317 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 17.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipshell.cc,v 1.17 1998-04-03 17:38:41 Singular Exp $ */
5/*
6* ABSTRACT:
7*/
8
9//#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13
14#include "mod2.h"
15#include "tok.h"
16#include "ipid.h"
17#include "intvec.h"
18#include "mmemory.h"
19#include "febase.h"
20#include "polys.h"
21#include "ideals.h"
22#include "matpol.h"
23#include "kstd1.h"
24#include "ring.h"
25#include "subexpr.h"
26#include "maps.h"
27#include "syz.h"
28#include "numbers.h"
29#include "lists.h"
30#include "attrib.h"
31#include "ipconv.h"
32#include "silink.h"
33#include "ipshell.h"
34
35leftv iiCurrArgs=NULL;
36int  traceit = 0;
37char *lastreserved=NULL;
38
39int  myynest = -1;
40
41static BOOLEAN iiNoKeepRing=TRUE;
42
43/*0 implementation*/
44
45char * Tok2Cmdname(int tok)
46{
47  int i = 0;
48  if (tok < 0)
49  {
50    return cmds[0].name;
51  }
52  if (tok==ANY_TYPE) return "any_type";
53  if (tok==NONE) return "nothing";
54  //if (tok==IFBREAK) return "if_break";
55  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
56  //if (tok==ORDER_VECTOR) return "ordering";
57  //if (tok==REF_VAR) return "ref";
58  //if (tok==OBJECT) return "object";
59  //if (tok==PRINT_EXPR) return "print_expr";
60  if (tok==IDHDL) return "identifier";
61  while (cmds[i].tokval!=0)
62  {
63    if ((cmds[i].tokval == tok)&&(cmds[i].alias==0))
64    {
65      return cmds[i].name;
66    }
67    i++;
68  }
69  return cmds[0].name;
70}
71
72char * iiTwoOps(int t)
73{
74  if (t<127)
75  {
76    static char ch[2];
77    switch (t)
78    {
79      case '&':
80        return "and";
81      case '|':
82        return "or";
83      default:
84        ch[0]=t;
85        ch[1]='\0';
86        return ch;
87    }
88  }
89  switch (t)
90  {
91    case COLONCOLON:  return "::";
92    case DOTDOT:      return "..";
93    //case PLUSEQUAL:   return "+=";
94    //case MINUSEQUAL:  return "-=";
95    case MINUSMINUS:  return "--";
96    case PLUSPLUS:    return "++";
97    case EQUAL_EQUAL: return "==";
98    case LE:          return "<=";
99    case GE:          return ">=";
100    case NOTEQUAL:    return "<>";
101    default:          return Tok2Cmdname(t);
102  }
103}
104
105static void list1(char* s, idhdl h,BOOLEAN c)
106{
107  char buffer[22];
108  int l;
109
110  Print("%s%-20.20s [%d]  ",s,IDID(h),IDLEV(h));
111  if (h == currRingHdl) PrintS("*");
112  PrintS(Tok2Cmdname((int)IDTYP(h)));
113
114  ipListFlag(h);
115  switch(IDTYP(h))
116  {
117    case INT_CMD:     Print(" %d",IDINT(h)); break;
118    case INTVEC_CMD:  Print(" (%d)",IDINTVEC(h)->length()); break;
119    case INTMAT_CMD:  Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
120                   break;
121    case POLY_CMD:
122    case VECTOR_CMD:  if (c)
123                   {
124                     PrintS(" ");wrp(IDPOLY(h));
125                     if(IDPOLY(h) != NULL)
126                     {
127                       Print(", %d monomial(s)",pLength(IDPOLY(h)));
128                     }
129                   }
130                   break;
131    case MODUL_CMD:   Print(", rk %d", IDIDEAL(h)->rank);
132    case IDEAL_CMD:   Print(", %u generator(s)",
133                     IDELEMS(IDIDEAL(h)),IDIDEAL(h)->rank); break;
134    case MAP_CMD:
135                   Print(" from %s",IDMAP(h)->preimage); break;
136    case MATRIX_CMD: Print(" %u x %u"
137                        ,MATROWS(IDMATRIX(h))
138                        ,MATCOLS(IDMATRIX(h))
139                        );
140                   break;
141    case PROC_CMD:    break;
142    case STRING_CMD:
143                   {
144                     char *s;
145                     l=strlen(IDSTRING(h));
146                     memset(buffer,0,22);
147                     strncpy(buffer,IDSTRING(h),min(l,20));
148                     if ((s=strchr(buffer,'\n'))!=NULL)
149                     {
150                       *s='\0';
151                     }
152                     PrintS(" ");
153                     PrintS(buffer);
154                     if((s!=NULL) ||(l>20))
155                     {
156                       Print("..., %d char(s)",l);
157                     }
158                     break;
159                   }
160    case LIST_CMD:   Print(", size: %d",IDLIST(h)->nr+1);
161                   break;
162    case QRING_CMD:
163    case RING_CMD:
164#ifdef RDEBUG
165                   if (traceit &TRACE_SHOW_RINGS) Print(" <%d>",IDRING(h)->no);
166#endif
167                   break;
168    /*default:     break;*/
169  }
170  PrintLn();
171}
172
173void type_cmd(idhdl h)
174{
175  int saveShortOut=pShortOut;
176  pShortOut=1;
177  list1("// ",h,FALSE);
178  if (IDTYP(h)!=INT_CMD)
179  {
180    sleftv expr;
181    memset(&expr,0,sizeof(expr));
182    expr.rtyp=IDHDL;
183    expr.name=IDID(h);
184    expr.data=(void *)h;
185    expr.Print();
186  }
187  pShortOut=saveShortOut;
188}
189
190static void killlocals0(int v, idhdl * localhdl)
191{
192  idhdl h = *localhdl;
193  while (h!=NULL)
194  {
195    int vv;
196    //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
197    if ((vv=IDLEV(h))>0)
198    {
199      if (vv < v)
200      {
201        if (iiNoKeepRing) 
202        {
203          //PrintS(" break\n");
204          return;
205        } 
206        h = IDNEXT(h);
207        //PrintLn();
208      }
209      else if (vv >= v)
210      {
211        idhdl nexth = IDNEXT(h);
212        killhdl(h,localhdl);
213        h = nexth;
214        //PrintS("kill\n");
215      }
216    }
217    else
218    {
219      h = IDNEXT(h);
220      //PrintLn();
221    }
222  }
223}
224
225void killlocals(int v)
226{
227  killlocals0(v,&idroot);
228
229  idhdl h = idroot;
230  idhdl sh=currRingHdl;
231  BOOLEAN changed=FALSE;
232
233  while (h!=NULL)
234  {
235    if (((IDTYP(h)==QRING_CMD) || (IDTYP(h) == RING_CMD))
236    && (IDRING(h)->idroot!=NULL))
237    {
238      if (h!=currRingHdl) {changed=TRUE;rSetHdl(h,FALSE);}
239      killlocals0(v,&(IDRING(h)->idroot));
240    }
241    h = IDNEXT(h);
242  }
243  if (changed)
244  {
245    currRing=NULL;
246    currRingHdl=NULL;
247    rSetHdl(sh,TRUE);
248  }
249  if (myynest<=1) iiNoKeepRing=TRUE;
250}
251
252void list_cmd(int typ, const char* what, char *prefix,BOOLEAN iterate)
253{
254  idhdl h,start;
255  BOOLEAN all = typ==-1;
256  BOOLEAN really_all=FALSE;
257
258  if ( typ==0 )
259  {
260    if (strcmp(what,"all")==0)
261    {
262      really_all=TRUE;
263      h=idroot;
264    }
265    else
266    {
267      h = ggetid(what);
268      if (h!=NULL)
269      {
270        if (iterate) list1(prefix,h,TRUE);
271        if ((IDTYP(h)==RING_CMD)
272        || (IDTYP(h)==QRING_CMD)
273        || (IDTYP(h)==PACKAGE_CMD))
274        {
275          h=IDRING(h)->idroot;
276        }
277        else
278          return;
279      }
280      else
281      {
282        Werror("%s is undefined",what);
283        return;
284      }
285    }
286    all=TRUE;
287  }
288  else if ((typ>BEGIN_RING) && (typ<END_RING))
289  {
290    h = currRing->idroot;
291  }
292  else
293    h = idroot;
294  start=h;
295  while (h!=NULL)
296  {
297    if ((all && (IDTYP(h)!=PROC_CMD)) || (typ == IDTYP(h))
298    || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD)))
299    {
300      list1(prefix,h,start==currRingHdl);
301      if ((((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
302        && (really_all || (all && (h==currRingHdl)))
303        && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
304      ||(IDTYP(h)==PACKAGE_CMD))
305      {
306        list_cmd(0,IDID(h),"//      ",FALSE);
307      }
308    }
309    h = IDNEXT(h);
310  }
311}
312
313void test_cmd(int i)
314{
315  int ii=(char)i;
316
317  if (i == (-32))
318  {
319    test = 0;
320  }
321  else
322  {
323    if (i<0)
324    {
325      ii= -i;
326      if (Sy_bit(ii) & kOptions)
327      {
328        Warn("use the option command");
329        test &= ~Sy_bit(ii);
330      }
331      else if (Sy_bit(ii) & validOpts)
332        test &= ~Sy_bit(ii);
333    }
334    else if (i<32)
335    {
336      if (Sy_bit(ii) & kOptions)
337      {
338        Warn("use the option command");
339        test |= Sy_bit(ii);
340      }
341      else if (Sy_bit(ii) & validOpts)
342        test |= Sy_bit(ii);
343    }
344  }
345}
346
347int exprlist_length(leftv v)
348{
349  int rc = 0;
350  while (v!=NULL)
351  {
352    switch (v->Typ())
353    {
354      case INT_CMD:
355      case POLY_CMD:
356      case VECTOR_CMD:
357      case NUMBER_CMD:
358        rc++;
359        break;
360      case INTVEC_CMD:
361      case INTMAT_CMD:
362        rc += ((intvec *)(v->Data()))->length();
363        break;
364      case MATRIX_CMD:
365      case IDEAL_CMD:
366      case MODUL_CMD:
367        {
368          matrix mm = (matrix)(v->Data());
369          rc += mm->rows() * mm->cols();
370        }
371        break;
372      case LIST_CMD:
373        rc+=((lists)v->Data())->nr+1;
374        break;
375      default:
376        rc++;
377    }
378    v = v->next;
379  }
380  return rc;
381}
382
383void iiWriteMatrix(matrix im, const char *n, int dim,int spaces)
384{
385  int i,ii = MATROWS(im)-1;
386  int j,jj = MATCOLS(im)-1;
387  poly *pp = im->m;
388
389  for (i=0; i<=ii; i++)
390  {
391    for (j=0; j<=jj; j++)
392    {
393      if (spaces>0)
394        Print("%-*.*s",spaces,spaces," ");
395      if (dim == 2) Print("%s[%u,%u]=",n,i+1,j+1);
396      else if (dim == 1) Print("%s[%u]=",n,j+1);
397      else if (dim == 0) Print("%s=",n);
398      if ((i<ii)||(j<jj)) pWrite(*pp++);
399      else                pWrite0(*pp);
400    }
401  }
402}
403
404char * iiStringMatrix(matrix im, int dim,char ch)
405{
406  int i,ii = MATROWS(im);
407  int j,jj = MATCOLS(im);
408  poly *pp = im->m;
409  char *s=StringSet("");
410
411  for (i=0; i<ii; i++)
412  {
413    for (j=0; j<jj; j++)
414    {
415      pString0(*pp++);
416      s=StringAppend("%c\n",ch);
417    }
418  }
419  s[strlen(s)-2]='\0';
420  return s;
421}
422
423int IsPrime(int p)  /* brute force !!!! */
424{
425  int i,j;
426  if      (p == 0) return 0;
427  else if (p == 1) return 1/*1*/;
428  else if (p == 2) return p;
429  else if (p <  0) return (-IsPrime(-p));
430  else if (!(p & 1)) return IsPrime(p-1);
431  for (j=p/2+1,i=3; i<p; i+=2)
432  {
433    if ((p%i) == 0) return IsPrime(p-2);
434    if (j < i) return p;
435  }
436  return p;
437}
438
439BOOLEAN iiWRITE(leftv res,leftv v)
440{
441  sleftv vf;
442  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
443  {
444    WerrorS("link expected");
445    return TRUE;
446  }
447  si_link l=(si_link)vf.Data();
448  if (vf.next == NULL)
449  {
450    WerrorS("write: need at least two arguments");
451    return TRUE;
452  }
453
454  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
455  if (b)
456  {
457    const char *s;
458    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
459    else                            s=sNoName;
460    Werror("cannot write to %s",s);
461  }
462  vf.CleanUp();
463  return b;
464}
465
466leftv iiMap(map theMap, char * what)
467{
468  idhdl w,r;
469  leftv v;
470  int i;
471
472  r=idroot->get(theMap->preimage,myynest);
473  if ((r!=NULL) && ((r->typ == RING_CMD) || (r->typ== QRING_CMD)))
474  {
475    if (!nSetMap(IDRING(r)->ch,IDRING(r)->parameter,IDRING(r)->P, IDRING(r)->minpoly))
476    {
477      Werror("map from characteristic %d to %d not implemented",
478        IDRING(r)->ch,currRing->ch);
479      return NULL;
480    }
481    if (IDELEMS(theMap)<IDRING(r)->N)
482    {
483      theMap->m=(polyset)ReAlloc((ADDRESS)theMap->m,IDELEMS(theMap)*sizeof(poly),
484                                     (IDRING(r)->N)*sizeof(poly));
485      for(i=IDELEMS(theMap);i<IDRING(r)->N;i++)
486        theMap->m[i]=NULL;
487      IDELEMS(theMap)=IDRING(r)->N;
488    }
489    if (what==NULL)
490    {
491      WerrorS("argument of a map must have a name");
492    }
493    else if ((w=IDRING(r)->idroot->get(what,myynest))!=NULL)
494    {
495      v=(leftv)Alloc0(sizeof(*v));
496      sleftv tmpW;
497      memset(&tmpW,0,sizeof(sleftv));
498      tmpW.rtyp=IDTYP(w);
499      tmpW.data=IDDATA(w);
500      if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,IDRING(r),NULL,NULL,0))
501      {
502        Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
503        Free((ADDRESS)v,sizeof(*v));
504        return NULL;
505      }
506      return v;
507    }
508    else
509      Werror("%s undefined in %s",what,theMap->preimage);
510  }
511  else
512    Werror("cannot find preimage %s",theMap->preimage);
513  return NULL;
514}
515
516#ifdef OLD_RES
517void  iiMakeResolv(resolvente r, int length, int rlen, char * name, int typ0,
518                   intvec ** weights)
519{
520  lists L=liMakeResolv(r,length,rlen,typ0,weights);
521  int i=0;
522  idhdl h;
523  char * s=(char *)Alloc(strlen(name)+5);
524
525  while (i<=L->nr)
526  {
527    sprintf(s,"%s(%d)",name,i+1);
528    if (i==0)
529      h=enterid(mstrdup(s),myynest,typ0,&(currRing->idroot), FALSE);
530    else
531      h=enterid(mstrdup(s),myynest,MODUL_CMD,&(currRing->idroot), FALSE);
532    if (h!=NULL)
533    {
534      h->data.uideal=(ideal)L->m[i].data;
535      h->attribute=L->m[i].attribute;
536      if (BVERBOSE(V_DEF_RES))
537        Print("//defining: %s as %d-th syzygy module\n",s,i+1);
538    }
539    else
540    {
541      idDelete((ideal *)&(L->m[i].data));
542      Warn("cannot define %s",s);
543    }
544    //L->m[i].data=NULL;
545    //L->m[i].rtyp=0;
546    //L->m[i].attribute=NULL;
547    i++;
548  }
549  Free((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
550  Free((ADDRESS)L,sizeof(slists));
551  Free((ADDRESS)s,strlen(name)+5);
552}
553#endif
554
555//resolvente iiFindRes(char * name, int * len, int *typ0)
556//{
557//  char *s=(char *)Alloc(strlen(name)+5);
558//  int i=-1;
559//  resolvente r;
560//  idhdl h;
561//
562//  do
563//  {
564//    i++;
565//    sprintf(s,"%s(%d)",name,i+1);
566//    h=currRing->idroot->get(s,myynest);
567//  } while (h!=NULL);
568//  *len=i-1;
569//  if (*len<=0)
570//  {
571//    Werror("no objects %s(1),.. found",name);
572//    Free((ADDRESS)s,strlen(name)+5);
573//    return NULL;
574//  }
575//  r=(ideal *)Alloc(/*(len+1)*/ i*sizeof(ideal));
576//  memset(r,0,(*len)*sizeof(ideal));
577//  i=-1;
578//  *typ0=MODUL_CMD;
579//  while (i<(*len))
580//  {
581//    i++;
582//    sprintf(s,"%s(%d)",name,i+1);
583//    h=currRing->idroot->get(s,myynest);
584//    if (h->typ != MODUL_CMD)
585//    {
586//      if ((i!=0) || (h->typ!=IDEAL_CMD))
587//      {
588//        Werror("%s is not of type module",s);
589//        Free((ADDRESS)r,(*len)*sizeof(ideal));
590//        Free((ADDRESS)s,strlen(name)+5);
591//        return NULL;
592//      }
593//      *typ0=IDEAL_CMD;
594//    }
595//    if ((i>0) && (idIs0(r[i-1])))
596//    {
597//      *len=i-1;
598//      break;
599//    }
600//    r[i]=IDIDEAL(h);
601//  }
602//  Free((ADDRESS)s,strlen(name)+5);
603//  return r;
604//}
605
606static resolvente iiCopyRes(resolvente r, int l)
607{
608  int i;
609  resolvente res=(ideal *)Alloc0((l+1)*sizeof(ideal));
610
611  for (i=0; i<l; i++)
612    res[i]=idCopy(r[i]);
613  return res;
614}
615
616BOOLEAN jjMINRES(leftv res, leftv v)
617{
618  int len=0;
619  int typ0;
620  resolvente rr=liFindRes((lists)v->Data(),&len,&typ0);
621  if (rr==NULL) return TRUE;
622  resolvente r=iiCopyRes(rr,len);
623
624  syMinimizeResolvente(r,len,0);
625  Free((ADDRESS)rr,len*sizeof(ideal));
626  len++;
627  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL);
628  return FALSE;
629}
630
631BOOLEAN jjBETTI(leftv res, leftv v)
632{
633  resolvente r;
634  int len;
635  int reg,typ0;
636
637  r=liFindRes((lists)v->Data(),&len,&typ0);
638  if (r==NULL) return TRUE;
639  res->data=(char *)syBetti(r,len,&reg);
640  Free((ADDRESS)r,(len)*sizeof(ideal));
641  return FALSE;
642}
643
644int iiRegularity(lists L)
645{
646  resolvente r;
647  int len,reg,typ0;
648  intvec * dummy;
649
650  r=liFindRes(L,&len,&typ0);
651  if (r==NULL) return -1;
652  dummy=syBetti(r,len,&reg);
653  Free((ADDRESS)r,len*sizeof(ideal));
654  delete dummy;
655  return reg-1;
656}
657
658BOOLEAN iiDebugMarker=TRUE;
659void iiDebug()
660{
661  Print("\n-- break point in %s --\n",VoiceName());
662  if (iiDebugMarker) VoiceBackTrack();
663  char * s;
664  iiDebugMarker=FALSE;
665  s = (char *)AllocL(84);
666  fe_fgets_stdin(s,80);
667  if (*s=='\n')
668  {
669    iiDebugMarker=TRUE;
670  }
671  else
672  {
673    strcat( s, "\n;~\n");
674    newBuffer(s,BT_execute);
675  }
676}
677
678int iiDeclCommand(leftv sy, leftv name, int lev,int t, idhdl* root,BOOLEAN init_b)
679{
680  BOOLEAN res=FALSE;
681  memset(sy,0,sizeof(sleftv));
682  if ((name->name==NULL)||(isdigit(name->name[0])))
683  {
684    WerrorS("object to declare is not a name");
685    res=TRUE;
686  }
687  else
688  {
689    sy->data = (char *)enterid(name->name,lev,t,root,init_b);
690    if (sy->data!=NULL)
691    {
692      sy->rtyp=IDHDL;
693      currid=sy->name=IDID((idhdl)sy->data);
694      name->name=NULL; /* used in enterid */
695      //sy->e = NULL;
696      if (name->next!=NULL)
697      {
698        sy->next=(leftv)Alloc(sizeof(sleftv));
699        res=iiDeclCommand(sy->next,name->next,lev,t,root);
700      }
701    }
702    else res=TRUE;
703  }
704  name->CleanUp();
705  return res;
706}
707
708BOOLEAN iiParameter(leftv p)
709{
710  if (iiCurrArgs==NULL)
711  {
712    if (strcmp(p->name,"#")==0) return FALSE;
713    Werror("not enough arguments for proc %s",VoiceName());
714    p->CleanUp();
715    return TRUE;
716  }
717  leftv h=iiCurrArgs;
718  if (strcmp(p->name,"#")==0)
719  {
720    iiCurrArgs=NULL;
721  }
722  else
723  {
724    iiCurrArgs=h->next;
725    h->next=NULL;
726  }
727  BOOLEAN res=iiAssign(p,h);
728  Free((ADDRESS)h,sizeof(sleftv));
729  return res;
730}
731
732BOOLEAN iiExport (leftv v, int toLev)
733{
734  BOOLEAN nok=FALSE;
735  leftv r=v;
736  while (v!=NULL)
737  {
738    if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
739    {
740      WerrorS("cannot export");
741      nok=TRUE;
742    }
743    else
744    {
745      idhdl h=(idhdl)v->data;
746      if (IDLEV(h)==0) Warn("`%s` is already global",IDID(h));
747      else
748      {
749        h=idroot->get(v->name,toLev);
750        idhdl *root=&idroot;
751        if ((h==NULL)&&(currRing!=NULL))
752        {
753          h=currRing->idroot->get(v->name,toLev);
754          root=&currRing->idroot;
755        }
756        if ((h!=NULL)&&(IDLEV(h)==toLev))
757        {
758          if (IDTYP(h)==v->Typ())
759          {
760            Warn("redefining %s",IDID(h));
761            if (iiLocalRing[0]==IDRING(h)) iiLocalRing[0]=NULL;
762            killhdl(h,root);
763          }
764          else
765          {
766            r->CleanUp();
767            return TRUE;
768          }
769        }
770        h=(idhdl)v->data;
771        IDLEV(h)=toLev;
772        iiNoKeepRing=FALSE;
773      }
774    }
775    v=v->next;
776  }
777  r->CleanUp();
778  return nok;
779}
780
781/*assume root!=idroot*/
782BOOLEAN iiExport (leftv v, int toLev, idhdl &root)
783{
784  BOOLEAN nok=FALSE;
785  leftv rv=v;
786  while (v!=NULL)
787  {
788    if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
789    )
790    {
791      WerrorS("cannot export");
792      nok=TRUE;
793    }
794    else
795    {
796      idhdl old=root->get(v->name,toLev);
797      if (old!=NULL)
798      {
799        if (IDTYP(old)==v->Typ())
800        {
801          Warn("redefining %s",IDID(old));
802          killhdl(old,&root);
803        }
804        else
805        {
806          rv->CleanUp();
807          return TRUE;
808        }
809      }
810      idhdl h=(idhdl)v->data;
811      if (h==idroot)
812      {
813        idroot=h->next;
814      }
815      else
816      {
817        idhdl hh=idroot;
818        while ((hh->next!=h)&&(hh->next!=NULL))
819          hh=hh->next;
820        if (hh->next==h)
821          hh->next=h->next;
822        else
823          break;
824      }
825      h->next=root;
826      root=h;
827      IDLEV(h)=toLev;
828    }
829    v=v->next;
830  }
831  rv->CleanUp();
832  return nok;
833}
834
835BOOLEAN iiCheckRing(int i)
836{
837  if (currRingHdl==NULL)
838  {
839    #ifdef SIQ
840    if (siq<=0)
841    {
842    #endif
843      if ((i>BEGIN_RING) && (i<END_RING))
844      {
845        WerrorS("no ring active");
846        return TRUE;
847      }
848    #ifdef SIQ
849    }
850    #endif
851  }
852  return FALSE;
853}
Note: See TracBrowser for help on using the repository browser.