source: git/Singular/ipid.cc @ 7f68b2

fieker-DuValspielwiese
Last change on this file since 7f68b2 was 7f68b2, checked in by Hans Schönemann <hannes@…>, 22 years ago
*hannes: update error messages git-svn-id: file:///usr/local/Singular/svn/trunk@5705 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 28.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipid.cc,v 1.56 2002-01-07 17:20:48 Singular Exp $ */
5
6/*
7* ABSTRACT: identfier handling
8*/
9
10#include <string.h>
11
12#include "mod2.h"
13#include "omalloc.h"
14#include "tok.h"
15#include "ipshell.h"
16#include "intvec.h"
17#include "febase.h"
18#include "numbers.h"
19#include "polys.h"
20#include "ring.h"
21#include "ideals.h"
22#include "matpol.h"
23#include "lists.h"
24#include "attrib.h"
25#include "silink.h"
26#include "syz.h"
27#include "ipid.h"
28
29
30omBin sip_command_bin = omGetSpecBin(sizeof(sip_command));
31omBin ip_command_bin = omGetSpecBin(sizeof(ip_command));
32omBin sip_package_bin = omGetSpecBin(sizeof(sip_package));
33omBin ip_package_bin = omGetSpecBin(sizeof(ip_package));
34omBin idrec_bin = omGetSpecBin(sizeof(idrec));
35#ifdef HAVE_NAMESPACES
36omBin namerec_bin = omGetSpecBin(sizeof(namerec));
37namehdl namespaceroot = NULL;
38#endif
39
40proclevel *procstack=NULL;
41#define TEST
42#ifndef HAVE_NAMESPACES
43idhdl idroot = NULL;
44#endif /* HAVE_NAMESPACES */
45
46#ifdef HAVE_NS
47idhdl currPackHdl = NULL;
48idhdl basePackHdl = NULL;
49package currPack =NULL;
50package basePack =NULL;
51#endif /* HAVE_NS */
52idhdl currRingHdl = NULL;
53ring  currRing = NULL;
54ideal currQuotient = NULL;
55char* iiNoName="_";
56
57void paCleanUp(package pack);
58#ifdef HAVE_NAMESPACES
59BOOLEAN paKill(package pack, BOOLEAN force_top=FALSE);
60#endif
61
62/*0 implementation*/
63
64idhdl idrec::get(const char * s, int lev)
65{
66  idhdl h = this;
67  idhdl found=NULL;
68  int l;
69  char *id;
70  if (s[1]=='\0')
71  {
72    while (h!=NULL)
73    {
74      omCheckAddr(IDID(h));
75// =============================================================
76#if 0
77// timings: ratchwum: 515 s, wilde13: 373 s, nepomuck: 267 s, lukas 863 s
78    id=IDID(h);
79    l=IDLEV(h);
80    if ((l==0) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
81    {
82      found=h;
83    }
84    else if ((l==lev) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
85    {
86      return h;
87    }
88#endif
89// =============================================================
90#if 0
91// timings: ratchwum: 515 s, wilde13: 398 s, nepomuck: 269 s, lukas 834 s
92    id=IDID(h);
93    if (*(short *)s==*(short *)id)
94    {
95      l=IDLEV(h);
96      if ((l==0) && (0 == strcmp(s+1,id+1)))
97      {
98        found=h;
99      }
100      else if ((l==lev) && (0 == strcmp(s+1,id+1)))
101      {
102        return h;
103      }
104    }
105#endif
106// =============================================================
107#if 1
108// timings: ratchwum: 501 s, wilde13: 357 s, nepomuck: 267 s, lukas 816 s
109// timings bug4: ratchwum: s, wilde13: s, nepomuck: 379.74 s, lukas s
110    l=IDLEV(h);
111    if ((l==0)||(l==lev))
112    {
113      id=IDID(h);
114      if (*(short *)s==*(short *)id)
115      {
116        if (0 == strcmp(s+1,id+1))
117        {
118          if (l==lev) return h;
119          found=h;
120        }
121      }
122    }
123#endif
124// =============================================================
125#if 0
126// timings: ratchwum: s, wilde13: s, nepomuck: s, lukas s
127// timings bug4: ratchwum: s, wilde13: s, nepomuck: s, lukas s
128    l=IDLEV(h);
129    if ((l==0)||(l==lev))
130    {
131      id=IDID(h);
132      if (*(short *)s==*(short *)id)
133      {
134        if (l==lev) return h;
135        found=h;
136      }
137    }
138#endif
139// =============================================================
140    h = IDNEXT(h);
141  }
142  }
143  else
144  {
145  while (h!=NULL)
146  {
147    omCheckAddr(IDID(h));
148// =============================================================
149#if 0
150// timings: ratchwum: 515 s, wilde13: 373 s, nepomuck: 267 s, lukas 863 s
151    id=IDID(h);
152    l=IDLEV(h);
153    if ((l==0) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
154    {
155      found=h;
156    }
157    else if ((l==lev) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
158    {
159      return h;
160    }
161#endif
162// =============================================================
163#if 0
164// timings: ratchwum: 515 s, wilde13: 398 s, nepomuck: 269 s, lukas 834 s
165    id=IDID(h);
166    if (*(short *)s==*(short *)id)
167    {
168      l=IDLEV(h);
169      if ((l==0) && (0 == strcmp(s+1,id+1)))
170      {
171        found=h;
172      }
173      else if ((l==lev) && (0 == strcmp(s+1,id+1)))
174      {
175        return h;
176      }
177    }
178#endif
179// =============================================================
180#if 0
181// timings: ratchwum: 501 s, wilde13: 357 s, nepomuck: 267 s, lukas 816 s
182// timings bug4: ratchwum: s, wilde13: s, nepomuck: 379.74 s, lukas s
183    l=IDLEV(h);
184    if ((l==0)||(l==lev))
185    {
186      id=IDID(h);
187      if (*(short *)s==*(short *)id)
188      {
189        if (0 == strcmp(s+1,id+1))
190        {
191          if (l==lev) return h;
192          found=h;
193        }
194      }
195    }
196#endif
197// =============================================================
198#if 1
199// timings: ratchwum: s, wilde13: s, nepomuck: s, lukas s
200// timings bug4: ratchwum: s, wilde13: s, nepomuck: s, lukas s
201    l=IDLEV(h);
202    if ((l==0)||(l==lev))
203    {
204      id=IDID(h);
205      if (*(short *)s==*(short *)id)
206      {
207        if (0 == strcmp(s+2,id+2))
208        {
209          if (l==lev) return h;
210          found=h;
211        }
212      }
213    }
214#endif
215// =============================================================
216    h = IDNEXT(h);
217  }
218  }
219  return found;
220}
221
222//idrec::~idrec()
223//{
224//  if (id!=NULL)
225//  {
226//    omFree((ADDRESS)id);
227//    id=NULL;
228//  }
229//  /* much more !! */
230//}
231
232idhdl idrec::set(char * s, int lev, idtyp t, BOOLEAN init)
233{
234  //printf("define %s, %x, lev: %d, typ: %d\n", s,s,lev,t);
235  idhdl h = (idrec *)omAlloc0Bin(idrec_bin);
236  int   len = 0;
237  IDID(h)   = s;
238  IDTYP(h)  = t;
239  IDLEV(h)  = lev;
240#ifdef HAVE_NAMESPACES
241  h->ref    = 0;
242#endif /* HAVE_NAMESPACES */
243  IDNEXT(h) = this;
244  if (init)
245  {
246    switch (t)
247    {
248      //the type with init routines:
249      case INTVEC_CMD:
250      case INTMAT_CMD:
251        IDINTVEC(h) = new intvec();
252        break;
253      case NUMBER_CMD:
254        IDNUMBER(h) = nInit(0);
255        break;
256      case IDEAL_CMD:
257      case MODUL_CMD:
258        IDFLAG(h) = Sy_bit(FLAG_STD);
259      case MATRIX_CMD:
260        IDIDEAL(h) = idInit(1,1);
261        break;
262      case MAP_CMD:
263        IDIDEAL(h) = idInit(1,1);
264        IDMAP(h)->preimage = omStrDup(IDID(currRingHdl));
265        break;
266      case STRING_CMD:
267        IDSTRING(h) = omStrDup("");
268        break;
269      case LIST_CMD:
270        IDLIST(h)=(lists)omAllocBin(slists_bin);
271        IDLIST(h)->Init();
272        break;
273      case LINK_CMD:
274        IDLINK(h)=(si_link) omAlloc0Bin(sip_link_bin);
275        break;
276      case RING_CMD:
277      case QRING_CMD:
278        IDRING(h) = (ring) omAlloc0Bin(sip_sring_bin);
279        break;
280      case PACKAGE_CMD:
281        IDPACKAGE(h) = (package) omAlloc0Bin(sip_package_bin);
282        break;
283      case PROC_CMD:
284        IDPROC(h) = (procinfo*) omAlloc0Bin(procinfo_bin);
285        break;
286        //the types with the standard init: set the struct to zero
287      case RESOLUTION_CMD:
288        len=sizeof(ssyStrategy);
289        break;
290    //other types: without init (int,script,poly,def,package)
291    }
292    if (len!=0)
293    {
294      IDSTRING(h) = (char *)omAlloc0(len);
295    }
296    // additional settings:--------------------------------------
297#if 0
298    // this leads to a memory leak
299    if (t == QRING_CMD)
300    {
301      // IDRING(h)=rCopy(currRing);
302      /* QRING_CMD is ring dep => currRing !=NULL */
303    }
304    else
305#endif
306      if (t == PROC_CMD)
307    {
308      IDPROC(h)->language=LANG_NONE;
309    }
310    else if (t == PACKAGE_CMD)
311    {
312      IDPACKAGE(h)->language=LANG_NONE;
313      IDPACKAGE(h)->loaded = FALSE;
314    }
315  }
316  // --------------------------------------------------------
317  return  h;
318}
319
320char * idrec::String()
321{
322  sleftv tmp;
323  memset(&tmp,0,sizeof(sleftv));
324  tmp.rtyp=IDTYP(this);
325  tmp.data=IDDATA(this);
326  tmp.name=IDID(this);
327  return tmp.String();
328}
329
330//#define KAI
331idhdl enterid(char * s, int lev, idtyp t, idhdl* root, BOOLEAN init)
332{
333  idhdl h;
334#ifdef HAVE_NAMESPACES
335  namehdl topnsroot = namespaceroot->root;
336#endif
337  s=omStrDup(s);
338  // is it already defined in root ?
339  if ((h=(*root)->get(s,lev))!=NULL)
340  {
341    if (IDLEV(h)==lev)
342    {
343    if ((IDTYP(h) == t)||(t==DEF_CMD))
344    {
345      if ((IDTYP(h)==PACKAGE_CMD)
346      && (strcmp(s,"Top")==0))
347      {
348        goto errlabel;
349      } 
350      if (BVERBOSE(V_REDEFINE))
351        Warn("redefining %s **",s);
352#ifdef HAVE_NAMESPACES
353      if(t==PACKAGE_CMD && strcmp(s,"Top")==0)
354      {
355        Warn("identifier `%s` in use",s);
356        return(h);
357      }
358#endif /* HAVE_NAMESPACES */
359      if (s==IDID(h)) IDID(h)=NULL;
360      killhdl2(h,root);
361    }
362    else
363      goto errlabel;
364    }
365  }
366  // is it already defined in idroot ?
367  else if (*root != IDROOT)
368  {
369    if ((h=IDROOT->get(s,lev))!=NULL)
370    {
371      if (IDLEV(h)==lev)
372      {
373      if ((IDTYP(h) == t)||(t==DEF_CMD))
374      {
375        if (BVERBOSE(V_REDEFINE))
376          Warn("redefining %s **",s);
377        if (s==IDID(h)) IDID(h)=NULL;
378        killhdl2(h,&IDROOT);
379      }
380      else
381        goto errlabel;
382      }
383    }
384  }
385#ifdef HAVE_NAMESPACES
386  // is it already defined in toplevel idroot ?
387  else if (*root != NSROOT(topnsroot))
388  {
389    if ((h=topnsroot->get(s,lev))!=NULL)
390    {
391    }
392  }
393#endif /* HAVE_NAMESPACES */
394  // is it already defined in currRing->idroot ?
395  else if ((currRing!=NULL)&&((*root) != currRing->idroot))
396  {
397    if ((h=currRing->idroot->get(s,lev))!=NULL)
398    {
399      if (IDLEV(h)==lev)
400      {
401      if ((IDTYP(h) == t)||(t==DEF_CMD))
402      {
403        if (BVERBOSE(V_REDEFINE))
404          Warn("redefining %s **",s);
405        IDID(h)=NULL;
406        killhdl2(h,&currRing->idroot);
407      }
408      else
409        goto errlabel;
410      }
411    }
412  }
413  *root = (*root)->set(s, lev, t, init);
414#ifdef HAVE_NS
415  checkall();
416#endif
417  return *root;
418
419  errlabel:
420    //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
421    Werror("identifier `%s` in use",s);
422#ifdef HAVE_NS
423    //listall();
424#endif
425    omFree(s);
426    return NULL;
427}
428
429void killid(char * id, idhdl * ih)
430{
431  if (id!=NULL)
432  {
433    idhdl h = (*ih)->get(id,myynest);
434
435    // id not found in global list, is it defined in current ring ?
436    if (h==NULL)
437    {
438      if ((currRing!=NULL) && (*ih != (currRing->idroot)))
439      {
440        h = currRing->idroot->get(id,myynest);
441        if (h!=NULL)
442        {
443          killhdl2(h,&(currRing->idroot));
444          return;
445        }
446      }
447      Werror("`%s` is not defined",id);
448      return;
449    }
450    killhdl2(h,ih);
451  }
452  else
453    Werror("kill what ?");
454}
455
456void killhdl(idhdl h)
457{
458  int t=IDTYP(h);
459  if ((BEGIN_RING<t) && (t<END_RING) && (t!=QRING_CMD))
460    killhdl2(h,&currRing->idroot);
461  else
462  {
463#ifdef HAVE_NAMESPACES
464    if(t==PACKAGE_CMD)
465    {
466      killhdl2(h,&NSROOT(namespaceroot->root));
467    }
468    else
469#endif /* HAVE_NAMESPACES */
470#ifdef HAVE_NS
471    if(t==PACKAGE_CMD)
472    {
473      killhdl2(h,&(basePack->idroot));
474    }
475    else
476    {
477      idhdl s=currPack->idroot;
478      while ((s!=h) && (s!=NULL)) s=s->next;
479      if (s!=NULL)
480        killhdl2(h,&(currPack->idroot));
481      else if (basePack!=currPack)
482      {
483        idhdl s=basePack->idroot;
484        while ((s!=h) && (s!=NULL)) s=s->next;
485        if (s!=NULL)
486          killhdl2(h,&(basePack->idroot));
487        else
488          killhdl2(h,&(currRing->idroot));
489       }
490    }
491#else /* HAVE_NS */
492    {
493      idhdl s=IDROOT;
494      while ((s!=h) && (s!=NULL)) s=s->next;
495      if (s==NULL) killhdl2(h,&(currRing->idroot));
496      else killhdl2(h,&IDROOT);
497    }
498#endif /* HAVE_NAMESPACES */
499  }
500}
501
502void killhdl2(idhdl h, idhdl * ih)
503{
504  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
505  idhdl hh;
506  BOOLEAN killOtherRing = TRUE;
507  BOOLEAN needResetRing = FALSE;
508
509  if (h->attribute!=NULL)
510  {
511    atKillAll(h);
512    //h->attribute=NULL;
513  }
514  if ((IDTYP(h) == PACKAGE_CMD) && (strcmp(IDID(h),"Top")==0))
515  {
516    WarnS("can not kill `Top`");
517    return;
518  }
519  // ring / qring  --------------------------------------------------------
520  if ((IDTYP(h) == RING_CMD) || (IDTYP(h) == QRING_CMD))
521  {
522    idhdl savecurrRingHdl = currRingHdl;
523    ring  savecurrRing = currRing;
524    // any objects defined for this ring ?
525    // Hmm ... why onlyt for rings and not for qrings??
526    // if (((IDTYP(h)==RING_CMD) && (IDRING(h)->ref<=0))
527    if ((IDRING(h)->ref<=0)  &&  (IDRING(h)->idroot!=NULL))
528    {
529      idhdl * hd = &IDRING(h)->idroot;
530      idhdl  hdh = IDNEXT(*hd);
531      idhdl  temp;
532      killOtherRing=(IDRING(h)!=currRing);
533      if (killOtherRing) //we are not killing the base ring, so switch
534      {
535        needResetRing=TRUE;
536        rSetHdl(h);
537        /* no complete init*/
538      }
539      else
540      {
541        // we are killing the basering, so: make sure that
542        // sLastPrinted is killed before this ring is destroyed
543        if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
544        || ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
545        {
546          sLastPrinted.CleanUp();
547        }
548      }
549      while (hdh!=NULL)
550      {
551        temp = IDNEXT(hdh);
552        killhdl2(hdh,&(IDRING(h)->idroot));
553        hdh = temp;
554      }
555      killhdl2(*hd,hd);
556    }
557    // reset currRing ?
558    if (needResetRing) // && (killOtherRing)
559    {
560      //we have to switch back to the base ring
561      //currRing = savecurrRing;
562      //currRingHdl = savecurrRingHdl;
563      if (savecurrRingHdl!=NULL)
564      {
565        rSetHdl(savecurrRingHdl);
566      }
567      else if (savecurrRing!=NULL)
568      {
569        rChangeCurrRing(savecurrRing);
570      }
571    }
572    rKill(h);
573  }
574#ifdef HAVE_NAMESPACES
575  // package -------------------------------------------------------------
576  else if (IDTYP(h) == PACKAGE_CMD)
577  {
578    if(IDPACKAGE(h)->language!=LANG_TOP)
579    {
580      if(!paKill(IDPACKAGE(h))) return;
581    }
582    else
583    {
584      if(strcmp(IDID(h), "Top")!=0)
585      {
586        if(!paKill(IDPACKAGE(h))) return;
587      }
588      else
589      {
590        if(!paKill(IDPACKAGE(h), TRUE)) return;
591      }
592    }
593  }
594  // pointer -------------------------------------------------------------
595  else if(IDTYP(h)==POINTER_CMD)
596  {
597    PrintS(">>>>>>Free pointer\n");
598  }
599#endif /* HAVE_NAMESPACES */
600#ifdef HAVE_NS
601  // package -------------------------------------------------------------
602  else if (IDTYP(h) == PACKAGE_CMD)
603  {
604    // any objects defined for this package ?
605    if ((IDPACKAGE(h)->ref<=0)  &&  (IDPACKAGE(h)->idroot!=NULL))
606    {
607      if (currPack==IDPACKAGE(h))
608      {
609        currPack=basePack;
610        currPackHdl=NULL;
611      }
612      idhdl * hd = &IDRING(h)->idroot;
613      idhdl  hdh = IDNEXT(*hd);
614      idhdl  temp;
615      while (hdh!=NULL)
616      {
617        temp = IDNEXT(hdh);
618        killhdl2(hdh,&(IDPACKAGE(h)->idroot));
619        hdh = temp;
620      }
621      killhdl2(*hd,hd);
622    }
623    paKill(IDPACKAGE(h));
624    if (currPackHdl==h) currPackHdl=packFindHdl(currPack);
625  }
626#endif /* HAVE_NS */
627  // poly / vector -------------------------------------------------------
628  else if ((IDTYP(h) == POLY_CMD) || (IDTYP(h) == VECTOR_CMD))
629  {
630    pDelete(&IDPOLY(h));
631  }
632  // ideal / module/ matrix / map ----------------------------------------
633  else if ((IDTYP(h) == IDEAL_CMD)
634           || (IDTYP(h) == MODUL_CMD)
635           || (IDTYP(h) == MATRIX_CMD)
636           || (IDTYP(h) == MAP_CMD))
637  {
638    ideal iid = IDIDEAL(h);
639    if (IDTYP(h) == MAP_CMD)
640    {
641      map im = IDMAP(h);
642      omFree((ADDRESS)im->preimage);
643    }
644    idDelete(&iid);
645  }
646  // string -------------------------------------------------------------
647  else if (IDTYP(h) == STRING_CMD)
648  {
649    omFree((ADDRESS)IDSTRING(h));
650    //IDSTRING(h)=NULL;
651  }
652  // proc ---------------------------------------------------------------
653  else if (IDTYP(h) == PROC_CMD)
654  {
655    if (piKill(IDPROC(h))) return;
656  }
657  // number -------------------------------------------------------------
658  else if (IDTYP(h) == NUMBER_CMD)
659  {
660    nDelete(&IDNUMBER(h));
661  }
662  // intvec / intmat  ---------------------------------------------------
663  else if ((IDTYP(h) == INTVEC_CMD)||(IDTYP(h) == INTMAT_CMD))
664  {
665    delete IDINTVEC(h);
666  }
667  // list  -------------------------------------------------------------
668  else if (IDTYP(h)==LIST_CMD)
669  {
670    IDLIST(h)->Clean();
671    //omFreeSize((ADDRESS)IDLIST(h)->m, (IDLIST(h)->nr+1)*sizeof(sleftv));
672    //omFreeBin((ADDRESS)IDLIST(h),  slists_bin);
673  }
674  // link  -------------------------------------------------------------
675  else if (IDTYP(h)==LINK_CMD)
676  {
677    slKill(IDLINK(h));
678  }
679  else if(IDTYP(h)==RESOLUTION_CMD)
680  {
681    if (IDDATA(h)!=NULL)
682      syKillComputation((syStrategy)IDDATA(h));
683  }
684#ifdef TEST
685  else if ((IDTYP(h)!= INT_CMD)&&(IDTYP(h)!=DEF_CMD) && (IDTYP(h)!=NONE))
686    Warn("unknown type to kill: %s(%d)",Tok2Cmdname(IDTYP(h)),IDTYP(h));
687#endif
688
689  //  general  -------------------------------------------------------------
690  // now dechain it and delete idrec
691#ifdef KAI
692  if(h->next != NULL)
693    Print("=======>%s(%x) -> %s<====\n", IDID(h), IDID(h), IDID(h->next));
694  else
695    Print("=======>%s(%x)<====\n", IDID(h), IDID(h));
696#endif
697
698  if (IDID(h)) // OB: ?????
699    omFree((ADDRESS)IDID(h));
700  IDID(h)=NULL;
701  if (h == (*ih))
702  {
703    // h is at the beginning of the list
704    *ih = IDNEXT(h) /* ==*ih */;
705  }
706  else
707  {
708    // h is somethere in the list:
709    hh = *ih;
710    loop
711    {
712      if (hh==NULL)
713      {
714        PrintS(">>?<< not found for kill\n");
715        return;
716      }
717      idhdl hhh = IDNEXT(hh);
718      if (hhh == h)
719      {
720        IDNEXT(hh) = IDNEXT(hhh);
721        break;
722      }
723      hh = hhh;
724    }
725  }
726  omFreeBin((ADDRESS)h, idrec_bin);
727}
728
729idhdl ggetid(const char *n, BOOLEAN local, idhdl *packhdl)
730{
731#ifdef HAVE_NAMESPACES
732  idhdl h =namespaceroot->get(n,myynest, TRUE); // search in toplevel namespace
733  idhdl h2=namespaceroot->get(n,myynest); // search in current namespace
734  idhdl h3=NULL;
735  if ((currRing!=NULL) && ((h2==NULL)||(IDLEV(h2)!=myynest)))
736  {
737    h3 = currRing->idroot->get(n,myynest);
738  }
739  if (h3==NULL) {
740    if (h2!=NULL) {
741      *packhdl=namespaceroot->get(namespaceroot->name,0, TRUE);
742      return h2;
743    }
744    if(!local) {
745      if(h!=NULL)*packhdl=namespaceroot->get("Top",0, TRUE);
746      return h;
747    }
748  }
749  if(h3!=NULL) *packhdl = currRingHdl;
750  else *packhdl = NULL;
751  return h3;
752#else /* HAVE_NAMESPACES */
753  idhdl h = IDROOT->get(n,myynest);
754  idhdl h2=NULL;
755  *packhdl = NULL;
756  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
757  {
758    h2 = currRing->idroot->get(n,myynest);
759  }
760  if (h2==NULL) return h;
761  return h2;
762#endif /* HAVE_NAMESPACES */
763}
764
765idhdl ggetid(const char *n, BOOLEAN local)
766{
767#ifdef HAVE_NAMESPACES
768  idhdl h =namespaceroot->get(n,myynest, TRUE); // search in toplevel namespace
769  idhdl h2=namespaceroot->get(n,myynest); // search in current namespace
770  idhdl h3=NULL;
771  if ((currRing!=NULL) && ((h2==NULL)||(IDLEV(h2)!=myynest)))
772  {
773    h3 = currRing->idroot->get(n,myynest);
774  }
775  if (h3==NULL)
776  {
777    if (h2!=NULL) return h2;
778    if(!local) return h;
779  }
780  return h3;
781#else /* HAVE_NAMESPACES */
782  idhdl h = IDROOT->get(n,myynest);
783  if ((h!=NULL)&&(IDLEV(h)==myynest)) return h;
784  idhdl h2=NULL;
785  if (currRing!=NULL)
786  {
787    h2 = currRing->idroot->get(n,myynest);
788  }
789  if (h2!=NULL) return h2;
790  if (h!=NULL) return h;
791#ifdef HAVE_NS 
792  if (basePack!=currPack)
793    return basePack->idroot->get(n,myynest);
794#endif     
795  return NULL; 
796#endif /* HAVE_NAMESPACES */
797}
798
799void ipListFlag(idhdl h)
800{
801  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
802  if (hasFlag(h,FLAG_DRING)) PrintS(" (D)");
803}
804
805lists ipNameList(idhdl root)
806{
807  idhdl h=root;
808  /* compute the length */
809  int l=0;
810  while (h!=NULL) { l++; h=IDNEXT(h); }
811  /* allocate list */
812  lists L=(lists)omAllocBin(slists_bin);
813  L->Init(l);
814  /* copy names */
815  h=root;
816  l=0;
817  while (h!=NULL)
818  {
819    /* list is initialized with 0 => no need to clear anything */
820    L->m[l].rtyp=STRING_CMD;
821    L->m[l].data=omStrDup(IDID(h));
822    l++;
823    h=IDNEXT(h);
824  }
825  return L;
826}
827
828/*
829* move 'tomove' from root1 list to root2 list
830*/
831static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
832{
833  idhdl h;
834  /* search 'tomove' in root2 : if found -> do nothing */
835  h=root2;
836  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
837  if (h!=NULL) return FALSE; /*okay */
838  /* search predecessor of h in root1, remove 'tomove' */
839  h=root1;
840  if (tomove==h)
841  {
842    root1=IDNEXT(h);
843  }
844  else
845  {
846    while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
847    if (h==NULL) return TRUE; /* not in the list root1 -> do nothing */
848    IDNEXT(h)=IDNEXT(tomove);
849  }
850  /* add to root2 list */
851  IDNEXT(tomove)=root2;
852  root2=tomove;
853  return FALSE;
854}
855
856void  ipMoveId(idhdl tomove)
857{
858  if ((currRing!=NULL)&&(tomove!=NULL))
859  {
860    if (((QRING_CMD!=IDTYP(tomove)) && RingDependend(IDTYP(tomove)))
861    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
862    {
863      /*move 'tomove' to ring id's*/
864#ifdef HAVE_NS
865      if (ipSwapId(tomove,IDROOT,currRing->idroot))
866      ipSwapId(tomove,basePack->idroot,currRing->idroot);
867#else
868      ipSwapId(tomove,IDROOT,currRing->idroot);
869#endif
870    }
871    else
872    {
873      /*move 'tomove' to global id's*/
874      ipSwapId(tomove,currRing->idroot,IDROOT);
875    }
876  }
877}
878
879char * piProcinfo(procinfov pi, char *request)
880{
881  if(pi == NULL) return "empty proc";
882  else if (strcmp(request, "libname")  == 0) return pi->libname;
883  else if (strcmp(request, "procname") == 0) return pi->procname;
884  else if (strcmp(request, "type")     == 0)
885  {
886    switch (pi->language)
887    {
888      case LANG_SINGULAR: return "singular"; break;
889      case LANG_C:        return "object";   break;
890      case LANG_NONE:     return "none";     break;
891      default:            return "unknow language";
892    }
893  }
894  else if (strcmp(request, "ref")      == 0)
895  {
896    char p[8];
897    sprintf(p, "%d", pi->ref);
898    return omStrDup(p);  // MEMORY-LEAK
899  }
900  return "??";
901}
902
903void piCleanUp(procinfov pi)
904{
905  (pi->ref)--;
906  if (pi->ref <= 0)
907  {
908    if (pi->libname != NULL) // OB: ????
909      omFree((ADDRESS)pi->libname);
910    if (pi->procname != NULL) // OB: ????
911      omFree((ADDRESS)pi->procname);
912
913    if( pi->language == LANG_SINGULAR)
914    {
915      if (pi->data.s.body != NULL) // OB: ????
916        omFree((ADDRESS)pi->data.s.body);
917    }
918    if( pi->language == LANG_C)
919    {
920    }
921    memset((void *) pi, 0, sizeof(procinfo));
922    pi->language=LANG_NONE;
923  }
924}
925
926BOOLEAN piKill(procinfov pi)
927{
928  Voice *p=currentVoice;
929  while (p!=NULL)
930  {
931    if (p->pi==pi && pi->ref <= 1)
932    {
933      Warn("`%s` in use, can not be killed",pi->procname);
934      return TRUE;
935    }
936    p=p->next;
937  }
938  piCleanUp(pi);
939  if (pi->ref <= 0)
940    omFreeBin((ADDRESS)pi,  procinfo_bin);
941  return FALSE;
942}
943
944void paCleanUp(package pack)
945{
946  (pack->ref)--;
947  if (pack->ref < 0)
948  {
949    if( pack->language == LANG_C)
950    {
951      Print("//dlclose(%s)\n",pack->libname);
952#ifdef HAVE_DYNAMIC_LOADING
953      extern int dynl_close (void *handle);
954      dynl_close (pack->handle);
955#endif /* HAVE_DYNAMIC_LOADING */
956    }
957    omFree((ADDRESS)pack->libname);
958    memset((void *) pack, 0, sizeof(sip_package));
959    pack->language=LANG_NONE;
960  }
961}
962
963#ifdef HAVE_NAMESPACES
964BOOLEAN paKill(package pack, BOOLEAN force_top)
965{
966  if (pack->ref <= 0 || force_top) {
967    idhdl hdh = pack->idroot;
968    idhdl temp;
969    while (hdh!=NULL)
970    {
971      temp = IDNEXT(hdh);
972      if((IDTYP(hdh)!=PACKAGE_CMD) ||
973         (IDTYP(hdh)==PACKAGE_CMD && IDPACKAGE(hdh)->language!=LANG_TOP) ||
974         (IDTYP(hdh)==PACKAGE_CMD && IDPACKAGE(hdh)->language==LANG_TOP &&
975         IDPACKAGE(hdh)->ref>0 ))
976        killhdl2(hdh,&(pack->idroot));
977      hdh = temp;
978    }
979    if(checkPackage(pack))
980    {
981      paCleanUp(pack);
982      omFreeBin((ADDRESS)pack,  sip_package_bin);
983    }
984    else return FALSE;
985  }
986  else paCleanUp(pack);
987  return TRUE;
988}
989#endif /* HAVE_NAMESPACES */
990
991char *idhdl2id(idhdl pck, idhdl h)
992{
993  char *name = (char *)omAlloc(strlen(pck->id) + strlen(h->id) + 3);
994  sprintf(name, "%s::%s", pck->id, h->id);
995  return(name);
996}
997
998void iiname2hdl(const char *name, idhdl *pck, idhdl *h)
999{
1000  const char *q = strchr(name, ':');
1001  char *p, *i;
1002
1003  if(q==NULL)
1004  {
1005    p = omStrDup("");
1006    i = (char *)omAlloc(strlen(name)+1);
1007    *i = '\0';
1008    sscanf(name, "%s", i);
1009#ifdef HAVE_NAMESPACES
1010    *h = namespaceroot->get(i, myynest);
1011    if(*h == NULL) { *h = namespaceroot->get(i, myynest, TRUE); }
1012#else /* HAVE_NAMESPACES */
1013#endif /* HAVE_NAMESPACES */
1014  }
1015  else {
1016    if( *(q+1) != ':') return;
1017    i = (char *)omAlloc(strlen(name)+1);
1018    *i = '\0';
1019    if(name == q)
1020    {
1021      p = omStrDup("");
1022      sscanf(name, "::%s", i);
1023#ifdef HAVE_NAMESPACES
1024      *h =namespaceroot->get(i, myynest, TRUE); // search in toplevel namespace
1025#else /* HAVE_NAMESPACES */
1026#endif /* HAVE_NAMESPACES */
1027    }
1028    else
1029    {
1030      p = (char *)omAlloc(strlen(name)+1);
1031      sscanf(name, "%[^:]::%s", p, i);
1032#ifdef HAVE_NAMESPACES
1033      *pck =namespaceroot->get(p, myynest, TRUE); // search in toplevel namespace
1034      if((*pck!=NULL)&&(IDTYP(*pck)==PACKAGE_CMD))
1035      {
1036        namespaceroot->push(IDPACKAGE(*pck), IDID(*pck));
1037        *h =namespaceroot->get(i, myynest); // search in toplevel namespace
1038        namespaceroot->pop();
1039      }
1040#else /* HAVE_NAMESPACES */
1041#endif /* HAVE_NAMESPACES */
1042    }
1043  }
1044  //printf("Package: '%s'\n", p);
1045  //printf("Id Rec : '%s'\n", i);
1046  omFree(p);
1047  omFree(i);
1048}
1049
1050#if 0
1051char *getnamelev()
1052{
1053  char buf[256];
1054  sprintf(buf, "(%s:%d)", namespaceroot->name,namespaceroot->lev);
1055  return(buf);
1056}
1057// warning: address of local variable `buf' returned
1058#endif
1059
1060void proclevel::push(char *n)
1061{
1062  //Print("push %s\n",n);
1063  proclevel *p=(proclevel*)omAlloc0(sizeof(proclevel));
1064  //p->currRing=::currRing;
1065  //p->currRingHdl=::currRingHdl;
1066  p->name=n;
1067  #ifdef HAVE_NS
1068  p->currPackHdl=::currPackHdl;
1069  p->currPack=::currPack;
1070  #endif
1071  p->next=this;
1072  procstack=p;
1073}
1074void proclevel::pop()
1075{
1076  //Print("pop %s\n",name);
1077  //if (currRing!=::currRing) PrintS("currRing wrong\n");;
1078  //::currRing=this->currRing;
1079  //if (r==NULL) Print("set ring to NULL at lev %d(%s)\n",myynest,name);
1080  //::currRingHdl=this->currRingHdl;
1081  //if((::currRingHdl==NULL)||(IDRING(::currRingHdl)!=(::currRing)))
1082  //  ::currRingHdl=rFindHdl(::currRing,NULL,NULL);
1083  #ifdef HAVE_NS
1084  //Print("restore pack=%s,1.obj=%s\n",IDID(currPackHdl),IDID(currPack->idroot));
1085  ::currPackHdl=this->currPackHdl;
1086  ::currPack=this->currPack;
1087  #endif
1088  proclevel *p=this;
1089  procstack=next;
1090  omFreeSize(p,sizeof(proclevel));
1091}
1092#ifdef HAVE_NAMESPACES
1093namehdl namerec::push(package pack, char *name, int nesting, BOOLEAN init)
1094{
1095  //printf("PUSH: put entry (%s) on stack\n", name);
1096  namehdl ns = (namerec *)omAlloc0Bin(namerec_bin);
1097  extern int myynest;
1098  if(nesting<0) nesting = myynest;
1099  ns->next   = this;
1100  if(this==NULL && !init)
1101  {
1102    printf("PUSH: this is NULL and init not set.\n");
1103    init=TRUE;
1104  }
1105  if(init)
1106  {
1107    ns->next    = NULL;
1108    ns->pack    = (ip_package *)omAlloc0Bin(ip_package_bin);
1109    ns->isroot  = TRUE;
1110    ns->lev     = 1;
1111    //ns->myynest = 0;
1112  }
1113  else
1114  {
1115    extern ring currRing;
1116    ns->pack   = pack;
1117    ns->lev    = this->lev+1;
1118    //ns->myynest = myynest+1;
1119    this->currRing = currRing;
1120    //printf("Saving Ring %x, %x\n", this->currRing, currRing);
1121  }
1122  ns->name    = omStrDup(name);
1123  ns->myynest = nesting;
1124
1125  //ns->currRing = currRing;
1126  //ns->currRingHdl = currRingHdl;
1127  if(ns->isroot) ns->root=ns; else ns->root = this->root;
1128  namespaceroot = ns;
1129#if 0
1130  if(init && ns->isroot) {
1131    idhdl pl = enterid( "Top",0, PACKAGE_CMD,
1132                      &NSROOT(namespaceroot), TRUE );
1133    if(pl != NULL) {
1134      omFreeBin((ADDRESS)IDPACKAGE(pl),  ip_package_bin);
1135      IDPACKAGE(pl) = ns->pack;
1136    }
1137  }
1138#endif
1139  //Print("NSPUSH: done\n");
1140  return(namespaceroot);
1141}
1142#endif /* HAVE_NAMESPACES */
1143
1144#ifdef HAVE_NAMESPACES
1145namehdl namerec::pop(BOOLEAN change_nesting)
1146{
1147  namehdl ns;
1148  //printf("POP: remove entry (%s)\n", this->name);
1149  if(this==NULL) return NULL;
1150  if(isroot) {
1151    //printf("POP: base. woul'd do it.\n");
1152    return this;
1153  }
1154  if(!change_nesting && this->myynest!=this->next->myynest) {
1155    return(this);
1156  }
1157  ns = this;
1158  namespaceroot = this->next;
1159  omFree((ADDRESS)ns->name);
1160  omFreeBin((ADDRESS)ns,  namerec_bin);
1161  return(namespaceroot);
1162}
1163#endif /* HAVE_NAMESPACES */
1164
1165#ifdef HAVE_NAMESPACES
1166idhdl namerec::get(const char * s, int lev, BOOLEAN root)
1167{
1168  namehdl ns;
1169  if(root)
1170  {
1171    ns = this->root;
1172  }
1173  else
1174  {
1175    ns = this;
1176  }
1177  //printf("//====== namerec::get(%s, %d) from '%s'\n", s, lev, ns->name);
1178  if(ns==NULL)
1179  {
1180    //printf("//======== namerec::get() from null\n");
1181    return NULL;
1182  }
1183  return( NSROOT(ns)->get(s, lev));
1184}
1185
1186BOOLEAN checkPackage(package pack)
1187{
1188  namehdl nshdl = namespaceroot;
1189
1190  for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
1191    //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1192    if (nshdl->pack==pack)
1193    {
1194      Warn("package '%s' still in use on level %d",nshdl->name, nshdl->lev);
1195      return FALSE;
1196    }
1197  }
1198  if (nshdl->pack==pack)
1199  {
1200    //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1201    Warn("package '%s' still in use on level %d",nshdl->name, nshdl->lev);
1202    return FALSE;
1203  }
1204  return TRUE;
1205
1206}
1207#endif /* HAVE_NAMESPACES */
1208
1209#ifdef HAVE_NS
1210idhdl packFindHdl(package r)
1211{
1212  idhdl h=basePack->idroot;
1213  while (h!=NULL)
1214  {
1215    if ((IDTYP(h)==PACKAGE_CMD)
1216        && (IDPACKAGE(h)==r))
1217      return h;
1218    h=IDNEXT(h);
1219  }
1220  return NULL;
1221}
1222#endif
Note: See TracBrowser for help on using the repository browser.