source: git/Singular/ipid.cc @ 4fc824e

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