source: git/Singular/ipid.cc @ 3b1d9a

spielwiese
Last change on this file since 3b1d9a was 1085d4, checked in by Hans Schoenemann <hannes@…>, 13 years ago
fix idid.cc via ipshell.h
  • Property mode set to 100644
File size: 15.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT: identfier handling
8*/
9
10#include <string.h>
11
12#include <kernel/mod2.h>
13#include <Singular/static.h>
14#include <omalloc/omalloc.h>
15#include <Singular/tok.h>
16#include <misc/options.h>
17#include <Singular/ipshell.h>
18#include <misc/intvec.h>
19#include <kernel/febase.h>
20#include <coeffs/numbers.h>
21#include <kernel/longrat.h>
22#include <polys/polys.h>
23#include <polys/monomials/ring.h>
24#include <kernel/ideals.h>
25#include <polys/matpol.h>
26#include <Singular/lists.h>
27#include <Singular/attrib.h>
28#include <Singular/silink.h>
29#include <kernel/syz.h>
30#include <Singular/ipid.h>
31#include <Singular/blackbox.h>
32
33#ifdef HAVE_DYNAMIC_LOADING
34#include <polys/mod_raw.h>
35#endif /* HAVE_DYNAMIC_LOADING */
36
37omBin sip_command_bin = omGetSpecBin(sizeof(sip_command));
38omBin sip_package_bin = omGetSpecBin(sizeof(sip_package));
39//omBin ip_package_bin = omGetSpecBin(sizeof(ip_package));
40omBin idrec_bin = omGetSpecBin(sizeof(idrec));
41
42coeffs coeffs_BIGINT;
43
44FILE   *feFilePending; /*temp. storage for grammar.y */
45
46proclevel *procstack=NULL;
47#define TEST
48//idhdl idroot = NULL;
49
50idhdl currPackHdl = NULL;
51idhdl basePackHdl = NULL;
52package currPack =NULL;
53package basePack =NULL;
54idhdl currRingHdl = NULL;
55ring  currRing = NULL;
56ideal currQuotient = NULL;
57const char* iiNoName="_";
58
59void paCleanUp(package pack);
60
61/*0 implementation*/
62
63int iiS2I(const char *s)
64{
65  int i;
66  i=s[0];
67  if (s[1]!='\0')
68  {
69    i=(i<<8)+s[1];
70    if (s[2]!='\0')
71    {
72      i=(i<<8)+s[2];
73      if (s[3]!='\0')
74      {
75        i=(i<<8)+s[3];
76      }
77    }
78  }
79  return i;
80}
81
82idhdl idrec::get(const char * s, int level)
83{
84  assume(s!=NULL);
85  assume((level>=0) && (level<=1000)); //not really, but if it isnt in that bounds..
86  idhdl h = this;
87  idhdl found=NULL;
88  int l;
89  const char *id_;
90  int i=iiS2I(s);
91  int less4=(i < (1<<24));
92  while (h!=NULL)
93  {
94    omCheckAddr((ADDRESS)IDID(h));
95    l=IDLEV(h);
96    if ((l==0)||(l==level))
97    {
98      if (i==h->id_i)
99      {
100        id_=IDID(h);
101        if (less4 || (0 == strcmp(s+4,id_+4)))
102        {
103          if (l==level) return h;
104          found=h;
105        }
106      }
107    }
108    h = IDNEXT(h);
109  }
110  return found;
111}
112
113//idrec::~idrec()
114//{
115//  if (id!=NULL)
116//  {
117//    omFree((ADDRESS)id);
118//    id=NULL;
119//  }
120//  /* much more !! */
121//}
122
123void *idrecDataInit(int t)
124{
125  switch (t)
126  {
127    //the type with init routines:
128    case INTVEC_CMD:
129    case INTMAT_CMD:
130      return (void *)new intvec();
131    case NUMBER_CMD:
132      return (void *) nInit(0);
133    case BIGINT_CMD:
134      return (void *) n_Init(0, coeffs_BIGINT);
135    case IDEAL_CMD:
136    case MODUL_CMD:
137    case MATRIX_CMD:
138      return (void*) idInit(1,1);
139    case MAP_CMD:
140    {
141      map m = (map)idInit(1,1);
142      m->preimage = omStrDup(IDID(currRingHdl));
143      return (void *)m;
144    }
145    case STRING_CMD:
146      return (void *)omAlloc0(1);
147    case LIST_CMD:
148    {
149      lists l=(lists)omAllocBin(slists_bin);
150      l->Init();
151      return (void*)l;
152    }
153    //the types with the standard init: set the struct to zero
154    case LINK_CMD:
155      return (void*) omAlloc0Bin(sip_link_bin);
156    case RING_CMD:
157      return (void*) omAlloc0Bin(sip_sring_bin);
158    case PACKAGE_CMD:
159      return (void*) omAlloc0Bin(sip_package_bin);
160    case PROC_CMD:
161      return (void *) omAlloc0Bin(procinfo_bin);
162    case RESOLUTION_CMD:
163      return  (void *)omAlloc0(sizeof(ssyStrategy));
164    //other types: without init (int,script,poly,def,package)
165    case INT_CMD:
166    case DEF_CMD:
167    case POLY_CMD:
168    case VECTOR_CMD:
169    case QRING_CMD:
170       return (void*)0L;
171    default:
172      {
173        if (t>MAX_TOK)
174        {
175#ifdef BLACKBOX_DEVEL
176          Print("bb-type %d\n",t);
177#endif
178          blackbox *bb=getBlackboxStuff(t);
179          if (bb!=NULL)
180             return (void *)bb->blackbox_Init(bb);
181        }
182        else
183          Werror("unknown type %d",t);
184        break;
185      }
186  }
187  return (void *)0L;
188}
189idhdl idrec::set(const char * s, int level, int t, BOOLEAN init)
190{
191  //printf("define %s, %x, level: %d, typ: %d\n", s,s,level,t);
192  idhdl h = (idrec *)omAlloc0Bin(idrec_bin);
193  IDID(h)   = s;
194  IDTYP(h)  = t;
195  IDLEV(h)  = level;
196  IDNEXT(h) = this;
197  h->id_i=iiS2I(s);
198  if (init)
199  {
200    if ((t==IDEAL_CMD)||(t==MODUL_CMD))
201      IDFLAG(h) = Sy_bit(FLAG_STD);
202    IDSTRING(h)=(char *)idrecDataInit(t);
203    // additional settings:--------------------------------------
204#if 0
205    // this leads to a memory leak
206    if (t == QRING_CMD)
207    {
208      // IDRING(h)=rCopy(currRing);
209      /* QRING_CMD is ring dep => currRing !=NULL */
210    }
211    else
212#endif
213    if (t == PROC_CMD)
214    {
215      IDPROC(h)->language=LANG_NONE;
216    }
217    else if (t == PACKAGE_CMD)
218    {
219      IDPACKAGE(h)->language=LANG_NONE;
220      IDPACKAGE(h)->loaded = FALSE;
221    }
222  }
223  // --------------------------------------------------------
224  return  h;
225}
226
227char * idrec::String()
228{
229  sleftv tmp;
230  memset(&tmp,0,sizeof(sleftv));
231  tmp.rtyp=IDTYP(this);
232  tmp.data=IDDATA(this);
233  tmp.name=IDID(this);
234  return tmp.String();
235}
236
237idhdl enterid(const char * s, int lev, int t, idhdl* root, BOOLEAN init, BOOLEAN search)
238{
239  if (s==NULL) return NULL;
240  idhdl h;
241  s=omStrDup(s);
242  // is it already defined in root ?
243  if ((h=(*root)->get(s,lev))!=NULL)
244  {
245    if (IDLEV(h)==lev)
246    {
247      if ((IDTYP(h) == t)||(t==DEF_CMD))
248      {
249        if ((IDTYP(h)==PACKAGE_CMD)
250        && (strcmp(s,"Top")==0))
251        {
252          goto errlabel;
253        }
254        if (BVERBOSE(V_REDEFINE))
255          Warn("redefining %s **",s);
256        if (s==IDID(h)) IDID(h)=NULL;
257        killhdl2(h,root,currRing);
258      }
259      else
260        goto errlabel;
261    }
262  }
263  // is it already defined in currRing->idroot ?
264  else if (search && (currRing!=NULL)&&((*root) != currRing->idroot))
265  {
266    if ((h=currRing->idroot->get(s,lev))!=NULL)
267    {
268      if (IDLEV(h)==lev)
269      {
270        if ((IDTYP(h) == t)||(t==DEF_CMD))
271        {
272          if (BVERBOSE(V_REDEFINE))
273            Warn("redefining %s **",s);
274          IDID(h)=NULL;
275          killhdl2(h,&currRing->idroot,currRing);
276        }
277        else
278          goto errlabel;
279      }
280    }
281  }
282  // is it already defined in idroot ?
283  else if (search && (*root != IDROOT))
284  {
285    if ((h=IDROOT->get(s,lev))!=NULL)
286    {
287      if (IDLEV(h)==lev)
288      {
289        if ((IDTYP(h) == t)||(t==DEF_CMD))
290        {
291          if (BVERBOSE(V_REDEFINE))
292            Warn("redefining `%s` **",s);
293          if (s==IDID(h)) IDID(h)=NULL;
294          killhdl2(h,&IDROOT,NULL);
295        }
296        else
297          goto errlabel;
298      }
299    }
300  }
301  *root = (*root)->set(s, lev, t, init);
302#ifndef NDEBUG
303  checkall();
304#endif
305  return *root;
306
307  errlabel:
308    //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
309    Werror("identifier `%s` in use",s);
310    //listall();
311    omFree((ADDRESS)s);
312    return NULL;
313}
314void killid(const char * id, idhdl * ih)
315{
316  if (id!=NULL)
317  {
318    idhdl h = (*ih)->get(id,myynest);
319
320    // id not found in global list, is it defined in current ring ?
321    if (h==NULL)
322    {
323      if ((currRing!=NULL) && (*ih != (currRing->idroot)))
324      {
325        h = currRing->idroot->get(id,myynest);
326        if (h!=NULL)
327        {
328          killhdl2(h,&(currRing->idroot),currRing);
329          return;
330        }
331      }
332      Werror("`%s` is not defined",id);
333      return;
334    }
335    killhdl2(h,ih,currRing);
336  }
337  else
338    Werror("kill what ?");
339}
340
341void killhdl(idhdl h, package proot)
342{
343  int t=IDTYP(h);
344  if (((BEGIN_RING<t) && (t<END_RING) && (t!=QRING_CMD))
345  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
346    killhdl2(h,&currRing->idroot,currRing);
347  else
348  {
349    if(t==PACKAGE_CMD)
350    {
351      killhdl2(h,&(basePack->idroot),NULL);
352    }
353    else
354    {
355      idhdl s=proot->idroot;
356      while ((s!=h) && (s!=NULL)) s=s->next;
357      if (s!=NULL)
358        killhdl2(h,&(proot->idroot),NULL);
359      else if (basePack!=proot)
360      {
361        idhdl s=basePack->idroot;
362        while ((s!=h) && (s!=NULL)) s=s->next;
363        if (s!=NULL)
364          killhdl2(h,&(basePack->idroot),currRing);
365        else
366          killhdl2(h,&(currRing->idroot),currRing);
367       }
368    }
369  }
370}
371
372void killhdl2(idhdl h, idhdl * ih, ring r)
373{
374  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
375  idhdl hh;
376
377  if (h->attribute!=NULL)
378  {
379    //h->attribute->killAll(r); MEMORY LEAK!
380    h->attribute=NULL;
381  }
382  if (IDTYP(h) == PACKAGE_CMD)
383  {
384    if (strcmp(IDID(h),"Top")==0)
385    {
386      WarnS("can not kill `Top`");
387      return;
388    }
389    // any objects defined for this package ?
390    if ((IDPACKAGE(h)->ref<=0)  &&  (IDPACKAGE(h)->idroot!=NULL))
391    {
392      if (currPack==IDPACKAGE(h))
393      {
394        currPack=basePack;
395        currPackHdl=NULL;
396      }
397      idhdl * hd = &IDRING(h)->idroot;
398      idhdl  hdh = IDNEXT(*hd);
399      idhdl  temp;
400      while (hdh!=NULL)
401      {
402        temp = IDNEXT(hdh);
403        killhdl2(hdh,&(IDPACKAGE(h)->idroot),NULL);
404        hdh = temp;
405      }
406      killhdl2(*hd,hd,NULL);
407      if (IDPACKAGE(h)->libname!=NULL) omFree((ADDRESS)(IDPACKAGE(h)->libname));
408    }
409    paKill(IDPACKAGE(h));
410    if (currPackHdl==h) currPackHdl=packFindHdl(currPack);
411    iiCheckPack(currPack);
412  }
413  else if ((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
414    rKill(h);
415  else
416    s_internalDelete(IDTYP(h),IDDATA(h),r);
417  //  general  -------------------------------------------------------------
418  // now dechain it and delete idrec
419  if (IDID(h)!=NULL) // OB: ?????
420    omFree((ADDRESS)IDID(h));
421  IDID(h)=NULL;
422  IDDATA(h)=NULL;
423  if (h == (*ih))
424  {
425    // h is at the beginning of the list
426    *ih = IDNEXT(h) /* ==*ih */;
427  }
428  else if (ih!=NULL)
429  {
430    // h is somethere in the list:
431    hh = *ih;
432    loop
433    {
434      if (hh==NULL)
435      {
436        PrintS(">>?<< not found for kill\n");
437        return;
438      }
439      idhdl hhh = IDNEXT(hh);
440      if (hhh == h)
441      {
442        IDNEXT(hh) = IDNEXT(hhh);
443        break;
444      }
445      hh = hhh;
446    }
447  }
448  omFreeBin((ADDRESS)h, idrec_bin);
449}
450
451idhdl ggetid(const char *n, BOOLEAN local, idhdl *packhdl)
452{
453  idhdl h = IDROOT->get(n,myynest);
454  idhdl h2=NULL;
455  *packhdl = NULL;
456  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
457  {
458    h2 = currRing->idroot->get(n,myynest);
459  }
460  if (h2==NULL) return h;
461  return h2;
462}
463
464idhdl ggetid(const char *n)
465{
466  idhdl h = IDROOT->get(n,myynest);
467  if ((h!=NULL)&&(IDLEV(h)==myynest)) return h;
468  idhdl h2=NULL;
469  if (currRing!=NULL)
470  {
471    h2 = currRing->idroot->get(n,myynest);
472  }
473  if (h2!=NULL) return h2;
474  if (h!=NULL) return h;
475  if (basePack!=currPack)
476    return basePack->idroot->get(n,myynest);
477  return NULL;
478}
479
480void ipListFlag(idhdl h)
481{
482  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
483#ifdef HAVE_PLURAL
484  if (hasFlag(h,FLAG_TWOSTD)) PrintS(" (2SB)");
485#endif
486}
487
488lists ipNameList(idhdl root)
489{
490  idhdl h=root;
491  /* compute the length */
492  int l=0;
493  while (h!=NULL) { l++; h=IDNEXT(h); }
494  /* allocate list */
495  lists L=(lists)omAllocBin(slists_bin);
496  L->Init(l);
497  /* copy names */
498  h=root;
499  l=0;
500  while (h!=NULL)
501  {
502    /* list is initialized with 0 => no need to clear anything */
503    L->m[l].rtyp=STRING_CMD;
504    L->m[l].data=omStrDup(IDID(h));
505    l++;
506    h=IDNEXT(h);
507  }
508  return L;
509}
510
511/*
512* move 'tomove' from root1 list to root2 list
513*/
514static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
515{
516  idhdl h;
517  /* search 'tomove' in root2 : if found -> do nothing */
518  h=root2;
519  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
520  if (h!=NULL) return FALSE; /*okay */
521  /* search predecessor of h in root1, remove 'tomove' */
522  h=root1;
523  if (tomove==h)
524  {
525    root1=IDNEXT(h);
526  }
527  else
528  {
529    while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
530    if (h==NULL) return TRUE; /* not in the list root1 -> do nothing */
531    IDNEXT(h)=IDNEXT(tomove);
532  }
533  /* add to root2 list */
534  IDNEXT(tomove)=root2;
535  root2=tomove;
536  return FALSE;
537}
538
539void  ipMoveId(idhdl tomove)
540{
541  if ((currRing!=NULL)&&(tomove!=NULL))
542  {
543    if (((QRING_CMD!=IDTYP(tomove)) && RingDependend(IDTYP(tomove)))
544    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
545    {
546      /*move 'tomove' to ring id's*/
547      if (ipSwapId(tomove,IDROOT,currRing->idroot))
548      ipSwapId(tomove,basePack->idroot,currRing->idroot);
549    }
550    else
551    {
552      /*move 'tomove' to global id's*/
553      ipSwapId(tomove,currRing->idroot,IDROOT);
554    }
555  }
556}
557
558const char * piProcinfo(procinfov pi, const char *request)
559{
560  if(pi == NULL) return "empty proc";
561  else if (strcmp(request, "libname")  == 0) return pi->libname;
562  else if (strcmp(request, "procname") == 0) return pi->procname;
563  else if (strcmp(request, "type")     == 0)
564  {
565    switch (pi->language)
566    {
567      case LANG_SINGULAR: return "singular"; break;
568      case LANG_C:        return "object";   break;
569      case LANG_NONE:     return "none";     break;
570      default:            return "unknow language";
571    }
572  }
573  else if (strcmp(request, "ref")      == 0)
574  {
575    char p[8];
576    sprintf(p, "%d", pi->ref);
577    return omStrDup(p);  // MEMORY-LEAK
578  }
579  return "??";
580}
581
582void piCleanUp(procinfov pi)
583{
584  (pi->ref)--;
585  if (pi->ref <= 0)
586  {
587    if (pi->libname != NULL) // OB: ????
588      omFree((ADDRESS)pi->libname);
589    if (pi->procname != NULL) // OB: ????
590      omFree((ADDRESS)pi->procname);
591
592    if( pi->language == LANG_SINGULAR)
593    {
594      if (pi->data.s.body != NULL) // OB: ????
595        omFree((ADDRESS)pi->data.s.body);
596    }
597    if( pi->language == LANG_C)
598    {
599    }
600    memset((void *) pi, 0, sizeof(procinfo));
601    pi->language=LANG_NONE;
602  }
603}
604
605BOOLEAN piKill(procinfov pi)
606{
607  Voice *p=currentVoice;
608  while (p!=NULL)
609  {
610    if (p->pi==pi && pi->ref <= 1)
611    {
612      Warn("`%s` in use, can not be killed",pi->procname);
613      return TRUE;
614    }
615    p=p->next;
616  }
617  piCleanUp(pi);
618  if (pi->ref <= 0)
619    omFreeBin((ADDRESS)pi,  procinfo_bin);
620  return FALSE;
621}
622
623void paCleanUp(package pack)
624{
625  (pack->ref)--;
626  if (pack->ref < 0)
627  {
628#ifndef HAVE_STATIC
629    if( pack->language == LANG_C)
630    {
631      Print("//dlclose(%s)\n",pack->libname);
632#ifdef HAVE_DYNAMIC_LOADING
633      dynl_close (pack->handle);
634#endif /* HAVE_DYNAMIC_LOADING */
635    }
636#endif /* HAVE_STATIC */
637    omfree((ADDRESS)pack->libname);
638    memset((void *) pack, 0, sizeof(sip_package));
639    pack->language=LANG_NONE;
640  }
641}
642
643void proclevel::push(char *n)
644{
645  //Print("push %s\n",n);
646  proclevel *p=(proclevel*)omAlloc0(sizeof(proclevel));
647  p->cRing=currRing;
648  p->cRingHdl=currRingHdl;
649  p->name=n;
650  p->cPackHdl=currPackHdl;
651  p->cPack=currPack;
652  p->next=this;
653  procstack=p;
654}
655void proclevel::pop()
656{
657  //Print("pop %s\n",name);
658  //if (currRing!=::currRing) PrintS("currRing wrong\n");;
659  //::currRing=this->currRing;
660  //if (r==NULL) Print("set ring to NULL at lev %d(%s)\n",myynest,name);
661  //::currRingHdl=this->currRingHdl;
662  //if((::currRingHdl==NULL)||(IDRING(::currRingHdl)!=(::currRing)))
663  //  ::currRingHdl=rFindHdl(::currRing,NULL,NULL);
664  //Print("restore pack=%s,1.obj=%s\n",IDID(currPackHdl),IDID(currPack->idroot));
665  currPackHdl=this->cPackHdl;
666  currPack=this->cPack;
667  iiCheckPack(currPack);
668  proclevel *p=this;
669  procstack=next;
670  omFreeSize(p,sizeof(proclevel));
671}
672
673idhdl packFindHdl(package r)
674{
675  idhdl h=basePack->idroot;
676  while (h!=NULL)
677  {
678    if ((IDTYP(h)==PACKAGE_CMD)
679        && (IDPACKAGE(h)==r))
680      return h;
681    h=IDNEXT(h);
682  }
683  return NULL;
684}
Note: See TracBrowser for help on using the repository browser.