source: git/Singular/ipid.cc @ 26c8e6

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