source: git/Singular/ipid.cc @ 5c5638

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