source: git/Singular/ipid.cc @ 4508ce5

fieker-DuValspielwiese
Last change on this file since 4508ce5 was cf42ab1, checked in by Hans Schönemann <hannes@…>, 23 years ago
*hannes: ring changes don't have complete any more git-svn-id: file:///usr/local/Singular/svn/trunk@4817 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.46 2000-12-06 11:03:15 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          memset(&sLastPrinted,0,sizeof(sleftv));
520        }
521      }
522      while (hdh!=NULL)
523      {
524        temp = IDNEXT(hdh);
525        killhdl(hdh,&(IDRING(h)->idroot));
526        hdh = temp;
527      }
528      killhdl(*hd,hd);
529    }
530    // reset currRing ?
531    if (needResetRing) // && (killOtherRing)
532    {
533      //we have to switch back to the base ring
534      //currRing = savecurrRing;
535      //currRingHdl = savecurrRingHdl;
536      if (savecurrRingHdl!=NULL)
537      {
538        rSetHdl(savecurrRingHdl);
539      }
540      else if (savecurrRing!=NULL)
541      {
542        rChangeCurrRing(savecurrRing);
543      }
544    }
545    rKill(h);
546  }
547#ifdef HAVE_NAMESPACES
548  // package -------------------------------------------------------------
549  else if (IDTYP(h) == PACKAGE_CMD)
550  {
551    if(IDPACKAGE(h)->language!=LANG_TOP)
552    {
553      if(!paKill(IDPACKAGE(h))) return;
554    }
555    else
556    {
557      if(strcmp(IDID(h), "Top")!=0)
558      {
559        if(!paKill(IDPACKAGE(h))) return;
560      }
561      else
562      {
563        if(!paKill(IDPACKAGE(h), TRUE)) return;
564      }
565    }
566  }
567  // pointer -------------------------------------------------------------
568  else if(IDTYP(h)==POINTER_CMD)
569  {
570    PrintS(">>>>>>Free pointer\n");
571  }
572#endif /* HAVE_NAMESPACES */
573  // poly / vector -------------------------------------------------------
574  else if ((IDTYP(h) == POLY_CMD) || (IDTYP(h) == VECTOR_CMD))
575  {
576    pDelete(&IDPOLY(h));
577  }
578  // ideal / module/ matrix / map ----------------------------------------
579  else if ((IDTYP(h) == IDEAL_CMD)
580           || (IDTYP(h) == MODUL_CMD)
581           || (IDTYP(h) == MATRIX_CMD)
582           || (IDTYP(h) == MAP_CMD))
583  {
584    ideal iid = IDIDEAL(h);
585    if (IDTYP(h) == MAP_CMD)
586    {
587      map im = IDMAP(h);
588      omFree((ADDRESS)im->preimage);
589    }
590    idDelete(&iid);
591  }
592  // string -------------------------------------------------------------
593  else if (IDTYP(h) == STRING_CMD)
594  {
595    omFree((ADDRESS)IDSTRING(h));
596    //IDSTRING(h)=NULL;
597  }
598  // proc ---------------------------------------------------------------
599  else if (IDTYP(h) == PROC_CMD)
600  {
601    if (piKill(IDPROC(h))) return;
602  }
603  // number -------------------------------------------------------------
604  else if (IDTYP(h) == NUMBER_CMD)
605  {
606    nDelete(&IDNUMBER(h));
607  }
608  // intvec / intmat  ---------------------------------------------------
609  else if ((IDTYP(h) == INTVEC_CMD)||(IDTYP(h) == INTMAT_CMD))
610  {
611    delete IDINTVEC(h);
612  }
613  // list  -------------------------------------------------------------
614  else if (IDTYP(h)==LIST_CMD)
615  {
616    IDLIST(h)->Clean();
617    //omFreeSize((ADDRESS)IDLIST(h)->m, (IDLIST(h)->nr+1)*sizeof(sleftv));
618    //omFreeBin((ADDRESS)IDLIST(h),  slists_bin);
619  }
620  // link  -------------------------------------------------------------
621  else if (IDTYP(h)==LINK_CMD)
622  {
623    slKill(IDLINK(h));
624  }
625  else if((IDTYP(h)==RESOLUTION_CMD)&&(IDDATA(h)!=NULL))
626  {
627    syKillComputation((syStrategy)IDDATA(h));
628  }
629#ifdef TEST
630  else if ((IDTYP(h)!= INT_CMD)&&(IDTYP(h)!=DEF_CMD) && (IDTYP(h)!=NONE))
631    Warn("unknown type to kill: %s(%d)",Tok2Cmdname(IDTYP(h)),IDTYP(h));
632#endif
633
634  //  general  -------------------------------------------------------------
635  // now dechain it and delete idrec
636#ifdef KAI_
637  if(h->next != NULL)
638    Print("=======>%s(%x) -> %s<====\n", IDID(h), IDID(h), IDID(h->next));
639  else
640    Print("=======>%s(%x)<====\n", IDID(h), IDID(h));
641#endif
642
643  if (IDID(h)) // OB: ?????
644    omFree((ADDRESS)IDID(h));
645  //IDID(h)=NULL;
646  if (h == (*ih))
647  {
648    // h is at the beginning of the list
649    *ih = IDNEXT(*ih);
650  }
651  else
652  {
653    // h is somethere in the list:
654    hh = *ih;
655    loop
656    {
657      idhdl hhh = IDNEXT(hh);
658      if (hhh == h)
659      {
660        IDNEXT(hh) = IDNEXT(hhh);
661        break;
662      }
663      hh = hhh;
664    }
665  }
666  omFreeBin((ADDRESS)h, idrec_bin);
667}
668
669idhdl ggetid(const char *n, BOOLEAN local, idhdl *packhdl)
670{
671#ifdef HAVE_NAMESPACES
672  idhdl h =namespaceroot->get(n,myynest, TRUE); // search in toplevel namespace
673  idhdl h2=namespaceroot->get(n,myynest); // search in current namespace
674  idhdl h3=NULL;
675  if ((currRing!=NULL) && ((h2==NULL)||(IDLEV(h2)!=myynest)))
676  {
677    h3 = currRing->idroot->get(n,myynest);
678  }
679  if (h3==NULL) {
680    if (h2!=NULL) {
681      *packhdl=namespaceroot->get(namespaceroot->name,0, TRUE);
682      return h2;
683    }
684    if(!local) {
685      if(h!=NULL)*packhdl=namespaceroot->get("Top",0, TRUE);
686      return h;
687    }
688  }
689  if(h3!=NULL) *packhdl = currRingHdl;
690  else *packhdl = NULL;
691  return h3;
692#else /* HAVE_NAMESPACES */
693  idhdl h = idroot->get(n,myynest);
694  idhdl h2=NULL;
695  *packhdl = NULL;
696  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
697  {
698    h2 = currRing->idroot->get(n,myynest);
699  }
700  if (h2==NULL) return h;
701  return h2;
702#endif /* HAVE_NAMESPACES */
703}
704
705idhdl ggetid(const char *n, BOOLEAN local)
706{
707#ifdef HAVE_NAMESPACES
708  idhdl h =namespaceroot->get(n,myynest, TRUE); // search in toplevel namespace
709  idhdl h2=namespaceroot->get(n,myynest); // search in current namespace
710  idhdl h3=NULL;
711  if ((currRing!=NULL) && ((h2==NULL)||(IDLEV(h2)!=myynest)))
712  {
713    h3 = currRing->idroot->get(n,myynest);
714  }
715  if (h3==NULL)
716  {
717    if (h2!=NULL) return h2;
718    if(!local) return h;
719  }
720  return h3;
721#else /* HAVE_NAMESPACES */
722  idhdl h = idroot->get(n,myynest);
723  idhdl h2=NULL;
724  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
725  {
726    h2 = currRing->idroot->get(n,myynest);
727  }
728  if (h2==NULL) return h;
729  return h2;
730#endif /* HAVE_NAMESPACES */
731}
732
733void ipListFlag(idhdl h)
734{
735  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
736  if (hasFlag(h,FLAG_DRING)) PrintS(" (D)");
737}
738
739lists ipNameList(idhdl root)
740{
741  idhdl h=root;
742  /* compute the length */
743  int l=0;
744  while (h!=NULL) { l++; h=IDNEXT(h); }
745  /* allocate list */
746  lists L=(lists)omAllocBin(slists_bin);
747  L->Init(l);
748  /* copy names */
749  h=root;
750  l=0;
751  while (h!=NULL)
752  {
753    /* list is initialized with 0 => no need to clear anything */
754    L->m[l].rtyp=STRING_CMD;
755    L->m[l].data=omStrDup(IDID(h));
756    l++;
757    h=IDNEXT(h);
758  }
759  return L;
760}
761
762/*
763* move 'tomove' from root1 list to root2 list
764*/
765static void ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
766{
767  idhdl h;
768  /* search 'tomove' in root2 : if found -> do nothing */
769  h=root2;
770  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
771  if (h!=NULL) return;
772  /* search predecessor of h in root1, remove 'tomove' */
773  h=root1;
774  if (tomove==h)
775  {
776    root1=IDNEXT(h);
777  }
778  else
779  {
780    while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
781    if (h==NULL) return; /* not in the list root1 -> do nothing */
782    IDNEXT(h)=IDNEXT(tomove);
783  }
784  /* add to root2 list */
785  IDNEXT(tomove)=root2;
786  root2=tomove;
787}
788
789void  ipMoveId(idhdl tomove)
790{
791  if ((currRing!=NULL)&&(tomove!=NULL))
792  {
793    if (((QRING_CMD!=IDTYP(tomove)) && (BEGIN_RING<IDTYP(tomove)) && (IDTYP(tomove)<END_RING))
794    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
795    {
796      /*move 'tomove' to ring id's*/
797      ipSwapId(tomove,IDROOT,currRing->idroot);
798    }
799    else
800    {
801      /*move 'tomove' to global id's*/
802      ipSwapId(tomove,currRing->idroot,IDROOT);
803    }
804  }
805}
806
807char * piProcinfo(procinfov pi, char *request)
808{
809  if(pi == NULL) return "empty proc";
810  else if (strcmp(request, "libname")  == 0) return pi->libname;
811  else if (strcmp(request, "procname") == 0) return pi->procname;
812  else if (strcmp(request, "type")     == 0) {
813    switch (pi->language) {
814      case LANG_SINGULAR: return "singular"; break;
815      case LANG_C:        return "object";   break;
816      case LANG_NONE:     return "none";     break;
817      default:            return "unknow language";
818    }
819  } else if (strcmp(request, "ref")      == 0) {
820    char p[8];
821    sprintf(p, "%d", pi->ref);
822    return omStrDup(p);  // MEMORY-LEAK
823  }
824  return "??";
825}
826
827void piCleanUp(procinfov pi)
828{
829  (pi->ref)--;
830  if (pi->ref <= 0)
831  {
832    if (pi->libname != NULL) // OB: ????
833      omFree((ADDRESS)pi->libname);
834    if (pi->procname != NULL) // OB: ????
835      omFree((ADDRESS)pi->procname);
836
837    if( pi->language == LANG_SINGULAR)
838    {
839      if (pi->data.s.body != NULL) // OB: ????
840        omFree((ADDRESS)pi->data.s.body);
841    }
842    if( pi->language == LANG_C)
843    {
844    }
845    memset((void *) pi, 0, sizeof(procinfo));
846    pi->language=LANG_NONE;
847  }
848}
849
850BOOLEAN piKill(procinfov pi)
851{
852  Voice *p=currentVoice;
853  while (p!=NULL)
854  {
855    if (p->pi==pi && pi->ref <= 1)
856    {
857      Warn("`%s` in use, can not be killed",pi->procname);
858      return TRUE;
859    }
860    p=p->next;
861  }
862  piCleanUp(pi);
863  if (pi->ref <= 0)
864    omFreeBin((ADDRESS)pi,  procinfo_bin);
865  return FALSE;
866}
867
868void paCleanUp(package pack)
869{
870  (pack->ref)--;
871  if (pack->ref < 0)
872  {
873    if( pack->language == LANG_C)
874    {
875      Print("//dlclose(%s)\n",pack->libname);
876#ifdef HAVE_DYNAMIC_LOADING
877      extern int dynl_close (void *handle);
878      dynl_close (pack->handle);
879#endif /* HAVE_DYNAMIC_LOADING */
880    }
881    omFree((ADDRESS)pack->libname);
882    memset((void *) pack, 0, sizeof(sip_package));
883    pack->language=LANG_NONE;
884  }
885}
886
887#ifdef HAVE_NAMESPACES
888BOOLEAN paKill(package pack, BOOLEAN force_top)
889{
890  if (pack->ref <= 0 || force_top) {
891    idhdl hdh = pack->idroot;
892    idhdl temp;
893    while (hdh!=NULL)
894    {
895      temp = IDNEXT(hdh);
896      if((IDTYP(hdh)!=PACKAGE_CMD) ||
897         (IDTYP(hdh)==PACKAGE_CMD && IDPACKAGE(hdh)->language!=LANG_TOP) ||
898         (IDTYP(hdh)==PACKAGE_CMD && IDPACKAGE(hdh)->language==LANG_TOP &&
899         IDPACKAGE(hdh)->ref>0 ))
900        killhdl(hdh,&(pack->idroot));
901      hdh = temp;
902    }
903    if(checkPackage(pack)) {
904      paCleanUp(pack);
905      omFreeBin((ADDRESS)pack,  sip_package_bin);
906    } else return FALSE;
907  } else paCleanUp(pack);
908  return TRUE;
909}
910#endif /* HAVE_NAMESPACES */
911
912char *idhdl2id(idhdl pck, idhdl h)
913{
914  char *name = (char *)omAlloc(strlen(pck->id) + strlen(h->id) + 3);
915  sprintf(name, "%s::%s", pck->id, h->id);
916  return(name);
917}
918
919void iiname2hdl(const char *name, idhdl *pck, idhdl *h)
920{
921  const char *q = strchr(name, ':');
922  char *p, *i;
923
924  if(q==NULL)
925  {
926    p = omStrDup("");
927    i = (char *)omAlloc(strlen(name)+1);
928    *i = '\0';
929    sscanf(name, "%s", i);
930#ifdef HAVE_NAMESPACES
931    *h = namespaceroot->get(i, myynest);
932    if(*h == NULL) { *h = namespaceroot->get(i, myynest, TRUE); }
933#else /* HAVE_NAMESPACES */
934#endif /* HAVE_NAMESPACES */
935  }
936  else {
937    if( *(q+1) != ':') return;
938    i = (char *)omAlloc(strlen(name)+1);
939    *i = '\0';
940    if(name == q)
941    {
942      p = omStrDup("");
943      sscanf(name, "::%s", i);
944#ifdef HAVE_NAMESPACES
945      *h =namespaceroot->get(i, myynest, TRUE); // search in toplevel namespace
946#else /* HAVE_NAMESPACES */
947#endif /* HAVE_NAMESPACES */
948    }
949    else
950    {
951      p = (char *)omAlloc(strlen(name)+1);
952      sscanf(name, "%[^:]::%s", p, i);
953#ifdef HAVE_NAMESPACES
954      *pck =namespaceroot->get(p, myynest, TRUE); // search in toplevel namespace
955      namespaceroot->push(IDPACKAGE(*pck), IDID(*pck));
956      *h =namespaceroot->get(i, myynest); // search in toplevel namespace
957      namespaceroot->pop();
958#else /* HAVE_NAMESPACES */
959#endif /* HAVE_NAMESPACES */
960    }
961  }
962  //printf("Package: '%s'\n", p);
963  //printf("Id Rec : '%s'\n", i);
964  omFree(p);
965  omFree(i);
966}
967
968#if 0
969char *getnamelev()
970{
971  char buf[256];
972  sprintf(buf, "(%s:%d)", namespaceroot->name,namespaceroot->lev);
973  return(buf);
974}
975// warning: address of local variable `buf' returned
976#endif
977
978namehdl namerec::push(package pack, char *name, int nesting, BOOLEAN init)
979{
980  //printf("PUSH: put entry (%s) on stack\n", name);
981  namehdl ns = (namerec *)omAlloc0Bin(namerec_bin);
982  extern int myynest;
983  if(nesting<0) nesting = myynest;
984  ns->next   = this;
985  if(this==NULL && !init)
986  {
987    printf("PUSH: this is NULL and init not set.\n");
988    init=TRUE;
989  }
990  if(init)
991  {
992    ns->next    = NULL;
993#ifdef HAVE_NAMESPACES
994    ns->pack    = (ip_package *)omAlloc0Bin(ip_package_bin);
995#endif /* HAVE_NAMESPACES */
996    ns->isroot  = TRUE;
997    ns->lev     = 1;
998    //ns->myynest = 0;
999  }
1000  else
1001  {
1002    extern ring currRing;
1003#ifdef HAVE_NAMESPACES
1004    ns->pack   = pack;
1005#endif /* HAVE_NAMESPACES */
1006    ns->lev    = this->lev+1;
1007    //ns->myynest = myynest+1;
1008    this->currRing = currRing;
1009    //printf("Saving Ring %x, %x\n", this->currRing, currRing);
1010  }
1011  ns->name    = omStrDup(name);
1012  ns->myynest = nesting;
1013
1014  //ns->currRing = currRing;
1015  //ns->currRingHdl = currRingHdl;
1016  if(ns->isroot) ns->root=ns; else ns->root = this->root;
1017  namespaceroot = ns;
1018#if 0
1019  if(init && ns->isroot) {
1020    idhdl pl = enterid( omStrDup("Top"),0, PACKAGE_CMD,
1021                      &NSROOT(namespaceroot), TRUE );
1022    if(pl != NULL) {
1023      omFreeBin((ADDRESS)IDPACKAGE(pl),  ip_package_bin);
1024      IDPACKAGE(pl) = ns->pack;
1025    }
1026  }
1027#endif
1028  //Print("NSPUSH: done\n");
1029  return(namespaceroot);
1030}
1031
1032namehdl namerec::pop(BOOLEAN change_nesting)
1033{
1034  namehdl ns;
1035  //printf("POP: remove entry (%s)\n", this->name);
1036  if(this==NULL) return NULL;
1037  if(isroot) {
1038    //printf("POP: base. woul'd do it.\n");
1039    return this;
1040  }
1041  if(!change_nesting && this->myynest!=this->next->myynest) {
1042    return(this);
1043  }
1044  ns = this;
1045  namespaceroot = this->next;
1046  omFree((ADDRESS)ns->name);
1047  omFreeBin((ADDRESS)ns,  namerec_bin);
1048  return(namespaceroot);
1049}
1050
1051#ifdef HAVE_NAMESPACES
1052idhdl namerec::get(const char * s, int lev, BOOLEAN root)
1053{
1054  namehdl ns;
1055  if(root)
1056  {
1057    ns = this->root;
1058  }
1059  else
1060  {
1061    ns = this;
1062  }
1063  //printf("//====== namerec::get(%s, %d) from '%s'\n", s, lev, ns->name);
1064  if(ns==NULL)
1065  {
1066    //printf("//======== namerec::get() from null\n");
1067    return NULL;
1068  }
1069  return( NSROOT(ns)->get(s, lev));
1070}
1071
1072BOOLEAN checkPackage(package pack)
1073{
1074  namehdl nshdl = namespaceroot;
1075
1076  for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
1077    //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1078    if (nshdl->pack==pack)
1079    {
1080      Warn("package '%s' still in use on level %d",nshdl->name, nshdl->lev);
1081      return FALSE;
1082    }
1083  }
1084  if (nshdl->pack==pack)
1085  {
1086    //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1087    Warn("package '%s' still in use on level %d",nshdl->name, nshdl->lev);
1088    return FALSE;
1089  }
1090  return TRUE;
1091
1092}
1093#endif /* HAVE_NAMESPACES */
Note: See TracBrowser for help on using the repository browser.