source: git/Singular/ipid.cc @ 2dbaba4

spielwiese
Last change on this file since 2dbaba4 was 2dbaba4, checked in by Hans Schönemann <hannes@…>, 14 years ago
*hannes: ring dep. attribs (trac 134) git-svn-id: file:///usr/local/Singular/svn/trunk@11770 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 22.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipid.cc,v 1.86 2009-05-05 09:54:38 Singular Exp $ */
5
6/*
7* ABSTRACT: identfier handling
8*/
9
10#include <string.h>
11
12#include "mod2.h"
13#include "static.h"
14#include "omalloc.h"
15#include "tok.h"
16#include "ipshell.h"
17#include "intvec.h"
18#include "febase.h"
19#include "numbers.h"
20#include "longrat.h"
21#include "polys.h"
22#include "ring.h"
23#include "ideals.h"
24#include "matpol.h"
25#include "lists.h"
26#include "attrib.h"
27#include "silink.h"
28#include "syz.h"
29#include "ipid.h"
30
31#ifdef HAVE_DYNAMIC_LOADING
32#include "mod_raw.h"
33#endif /* HAVE_DYNAMIC_LOADING */
34
35omBin sip_command_bin = omGetSpecBin(sizeof(sip_command));
36omBin ip_command_bin = omGetSpecBin(sizeof(ip_command));
37omBin sip_package_bin = omGetSpecBin(sizeof(sip_package));
38omBin ip_package_bin = omGetSpecBin(sizeof(ip_package));
39omBin idrec_bin = omGetSpecBin(sizeof(idrec));
40
41proclevel *procstack=NULL;
42#define TEST
43idhdl idroot = NULL;
44
45#ifdef HAVE_NS
46idhdl currPackHdl = NULL;
47idhdl basePackHdl = NULL;
48package currPack =NULL;
49package basePack =NULL;
50#endif /* HAVE_NS */
51idhdl currRingHdl = NULL;
52ring  currRing = NULL;
53ideal currQuotient = NULL;
54const char* iiNoName="_";
55
56void paCleanUp(package pack);
57
58/*0 implementation*/
59
60#ifdef HAVE_IDI
61int iiS2I(const char *s)
62{
63  int i;
64  i=s[0];
65  if (s[1]!='\0')
66  {
67    i=(i<<8)+s[1];
68    if (s[2]!='\0')
69    {
70      i=(i<<8)+s[2];
71      if (s[3]!='\0')
72      {
73        i=(i<<8)+s[3];
74      }
75    }
76  }
77  return i; 
78}
79#endif
80idhdl idrec::get(const char * s, int lev)
81{
82  assume(s!=NULL);
83  assume((lev>=0) && (lev<=1000)); //not really, but if it isnt in that bounds..
84  idhdl h = this;
85  idhdl found=NULL;
86  int l;
87  const char *id;
88#ifndef HAVE_IDI
89  if (s[1]=='\0')
90  {
91    while (h!=NULL)
92    {
93      omCheckAddr(IDID(h));
94// =============================================================
95#if 0
96// timings: ratchwum: 515 s, wilde13: 373 s, nepomuck: 267 s, lukas 863 s
97    id=IDID(h);
98    l=IDLEV(h);
99    if ((l==0) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
100    {
101      found=h;
102    }
103    else if ((l==lev) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
104    {
105      return h;
106    }
107#endif
108// =============================================================
109#if 0
110// timings: ratchwum: 515 s, wilde13: 398 s, nepomuck: 269 s, lukas 834 s
111    id=IDID(h);
112    if (*(short *)s==*(short *)id)
113    {
114      l=IDLEV(h);
115      if ((l==0) && (0 == strcmp(s+1,id+1)))
116      {
117        found=h;
118      }
119      else if ((l==lev) && (0 == strcmp(s+1,id+1)))
120      {
121        return h;
122      }
123    }
124#endif
125// =============================================================
126#if 1
127// timings: ratchwum: 501 s, wilde13: 357 s, nepomuck: 267 s, lukas 816 s
128// timings bug4: ratchwum: s, wilde13: s, nepomuck: 379.74 s, lukas s
129    l=IDLEV(h);
130    if ((l==0)||(l==lev))
131    {
132      id=IDID(h);
133      if (*s==*id)
134      {
135        if (id[1]=='\0')  // we know: s[1]=='\0'
136        {
137          if (l==lev) return h;
138          found=h;
139        }
140      }
141    }
142#endif
143// =============================================================
144#if 0
145// timings: ratchwum: s, wilde13: s, nepomuck: s, lukas s
146// timings bug4: ratchwum: s, wilde13: s, nepomuck: s, lukas s
147    l=IDLEV(h);
148    if ((l==0)||(l==lev))
149    {
150      id=IDID(h);
151      if (*(short *)s==*(short *)id)
152      {
153        if (l==lev) return h;
154        found=h;
155      }
156    }
157#endif
158// =============================================================
159    h = IDNEXT(h);
160  }
161  }
162  else
163  {
164  while (h!=NULL)
165  {
166    omCheckAddr(IDID(h));
167// =============================================================
168#if 0
169// timings: ratchwum: 515 s, wilde13: 373 s, nepomuck: 267 s, lukas 863 s
170    id=IDID(h);
171    l=IDLEV(h);
172    if ((l==0) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
173    {
174      found=h;
175    }
176    else if ((l==lev) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
177    {
178      return h;
179    }
180#endif
181// =============================================================
182#if 0
183// timings: ratchwum: 515 s, wilde13: 398 s, nepomuck: 269 s, lukas 834 s
184    id=IDID(h);
185    if (*(short *)s==*(short *)id)
186    {
187      l=IDLEV(h);
188      if ((l==0) && (0 == strcmp(s+1,id+1)))
189      {
190        found=h;
191      }
192      else if ((l==lev) && (0 == strcmp(s+1,id+1)))
193      {
194        return h;
195      }
196    }
197#endif
198// =============================================================
199#if 0
200// timings: ratchwum: 501 s, wilde13: 357 s, nepomuck: 267 s, lukas 816 s
201// timings bug4: ratchwum: s, wilde13: s, nepomuck: 379.74 s, lukas s
202    l=IDLEV(h);
203    if ((l==0)||(l==lev))
204    {
205      id=IDID(h);
206      if (*(short *)s==*(short *)id)
207      {
208        if (0 == strcmp(s+1,id+1))
209        {
210          if (l==lev) return h;
211          found=h;
212        }
213      }
214    }
215#endif
216// =============================================================
217#if 1
218// timings: ratchwum: s, wilde13: s, nepomuck: s, lukas s
219// timings bug4: ratchwum: s, wilde13: s, nepomuck: s, lukas s
220    l=IDLEV(h);
221    if ((l==0)||(l==lev))
222    {
223      id=IDID(h);
224      if (*(short *)s==*(short *)id)
225      {
226        if (0 == strcmp(s+1,id+1))
227        {
228          if (l==lev) return h;
229          found=h;
230        }
231      }
232    }
233#endif
234// =============================================================
235    h = IDNEXT(h);
236  }
237  }
238  return found;
239#else
240  int i=iiS2I(s);
241  int less4=(i < (1<<24));
242  while (h!=NULL)
243  {
244    omCheckAddr((ADDRESS)IDID(h));
245    l=IDLEV(h);
246    if ((l==0)||(l==lev))
247    {
248      if (i==h->id_i)
249      {
250        id=IDID(h);
251        if (less4 || (0 == strcmp(s+4,id+4)))
252        {
253          if (l==lev) return h;
254          found=h;
255        }
256      }
257    }
258    h = IDNEXT(h);
259  }
260  return found;
261#endif
262}
263
264//idrec::~idrec()
265//{
266//  if (id!=NULL)
267//  {
268//    omFree((ADDRESS)id);
269//    id=NULL;
270//  }
271//  /* much more !! */
272//}
273
274idhdl idrec::set(const char * s, int lev, idtyp t, BOOLEAN init)
275{
276  //printf("define %s, %x, lev: %d, typ: %d\n", s,s,lev,t);
277  idhdl h = (idrec *)omAlloc0Bin(idrec_bin);
278  int   len = 0;
279  IDID(h)   = s;
280  IDTYP(h)  = t;
281  IDLEV(h)  = lev;
282  IDNEXT(h) = this;
283#ifdef HAVE_IDI
284  h->id_i=iiS2I(s);
285#endif
286  if (init)
287  {
288    switch (t)
289    {
290      //the type with init routines:
291      case INTVEC_CMD:
292      case INTMAT_CMD:
293        IDINTVEC(h) = new intvec();
294        break;
295      case NUMBER_CMD:
296        IDNUMBER(h) = nInit(0);
297        break;
298      case BIGINT_CMD:
299        IDNUMBER(h) = nlInit(0);
300        break;
301      case IDEAL_CMD:
302      case MODUL_CMD:
303        IDFLAG(h) = Sy_bit(FLAG_STD);
304      case MATRIX_CMD:
305        IDIDEAL(h) = idInit(1,1);
306        break;
307      case MAP_CMD:
308        IDIDEAL(h) = idInit(1,1);
309        IDMAP(h)->preimage = omStrDup(IDID(currRingHdl));
310        break;
311      case STRING_CMD:
312        IDSTRING(h) = omStrDup("");
313        break;
314      case LIST_CMD:
315        IDLIST(h)=(lists)omAllocBin(slists_bin);
316        IDLIST(h)->Init();
317        break;
318      case LINK_CMD:
319        IDLINK(h)=(si_link) omAlloc0Bin(sip_link_bin);
320        break;
321      case RING_CMD:
322        IDRING(h) = (ring) omAlloc0Bin(sip_sring_bin);
323        break;
324      case PACKAGE_CMD:
325        IDPACKAGE(h) = (package) omAlloc0Bin(sip_package_bin);
326        break;
327      case PROC_CMD:
328        IDPROC(h) = (procinfo*) omAlloc0Bin(procinfo_bin);
329        break;
330        //the types with the standard init: set the struct to zero
331      case RESOLUTION_CMD:
332        len=sizeof(ssyStrategy);
333        break;
334    //other types: without init (int,script,poly,def,package)
335    }
336    if (len!=0)
337    {
338      IDSTRING(h) = (char *)omAlloc0(len);
339    }
340    // additional settings:--------------------------------------
341#if 0
342    // this leads to a memory leak
343    if (t == QRING_CMD)
344    {
345      // IDRING(h)=rCopy(currRing);
346      /* QRING_CMD is ring dep => currRing !=NULL */
347    }
348    else
349#endif
350      if (t == PROC_CMD)
351    {
352      IDPROC(h)->language=LANG_NONE;
353    }
354    else if (t == PACKAGE_CMD)
355    {
356      IDPACKAGE(h)->language=LANG_NONE;
357      IDPACKAGE(h)->loaded = FALSE;
358    }
359  }
360  // --------------------------------------------------------
361  return  h;
362}
363
364char * idrec::String()
365{
366  sleftv tmp;
367  memset(&tmp,0,sizeof(sleftv));
368  tmp.rtyp=IDTYP(this);
369  tmp.data=IDDATA(this);
370  tmp.name=IDID(this);
371  return tmp.String();
372}
373
374//#define KAI
375idhdl enterid(const char * s, int lev, idtyp t, idhdl* root, BOOLEAN init)
376{
377  idhdl h;
378  s=omStrDup(s);
379  // is it already defined in root ?
380  if ((h=(*root)->get(s,lev))!=NULL)
381  {
382    if (IDLEV(h)==lev)
383    {
384      if ((IDTYP(h) == t)||(t==DEF_CMD))
385      {
386        if ((IDTYP(h)==PACKAGE_CMD)
387        && (strcmp(s,"Top")==0))
388        {
389          goto errlabel;
390        }
391        if (BVERBOSE(V_REDEFINE))
392          Warn("redefining %s **",s);
393        if (s==IDID(h)) IDID(h)=NULL;
394        killhdl2(h,root,currRing);
395      }
396      else
397        goto errlabel;
398    }
399  }
400  // is it already defined in idroot ?
401  else if (*root != IDROOT)
402  {
403    if ((h=IDROOT->get(s,lev))!=NULL)
404    {
405      if (IDLEV(h)==lev)
406      {
407        if ((IDTYP(h) == t)||(t==DEF_CMD))
408        {
409          if (BVERBOSE(V_REDEFINE))
410            Warn("redefining %s **",s);
411          if (s==IDID(h)) IDID(h)=NULL;
412          killhdl2(h,&IDROOT,NULL);
413        }
414        else
415          goto errlabel;
416      }
417    }
418  }
419  // is it already defined in currRing->idroot ?
420  else if ((currRing!=NULL)&&((*root) != currRing->idroot))
421  {
422    if ((h=currRing->idroot->get(s,lev))!=NULL)
423    {
424      if (IDLEV(h)==lev)
425      {
426        if ((IDTYP(h) == t)||(t==DEF_CMD))
427        {
428          if (BVERBOSE(V_REDEFINE))
429            Warn("redefining %s **",s);
430          IDID(h)=NULL;
431          killhdl2(h,&currRing->idroot,currRing);
432        }
433        else
434          goto errlabel;
435      }
436    }
437  }
438  *root = (*root)->set(s, lev, t, init);
439#ifdef HAVE_NS
440#ifndef NDEBUG
441  checkall();
442#endif
443#endif
444  return *root;
445
446  errlabel:
447    //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
448    Werror("identifier `%s` in use",s);
449#ifdef HAVE_NS
450    //listall();
451#endif
452    omFree((ADDRESS)s);
453    return NULL;
454}
455
456void killid(const char * id, idhdl * ih)
457{
458  if (id!=NULL)
459  {
460    idhdl h = (*ih)->get(id,myynest);
461
462    // id not found in global list, is it defined in current ring ?
463    if (h==NULL)
464    {
465      if ((currRing!=NULL) && (*ih != (currRing->idroot)))
466      {
467        h = currRing->idroot->get(id,myynest);
468        if (h!=NULL)
469        {
470          killhdl2(h,&(currRing->idroot),currRing);
471          return;
472        }
473      }
474      Werror("`%s` is not defined",id);
475      return;
476    }
477    killhdl2(h,ih,currRing);
478  }
479  else
480    Werror("kill what ?");
481}
482
483#ifndef HAVE_NS
484void killhdl(idhdl h)
485{
486  int t=IDTYP(h);
487  if (((BEGIN_RING<t) && (t<END_RING) && (t!=QRING_CMD))
488  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
489    killhdl2(h,&currRing->idroot,currRing);
490  else
491  {
492    {
493      idhdl s=IDROOT;
494      while ((s!=h) && (s!=NULL)) s=s->next;
495      if (s==NULL) killhdl2(h,&(currRing->idroot),currRing);
496      else killhdl2(h,&IDROOT,currRing);
497    }
498  }
499}
500#else
501//#ifdef HAVE_NS
502void killhdl(idhdl h, package proot)
503{
504  int t=IDTYP(h);
505  if (((BEGIN_RING<t) && (t<END_RING) && (t!=QRING_CMD))
506  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
507    killhdl2(h,&currRing->idroot,currRing);
508  else
509  {
510    if(t==PACKAGE_CMD)
511    {
512      killhdl2(h,&(basePack->idroot),NULL);
513    }
514    else
515    {
516      idhdl s=proot->idroot;
517      while ((s!=h) && (s!=NULL)) s=s->next;
518      if (s!=NULL)
519        killhdl2(h,&(proot->idroot),NULL);
520      else if (basePack!=proot)
521      {
522        idhdl s=basePack->idroot;
523        while ((s!=h) && (s!=NULL)) s=s->next;
524        if (s!=NULL)
525          killhdl2(h,&(basePack->idroot),currRing);
526        else
527          killhdl2(h,&(currRing->idroot),currRing);
528       }
529    }
530  }
531}
532#endif /* HAVE_NS */
533
534void killhdl2(idhdl h, idhdl * ih, ring r)
535{
536  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
537  idhdl hh;
538
539  if (h->attribute!=NULL)
540  {
541    at_KillAll(h,r);
542    //h->attribute=NULL;
543  }
544  if ((IDTYP(h) == PACKAGE_CMD) && (strcmp(IDID(h),"Top")==0))
545  {
546    WarnS("can not kill `Top`");
547    return;
548  }
549  // ring / qring  --------------------------------------------------------
550  if ((IDTYP(h) == RING_CMD) || (IDTYP(h) == QRING_CMD))
551  {
552    // any objects defined for this ring ? -> done by rKill
553   
554    rKill(h);
555  }
556#ifdef HAVE_NS
557  // package -------------------------------------------------------------
558  else if (IDTYP(h) == PACKAGE_CMD)
559  {
560    // any objects defined for this package ?
561    if ((IDPACKAGE(h)->ref<=0)  &&  (IDPACKAGE(h)->idroot!=NULL))
562    {
563      if (currPack==IDPACKAGE(h))
564      {
565        currPack=basePack;
566        currPackHdl=NULL;
567      }
568      idhdl * hd = &IDRING(h)->idroot;
569      idhdl  hdh = IDNEXT(*hd);
570      idhdl  temp;
571      while (hdh!=NULL)
572      {
573        temp = IDNEXT(hdh);
574        killhdl2(hdh,&(IDPACKAGE(h)->idroot),NULL);
575        hdh = temp;
576      }
577      killhdl2(*hd,hd,NULL);
578      if (IDPACKAGE(h)->libname!=NULL) omFree((ADDRESS)(IDPACKAGE(h)->libname));
579    }
580    paKill(IDPACKAGE(h));
581    if (currPackHdl==h) currPackHdl=packFindHdl(currPack);
582    iiCheckPack(currPack);
583  }
584#endif /* HAVE_NS */
585  // poly / vector -------------------------------------------------------
586  else if ((IDTYP(h) == POLY_CMD) || (IDTYP(h) == VECTOR_CMD))
587  {
588    assume(r!=NULL);
589    p_Delete(&IDPOLY(h),r);
590  }
591  // ideal / module/ matrix / map ----------------------------------------
592  else if ((IDTYP(h) == IDEAL_CMD)
593           || (IDTYP(h) == MODUL_CMD)
594           || (IDTYP(h) == MATRIX_CMD)
595           || (IDTYP(h) == MAP_CMD))
596  {
597    assume(r!=NULL);
598    ideal iid = IDIDEAL(h);
599    if (IDTYP(h) == MAP_CMD)
600    {
601      map im = IDMAP(h);
602      omFree((ADDRESS)im->preimage);
603    }
604    id_Delete(&iid,r);
605  }
606  // string -------------------------------------------------------------
607  else if (IDTYP(h) == STRING_CMD)
608  {
609    omFree((ADDRESS)IDSTRING(h));
610    //IDSTRING(h)=NULL;
611  }
612  // proc ---------------------------------------------------------------
613  else if (IDTYP(h) == PROC_CMD)
614  {
615    if (piKill(IDPROC(h))) return;
616  }
617  // number -------------------------------------------------------------
618  else if (IDTYP(h) == NUMBER_CMD)
619  {
620    assume(r!=NULL);
621    n_Delete(&IDNUMBER(h),r);
622  }
623  // bigint -------------------------------------------------------------
624  else if (IDTYP(h) == BIGINT_CMD)
625  {
626    nlDelete(&IDNUMBER(h),NULL);
627  }
628  // intvec / intmat  ---------------------------------------------------
629  else if ((IDTYP(h) == INTVEC_CMD)||(IDTYP(h) == INTMAT_CMD))
630  {
631    delete IDINTVEC(h);
632  }
633  // list  -------------------------------------------------------------
634  else if (IDTYP(h)==LIST_CMD)
635  {
636    IDLIST(h)->Clean(r);
637    //IDLIST(h)=NULL;
638  }
639  // link  -------------------------------------------------------------
640  else if (IDTYP(h)==LINK_CMD)
641  {
642    slKill(IDLINK(h));
643  }
644  else if(IDTYP(h)==RESOLUTION_CMD)
645  {
646    assume(r!=NULL);
647    if (IDDATA(h)!=NULL)
648      syKillComputation((syStrategy)IDDATA(h),r);
649  }
650#ifdef TEST
651  else if ((IDTYP(h)!= INT_CMD)&&(IDTYP(h)!=DEF_CMD) && (IDTYP(h)!=NONE))
652    Warn("unknown type to kill: %s(%d)",Tok2Cmdname(IDTYP(h)),IDTYP(h));
653#endif
654
655  //  general  -------------------------------------------------------------
656  // now dechain it and delete idrec
657#ifdef KAI
658  if(h->next != NULL)
659    Print("=======>%s(%x) -> %s<====\n", IDID(h), IDID(h), IDID(h->next));
660  else
661    Print("=======>%s(%x)<====\n", IDID(h), IDID(h));
662#endif
663
664  if (IDID(h)!=NULL) // OB: ?????
665    omFree((ADDRESS)IDID(h));
666  IDID(h)=NULL;
667  IDDATA(h)=NULL;
668  if (h == (*ih))
669  {
670    // h is at the beginning of the list
671    *ih = IDNEXT(h) /* ==*ih */;
672  }
673  else if (ih!=NULL)
674  {
675    // h is somethere in the list:
676    hh = *ih;
677    loop
678    {
679      if (hh==NULL)
680      {
681        PrintS(">>?<< not found for kill\n");
682        return;
683      }
684      idhdl hhh = IDNEXT(hh);
685      if (hhh == h)
686      {
687        IDNEXT(hh) = IDNEXT(hhh);
688        break;
689      }
690      hh = hhh;
691    }
692  }
693  omFreeBin((ADDRESS)h, idrec_bin);
694}
695
696idhdl ggetid(const char *n, BOOLEAN local, idhdl *packhdl)
697{
698  idhdl h = IDROOT->get(n,myynest);
699  idhdl h2=NULL;
700  *packhdl = NULL;
701  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
702  {
703    h2 = currRing->idroot->get(n,myynest);
704  }
705  if (h2==NULL) return h;
706  return h2;
707}
708
709idhdl ggetid(const char *n, BOOLEAN local)
710{
711  idhdl h = IDROOT->get(n,myynest);
712  if ((h!=NULL)&&(IDLEV(h)==myynest)) return h;
713  idhdl h2=NULL;
714  if (currRing!=NULL)
715  {
716    h2 = currRing->idroot->get(n,myynest);
717  }
718  if (h2!=NULL) return h2;
719  if (h!=NULL) return h;
720#ifdef HAVE_NS
721  if (basePack!=currPack)
722    return basePack->idroot->get(n,myynest);
723#endif
724  return NULL;
725}
726
727void ipListFlag(idhdl h)
728{
729  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
730#ifdef HAVE_PLURAL
731  if (hasFlag(h,FLAG_TWOSTD)) PrintS(" (2SB)");
732#endif
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 int 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 FALSE; /*okay */
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 TRUE; /* 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  return FALSE;
784}
785
786void  ipMoveId(idhdl tomove)
787{
788  if ((currRing!=NULL)&&(tomove!=NULL))
789  {
790    if (((QRING_CMD!=IDTYP(tomove)) && RingDependend(IDTYP(tomove)))
791    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
792    {
793      /*move 'tomove' to ring id's*/
794#ifdef HAVE_NS
795      if (ipSwapId(tomove,IDROOT,currRing->idroot))
796      ipSwapId(tomove,basePack->idroot,currRing->idroot);
797#else
798      ipSwapId(tomove,IDROOT,currRing->idroot);
799#endif
800    }
801    else
802    {
803      /*move 'tomove' to global id's*/
804      ipSwapId(tomove,currRing->idroot,IDROOT);
805    }
806  }
807}
808
809const char * piProcinfo(procinfov pi, const char *request)
810{
811  if(pi == NULL) return "empty proc";
812  else if (strcmp(request, "libname")  == 0) return pi->libname;
813  else if (strcmp(request, "procname") == 0) return pi->procname;
814  else if (strcmp(request, "type")     == 0)
815  {
816    switch (pi->language)
817    {
818      case LANG_SINGULAR: return "singular"; break;
819      case LANG_C:        return "object";   break;
820      case LANG_NONE:     return "none";     break;
821      default:            return "unknow language";
822    }
823  }
824  else if (strcmp(request, "ref")      == 0)
825  {
826    char p[8];
827    sprintf(p, "%d", pi->ref);
828    return omStrDup(p);  // MEMORY-LEAK
829  }
830  return "??";
831}
832
833void piCleanUp(procinfov pi)
834{
835  (pi->ref)--;
836  if (pi->ref <= 0)
837  {
838    if (pi->libname != NULL) // OB: ????
839      omFree((ADDRESS)pi->libname);
840    if (pi->procname != NULL) // OB: ????
841      omFree((ADDRESS)pi->procname);
842
843    if( pi->language == LANG_SINGULAR)
844    {
845      if (pi->data.s.body != NULL) // OB: ????
846        omFree((ADDRESS)pi->data.s.body);
847    }
848    if( pi->language == LANG_C)
849    {
850    }
851    memset((void *) pi, 0, sizeof(procinfo));
852    pi->language=LANG_NONE;
853  }
854}
855
856BOOLEAN piKill(procinfov pi)
857{
858  Voice *p=currentVoice;
859  while (p!=NULL)
860  {
861    if (p->pi==pi && pi->ref <= 1)
862    {
863      Warn("`%s` in use, can not be killed",pi->procname);
864      return TRUE;
865    }
866    p=p->next;
867  }
868  piCleanUp(pi);
869  if (pi->ref <= 0)
870    omFreeBin((ADDRESS)pi,  procinfo_bin);
871  return FALSE;
872}
873
874void paCleanUp(package pack)
875{
876  (pack->ref)--;
877  if (pack->ref < 0)
878  {
879#ifndef HAVE_STATIC
880    if( pack->language == LANG_C)
881    {
882      Print("//dlclose(%s)\n",pack->libname);
883#ifdef HAVE_DYNAMIC_LOADING
884      dynl_close (pack->handle);
885#endif /* HAVE_DYNAMIC_LOADING */
886    }
887#endif /* HAVE_STATIC */
888    omfree((ADDRESS)pack->libname);
889    memset((void *) pack, 0, sizeof(sip_package));
890    pack->language=LANG_NONE;
891  }
892}
893
894char *idhdl2id(idhdl pck, idhdl h)
895{
896  char *name = (char *)omAlloc(strlen(pck->id) + strlen(h->id) + 3);
897  sprintf(name, "%s::%s", pck->id, h->id);
898  return(name);
899}
900
901void iiname2hdl(const char *name, idhdl *pck, idhdl *h)
902{
903  const char *q = strchr(name, ':');
904  char *p, *i;
905
906  if(q==NULL)
907  {
908    p = omStrDup("");
909    i = (char *)omAlloc(strlen(name)+1);
910    *i = '\0';
911    sscanf(name, "%s", i);
912  }
913  else {
914    if( *(q+1) != ':') return;
915    i = (char *)omAlloc(strlen(name)+1);
916    *i = '\0';
917    if(name == q)
918    {
919      p = omStrDup("");
920      sscanf(name, "::%s", i);
921    }
922    else
923    {
924      p = (char *)omAlloc(strlen(name)+1);
925      sscanf(name, "%[^:]::%s", p, i);
926    }
927  }
928  //printf("Package: '%s'\n", p);
929  //printf("Id Rec : '%s'\n", i);
930  omFree(p);
931  omFree(i);
932}
933
934#if 0
935char *getnamelev()
936{
937  char buf[256];
938  sprintf(buf, "(%s:%d)", namespaceroot->name,namespaceroot->lev);
939  return(buf);
940}
941// warning: address of local variable `buf' returned
942#endif
943
944void proclevel::push(char *n)
945{
946  //Print("push %s\n",n);
947  proclevel *p=(proclevel*)omAlloc0(sizeof(proclevel));
948  p->cRing=currRing;
949  p->cRingHdl=currRingHdl;
950  p->name=n;
951  #ifdef HAVE_NS
952  p->cPackHdl=currPackHdl;
953  p->cPack=currPack;
954  #endif
955  p->next=this;
956  procstack=p;
957}
958void proclevel::pop()
959{
960  //Print("pop %s\n",name);
961  //if (currRing!=::currRing) PrintS("currRing wrong\n");;
962  //::currRing=this->currRing;
963  //if (r==NULL) Print("set ring to NULL at lev %d(%s)\n",myynest,name);
964  //::currRingHdl=this->currRingHdl;
965  //if((::currRingHdl==NULL)||(IDRING(::currRingHdl)!=(::currRing)))
966  //  ::currRingHdl=rFindHdl(::currRing,NULL,NULL);
967  #ifdef HAVE_NS
968  //Print("restore pack=%s,1.obj=%s\n",IDID(currPackHdl),IDID(currPack->idroot));
969  currPackHdl=this->cPackHdl;
970  currPack=this->cPack;
971  iiCheckPack(currPack);
972  #endif
973  proclevel *p=this;
974  procstack=next;
975  omFreeSize(p,sizeof(proclevel));
976}
977
978#ifdef HAVE_NS
979idhdl packFindHdl(package r)
980{
981  idhdl h=basePack->idroot;
982  while (h!=NULL)
983  {
984    if ((IDTYP(h)==PACKAGE_CMD)
985        && (IDPACKAGE(h)==r))
986      return h;
987    h=IDNEXT(h);
988  }
989  return NULL;
990}
991#endif
Note: See TracBrowser for help on using the repository browser.