source: git/Singular/ipid.cc @ 6e56de

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