source: git/Singular/ipid.cc @ 85e68dd

spielwiese
Last change on this file since 85e68dd was 85e68dd, checked in by Hans Schönemann <hannes@…>, 16 years ago
*hannes: gcc 4.2 git-svn-id: file:///usr/local/Singular/svn/trunk@10634 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 22.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipid.cc,v 1.83 2008-03-19 17:44:34 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      case QRING_CMD:
323        IDRING(h) = (ring) omAlloc0Bin(sip_sring_bin);
324        break;
325      case PACKAGE_CMD:
326        IDPACKAGE(h) = (package) omAlloc0Bin(sip_package_bin);
327        break;
328      case PROC_CMD:
329        IDPROC(h) = (procinfo*) omAlloc0Bin(procinfo_bin);
330        break;
331        //the types with the standard init: set the struct to zero
332      case RESOLUTION_CMD:
333        len=sizeof(ssyStrategy);
334        break;
335    //other types: without init (int,script,poly,def,package)
336    }
337    if (len!=0)
338    {
339      IDSTRING(h) = (char *)omAlloc0(len);
340    }
341    // additional settings:--------------------------------------
342#if 0
343    // this leads to a memory leak
344    if (t == QRING_CMD)
345    {
346      // IDRING(h)=rCopy(currRing);
347      /* QRING_CMD is ring dep => currRing !=NULL */
348    }
349    else
350#endif
351      if (t == PROC_CMD)
352    {
353      IDPROC(h)->language=LANG_NONE;
354    }
355    else if (t == PACKAGE_CMD)
356    {
357      IDPACKAGE(h)->language=LANG_NONE;
358      IDPACKAGE(h)->loaded = FALSE;
359    }
360  }
361  // --------------------------------------------------------
362  return  h;
363}
364
365char * idrec::String()
366{
367  sleftv tmp;
368  memset(&tmp,0,sizeof(sleftv));
369  tmp.rtyp=IDTYP(this);
370  tmp.data=IDDATA(this);
371  tmp.name=IDID(this);
372  return tmp.String();
373}
374
375//#define KAI
376idhdl enterid(const char * s, int lev, idtyp t, idhdl* root, BOOLEAN init)
377{
378  idhdl h;
379  s=omStrDup(s);
380  // is it already defined in root ?
381  if ((h=(*root)->get(s,lev))!=NULL)
382  {
383    if (IDLEV(h)==lev)
384    {
385    if ((IDTYP(h) == t)||(t==DEF_CMD))
386    {
387      if ((IDTYP(h)==PACKAGE_CMD)
388      && (strcmp(s,"Top")==0))
389      {
390        goto errlabel;
391      }
392      if (BVERBOSE(V_REDEFINE))
393        Warn("redefining %s **",s);
394      if (s==IDID(h)) IDID(h)=NULL;
395      killhdl2(h,root,currRing);
396    }
397    else
398      goto errlabel;
399    }
400  }
401  // is it already defined in idroot ?
402  else if (*root != IDROOT)
403  {
404    if ((h=IDROOT->get(s,lev))!=NULL)
405    {
406      if (IDLEV(h)==lev)
407      {
408      if ((IDTYP(h) == t)||(t==DEF_CMD))
409      {
410        if (BVERBOSE(V_REDEFINE))
411          Warn("redefining %s **",s);
412        if (s==IDID(h)) IDID(h)=NULL;
413        killhdl2(h,&IDROOT,NULL);
414      }
415      else
416        goto errlabel;
417      }
418    }
419  }
420  // is it already defined in currRing->idroot ?
421  else if ((currRing!=NULL)&&((*root) != currRing->idroot))
422  {
423    if ((h=currRing->idroot->get(s,lev))!=NULL)
424    {
425      if (IDLEV(h)==lev)
426      {
427      if ((IDTYP(h) == t)||(t==DEF_CMD))
428      {
429        if (BVERBOSE(V_REDEFINE))
430          Warn("redefining %s **",s);
431        IDID(h)=NULL;
432        killhdl2(h,&currRing->idroot,currRing);
433      }
434      else
435        goto errlabel;
436      }
437    }
438  }
439  *root = (*root)->set(s, lev, t, init);
440#ifdef HAVE_NS
441#ifndef NDEBUG
442  checkall();
443#endif
444#endif
445  return *root;
446
447  errlabel:
448    //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
449    Werror("identifier `%s` in use",s);
450#ifdef HAVE_NS
451    //listall();
452#endif
453    omFree((ADDRESS)s);
454    return NULL;
455}
456
457void killid(const char * id, idhdl * ih)
458{
459  if (id!=NULL)
460  {
461    idhdl h = (*ih)->get(id,myynest);
462
463    // id not found in global list, is it defined in current ring ?
464    if (h==NULL)
465    {
466      if ((currRing!=NULL) && (*ih != (currRing->idroot)))
467      {
468        h = currRing->idroot->get(id,myynest);
469        if (h!=NULL)
470        {
471          killhdl2(h,&(currRing->idroot),currRing);
472          return;
473        }
474      }
475      Werror("`%s` is not defined",id);
476      return;
477    }
478    killhdl2(h,ih,currRing);
479  }
480  else
481    Werror("kill what ?");
482}
483
484#ifndef HAVE_NS
485void killhdl(idhdl h)
486{
487  int t=IDTYP(h);
488  if (((BEGIN_RING<t) && (t<END_RING) && (t!=QRING_CMD))
489  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
490    killhdl2(h,&currRing->idroot,currRing);
491  else
492  {
493    {
494      idhdl s=IDROOT;
495      while ((s!=h) && (s!=NULL)) s=s->next;
496      if (s==NULL) killhdl2(h,&(currRing->idroot),currRing);
497      else killhdl2(h,&IDROOT,currRing);
498    }
499  }
500}
501#else
502//#ifdef HAVE_NS
503void killhdl(idhdl h, package proot)
504{
505  int t=IDTYP(h);
506  if (((BEGIN_RING<t) && (t<END_RING) && (t!=QRING_CMD))
507  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
508    killhdl2(h,&currRing->idroot,currRing);
509  else
510  {
511    if(t==PACKAGE_CMD)
512    {
513      killhdl2(h,&(basePack->idroot),NULL);
514    }
515    else
516    {
517      idhdl s=proot->idroot;
518      while ((s!=h) && (s!=NULL)) s=s->next;
519      if (s!=NULL)
520        killhdl2(h,&(proot->idroot),NULL);
521      else if (basePack!=proot)
522      {
523        idhdl s=basePack->idroot;
524        while ((s!=h) && (s!=NULL)) s=s->next;
525        if (s!=NULL)
526          killhdl2(h,&(basePack->idroot),currRing);
527        else
528          killhdl2(h,&(currRing->idroot),currRing);
529       }
530    }
531  }
532}
533#endif /* HAVE_NS */
534
535void killhdl2(idhdl h, idhdl * ih, ring r)
536{
537  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
538  idhdl hh;
539
540  if (h->attribute!=NULL)
541  {
542    atKillAll(h);
543    //h->attribute=NULL;
544  }
545  if ((IDTYP(h) == PACKAGE_CMD) && (strcmp(IDID(h),"Top")==0))
546  {
547    WarnS("can not kill `Top`");
548    return;
549  }
550  // ring / qring  --------------------------------------------------------
551  if ((IDTYP(h) == RING_CMD) || (IDTYP(h) == QRING_CMD))
552  {
553    // any objects defined for this ring ? -> done by rKill
554   
555    rKill(h);
556  }
557#ifdef HAVE_NS
558  // package -------------------------------------------------------------
559  else if (IDTYP(h) == PACKAGE_CMD)
560  {
561    // any objects defined for this package ?
562    if ((IDPACKAGE(h)->ref<=0)  &&  (IDPACKAGE(h)->idroot!=NULL))
563    {
564      if (currPack==IDPACKAGE(h))
565      {
566        currPack=basePack;
567        currPackHdl=NULL;
568      }
569      idhdl * hd = &IDRING(h)->idroot;
570      idhdl  hdh = IDNEXT(*hd);
571      idhdl  temp;
572      while (hdh!=NULL)
573      {
574        temp = IDNEXT(hdh);
575        killhdl2(hdh,&(IDPACKAGE(h)->idroot),NULL);
576        hdh = temp;
577      }
578      killhdl2(*hd,hd,NULL);
579      if (IDPACKAGE(h)->libname!=NULL) omFree((ADDRESS)(IDPACKAGE(h)->libname));
580    }
581    paKill(IDPACKAGE(h));
582    if (currPackHdl==h) currPackHdl=packFindHdl(currPack);
583    iiCheckPack(currPack);
584  }
585#endif /* HAVE_NS */
586  // poly / vector -------------------------------------------------------
587  else if ((IDTYP(h) == POLY_CMD) || (IDTYP(h) == VECTOR_CMD))
588  {
589    assume(r!=NULL);
590    p_Delete(&IDPOLY(h),r);
591  }
592  // ideal / module/ matrix / map ----------------------------------------
593  else if ((IDTYP(h) == IDEAL_CMD)
594           || (IDTYP(h) == MODUL_CMD)
595           || (IDTYP(h) == MATRIX_CMD)
596           || (IDTYP(h) == MAP_CMD))
597  {
598    assume(r!=NULL);
599    ideal iid = IDIDEAL(h);
600    if (IDTYP(h) == MAP_CMD)
601    {
602      map im = IDMAP(h);
603      omFree((ADDRESS)im->preimage);
604    }
605    id_Delete(&iid,r);
606  }
607  // string -------------------------------------------------------------
608  else if (IDTYP(h) == STRING_CMD)
609  {
610    omFree((ADDRESS)IDSTRING(h));
611    //IDSTRING(h)=NULL;
612  }
613  // proc ---------------------------------------------------------------
614  else if (IDTYP(h) == PROC_CMD)
615  {
616    if (piKill(IDPROC(h))) return;
617  }
618  // number -------------------------------------------------------------
619  else if (IDTYP(h) == NUMBER_CMD)
620  {
621    assume(r!=NULL);
622    n_Delete(&IDNUMBER(h),r);
623  }
624  // bigint -------------------------------------------------------------
625  else if (IDTYP(h) == BIGINT_CMD)
626  {
627    nlDelete(&IDNUMBER(h),NULL);
628  }
629  // intvec / intmat  ---------------------------------------------------
630  else if ((IDTYP(h) == INTVEC_CMD)||(IDTYP(h) == INTMAT_CMD))
631  {
632    delete IDINTVEC(h);
633  }
634  // list  -------------------------------------------------------------
635  else if (IDTYP(h)==LIST_CMD)
636  {
637    IDLIST(h)->Clean(r);
638    //IDLIST(h)=NULL;
639  }
640  // link  -------------------------------------------------------------
641  else if (IDTYP(h)==LINK_CMD)
642  {
643    slKill(IDLINK(h));
644  }
645  else if(IDTYP(h)==RESOLUTION_CMD)
646  {
647    assume(r!=NULL);
648    if (IDDATA(h)!=NULL)
649      syKillComputation((syStrategy)IDDATA(h),r);
650  }
651#ifdef TEST
652  else if ((IDTYP(h)!= INT_CMD)&&(IDTYP(h)!=DEF_CMD) && (IDTYP(h)!=NONE))
653    Warn("unknown type to kill: %s(%d)",Tok2Cmdname(IDTYP(h)),IDTYP(h));
654#endif
655
656  //  general  -------------------------------------------------------------
657  // now dechain it and delete idrec
658#ifdef KAI
659  if(h->next != NULL)
660    Print("=======>%s(%x) -> %s<====\n", IDID(h), IDID(h), IDID(h->next));
661  else
662    Print("=======>%s(%x)<====\n", IDID(h), IDID(h));
663#endif
664
665  if (IDID(h)!=NULL) // OB: ?????
666    omFree((ADDRESS)IDID(h));
667  IDID(h)=NULL;
668  IDDATA(h)=NULL;
669  if (h == (*ih))
670  {
671    // h is at the beginning of the list
672    *ih = IDNEXT(h) /* ==*ih */;
673  }
674  else if (ih!=NULL)
675  {
676    // h is somethere in the list:
677    hh = *ih;
678    loop
679    {
680      if (hh==NULL)
681      {
682        PrintS(">>?<< not found for kill\n");
683        return;
684      }
685      idhdl hhh = IDNEXT(hh);
686      if (hhh == h)
687      {
688        IDNEXT(hh) = IDNEXT(hhh);
689        break;
690      }
691      hh = hhh;
692    }
693  }
694  omFreeBin((ADDRESS)h, idrec_bin);
695}
696
697idhdl ggetid(const char *n, BOOLEAN local, idhdl *packhdl)
698{
699  idhdl h = IDROOT->get(n,myynest);
700  idhdl h2=NULL;
701  *packhdl = NULL;
702  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
703  {
704    h2 = currRing->idroot->get(n,myynest);
705  }
706  if (h2==NULL) return h;
707  return h2;
708}
709
710idhdl ggetid(const char *n, BOOLEAN local)
711{
712  idhdl h = IDROOT->get(n,myynest);
713  if ((h!=NULL)&&(IDLEV(h)==myynest)) return h;
714  idhdl h2=NULL;
715  if (currRing!=NULL)
716  {
717    h2 = currRing->idroot->get(n,myynest);
718  }
719  if (h2!=NULL) return h2;
720  if (h!=NULL) return h;
721#ifdef HAVE_NS
722  if (basePack!=currPack)
723    return basePack->idroot->get(n,myynest);
724#endif
725  return NULL;
726}
727
728void ipListFlag(idhdl h)
729{
730  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
731#ifdef HAVE_PLURAL
732  if (hasFlag(h,FLAG_TWOSTD)) PrintS(" (2SB)");
733#endif
734}
735
736lists ipNameList(idhdl root)
737{
738  idhdl h=root;
739  /* compute the length */
740  int l=0;
741  while (h!=NULL) { l++; h=IDNEXT(h); }
742  /* allocate list */
743  lists L=(lists)omAllocBin(slists_bin);
744  L->Init(l);
745  /* copy names */
746  h=root;
747  l=0;
748  while (h!=NULL)
749  {
750    /* list is initialized with 0 => no need to clear anything */
751    L->m[l].rtyp=STRING_CMD;
752    L->m[l].data=omStrDup(IDID(h));
753    l++;
754    h=IDNEXT(h);
755  }
756  return L;
757}
758
759/*
760* move 'tomove' from root1 list to root2 list
761*/
762static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
763{
764  idhdl h;
765  /* search 'tomove' in root2 : if found -> do nothing */
766  h=root2;
767  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
768  if (h!=NULL) return FALSE; /*okay */
769  /* search predecessor of h in root1, remove 'tomove' */
770  h=root1;
771  if (tomove==h)
772  {
773    root1=IDNEXT(h);
774  }
775  else
776  {
777    while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
778    if (h==NULL) return TRUE; /* not in the list root1 -> do nothing */
779    IDNEXT(h)=IDNEXT(tomove);
780  }
781  /* add to root2 list */
782  IDNEXT(tomove)=root2;
783  root2=tomove;
784  return FALSE;
785}
786
787void  ipMoveId(idhdl tomove)
788{
789  if ((currRing!=NULL)&&(tomove!=NULL))
790  {
791    if (((QRING_CMD!=IDTYP(tomove)) && RingDependend(IDTYP(tomove)))
792    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
793    {
794      /*move 'tomove' to ring id's*/
795#ifdef HAVE_NS
796      if (ipSwapId(tomove,IDROOT,currRing->idroot))
797      ipSwapId(tomove,basePack->idroot,currRing->idroot);
798#else
799      ipSwapId(tomove,IDROOT,currRing->idroot);
800#endif
801    }
802    else
803    {
804      /*move 'tomove' to global id's*/
805      ipSwapId(tomove,currRing->idroot,IDROOT);
806    }
807  }
808}
809
810const char * piProcinfo(procinfov pi, const char *request)
811{
812  if(pi == NULL) return "empty proc";
813  else if (strcmp(request, "libname")  == 0) return pi->libname;
814  else if (strcmp(request, "procname") == 0) return pi->procname;
815  else if (strcmp(request, "type")     == 0)
816  {
817    switch (pi->language)
818    {
819      case LANG_SINGULAR: return "singular"; break;
820      case LANG_C:        return "object";   break;
821      case LANG_NONE:     return "none";     break;
822      default:            return "unknow language";
823    }
824  }
825  else if (strcmp(request, "ref")      == 0)
826  {
827    char p[8];
828    sprintf(p, "%d", pi->ref);
829    return omStrDup(p);  // MEMORY-LEAK
830  }
831  return "??";
832}
833
834void piCleanUp(procinfov pi)
835{
836  (pi->ref)--;
837  if (pi->ref <= 0)
838  {
839    if (pi->libname != NULL) // OB: ????
840      omFree((ADDRESS)pi->libname);
841    if (pi->procname != NULL) // OB: ????
842      omFree((ADDRESS)pi->procname);
843
844    if( pi->language == LANG_SINGULAR)
845    {
846      if (pi->data.s.body != NULL) // OB: ????
847        omFree((ADDRESS)pi->data.s.body);
848    }
849    if( pi->language == LANG_C)
850    {
851    }
852    memset((void *) pi, 0, sizeof(procinfo));
853    pi->language=LANG_NONE;
854  }
855}
856
857BOOLEAN piKill(procinfov pi)
858{
859  Voice *p=currentVoice;
860  while (p!=NULL)
861  {
862    if (p->pi==pi && pi->ref <= 1)
863    {
864      Warn("`%s` in use, can not be killed",pi->procname);
865      return TRUE;
866    }
867    p=p->next;
868  }
869  piCleanUp(pi);
870  if (pi->ref <= 0)
871    omFreeBin((ADDRESS)pi,  procinfo_bin);
872  return FALSE;
873}
874
875void paCleanUp(package pack)
876{
877  (pack->ref)--;
878  if (pack->ref < 0)
879  {
880#ifndef HAVE_STATIC
881    if( pack->language == LANG_C)
882    {
883      Print("//dlclose(%s)\n",pack->libname);
884#ifdef HAVE_DYNAMIC_LOADING
885      dynl_close (pack->handle);
886#endif /* HAVE_DYNAMIC_LOADING */
887    }
888#endif /* HAVE_STATIC */
889    omfree((ADDRESS)pack->libname);
890    memset((void *) pack, 0, sizeof(sip_package));
891    pack->language=LANG_NONE;
892  }
893}
894
895char *idhdl2id(idhdl pck, idhdl h)
896{
897  char *name = (char *)omAlloc(strlen(pck->id) + strlen(h->id) + 3);
898  sprintf(name, "%s::%s", pck->id, h->id);
899  return(name);
900}
901
902void iiname2hdl(const char *name, idhdl *pck, idhdl *h)
903{
904  const char *q = strchr(name, ':');
905  char *p, *i;
906
907  if(q==NULL)
908  {
909    p = omStrDup("");
910    i = (char *)omAlloc(strlen(name)+1);
911    *i = '\0';
912    sscanf(name, "%s", i);
913  }
914  else {
915    if( *(q+1) != ':') return;
916    i = (char *)omAlloc(strlen(name)+1);
917    *i = '\0';
918    if(name == q)
919    {
920      p = omStrDup("");
921      sscanf(name, "::%s", i);
922    }
923    else
924    {
925      p = (char *)omAlloc(strlen(name)+1);
926      sscanf(name, "%[^:]::%s", p, i);
927    }
928  }
929  //printf("Package: '%s'\n", p);
930  //printf("Id Rec : '%s'\n", i);
931  omFree(p);
932  omFree(i);
933}
934
935#if 0
936char *getnamelev()
937{
938  char buf[256];
939  sprintf(buf, "(%s:%d)", namespaceroot->name,namespaceroot->lev);
940  return(buf);
941}
942// warning: address of local variable `buf' returned
943#endif
944
945void proclevel::push(char *n)
946{
947  //Print("push %s\n",n);
948  proclevel *p=(proclevel*)omAlloc0(sizeof(proclevel));
949  p->cRing=currRing;
950  p->cRingHdl=currRingHdl;
951  p->name=n;
952  #ifdef HAVE_NS
953  p->cPackHdl=currPackHdl;
954  p->cPack=currPack;
955  #endif
956  p->next=this;
957  procstack=p;
958}
959void proclevel::pop()
960{
961  //Print("pop %s\n",name);
962  //if (currRing!=::currRing) PrintS("currRing wrong\n");;
963  //::currRing=this->currRing;
964  //if (r==NULL) Print("set ring to NULL at lev %d(%s)\n",myynest,name);
965  //::currRingHdl=this->currRingHdl;
966  //if((::currRingHdl==NULL)||(IDRING(::currRingHdl)!=(::currRing)))
967  //  ::currRingHdl=rFindHdl(::currRing,NULL,NULL);
968  #ifdef HAVE_NS
969  //Print("restore pack=%s,1.obj=%s\n",IDID(currPackHdl),IDID(currPack->idroot));
970  currPackHdl=this->cPackHdl;
971  currPack=this->cPack;
972  iiCheckPack(currPack);
973  #endif
974  proclevel *p=this;
975  procstack=next;
976  omFreeSize(p,sizeof(proclevel));
977}
978
979#ifdef HAVE_NS
980idhdl packFindHdl(package r)
981{
982  idhdl h=basePack->idroot;
983  while (h!=NULL)
984  {
985    if ((IDTYP(h)==PACKAGE_CMD)
986        && (IDPACKAGE(h)==r))
987      return h;
988    h=IDNEXT(h);
989  }
990  return NULL;
991}
992#endif
Note: See TracBrowser for help on using the repository browser.