My Project
ipid.cc
Go to the documentation of this file.
1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 
5 /*
6 * ABSTRACT: identfier handling
7 */
8 
9 
10 
11 
12 
13 #include "kernel/mod2.h"
14 
15 #include "misc/options.h"
16 #include "misc/intvec.h"
17 
18 #include "coeffs/numbers.h"
19 #include "coeffs/bigintmat.h"
20 
21 #include "polys/matpol.h"
22 #include "polys/monomials/ring.h"
23 
24 #include "kernel/polys.h"
25 #include "kernel/ideals.h"
26 #include "kernel/GBEngine/syz.h"
27 
28 #include "Singular/tok.h"
29 #include "Singular/ipshell.h"
30 #include "Singular/fevoices.h"
31 #include "Singular/lists.h"
32 #include "Singular/attrib.h"
33 #include "Singular/links/silink.h"
34 #include "Singular/ipid.h"
35 #include "Singular/blackbox.h"
36 #include "Singular/number2.h"
37 
38 #ifdef SINGULAR_4_2
39 #include "Singular/number2.h"
40 #endif
41 #ifdef HAVE_DYNAMIC_LOADING
42 #include "polys/mod_raw.h"
43 #endif /* HAVE_DYNAMIC_LOADING */
44 
47 //omBin ip_package_bin = omGetSpecBin(sizeof(ip_package));
49 
51 
53 //idhdl idroot = NULL;
54 
57 VAR package currPack = NULL;
58 VAR package basePack = NULL;
60 
61 void paCleanUp(package pack);
62 
63 /*0 implementation*/
64 
65 static inline long iiS2I(const char *s)
66 {
67  long l;
68  strncpy((char*)&l,s,SIZEOF_LONG);
69  return l;
70 }
71 
72 idhdl idrec::get(const char * s, int level)
73 {
74  assume(s!=NULL);
75  assume((level>=0) && (level<=1000)); //not really, but if it isnt in that bounds..
76  idhdl h = this;
78  int l;
79  const char *id_;
80  unsigned long i=iiS2I(s);
81  char *dummy=(char*)&i;
82  BOOLEAN less4=(dummy[SIZEOF_LONG-1]=='\0');
83  while (h!=NULL)
84  {
86  l=IDLEV(h);
87  if ((l==0)||(l==level))
88  {
89  if (i==h->id_i)
90  {
91  id_=IDID(h);
92  if (less4 || (0 == strcmp(s+SIZEOF_LONG,id_+SIZEOF_LONG)))
93  {
94  if(l==level) return h;
95  found=h;
96  }
97  }
98  }
99  h = IDNEXT(h);
100  }
101  return found;
102 }
103 
104 idhdl idrec::get_level(const char * s, int level)
105 {
106  assume(s!=NULL);
107  assume((level>=0) && (level<=1000)); //not really, but if it isnt in that bounds..
108  idhdl h = this;
109  int l;
110  const char *id_;
111  unsigned long i=iiS2I(s);
112  int less4=(i < (1L<<((SIZEOF_LONG-1)*8)));
113  while (h!=NULL)
114  {
116  l=IDLEV(h);
117  if ((l==level)&&(i==h->id_i))
118  {
119  id_=IDID(h);
120  if (less4 || (0 == strcmp(s+SIZEOF_LONG,id_+SIZEOF_LONG)))
121  {
122  return h;
123  }
124  }
125  h = IDNEXT(h);
126  }
127  return NULL;
128 }
129 
130 //idrec::~idrec()
131 //{
132 // if (id!=NULL)
133 // {
134 // omFree((ADDRESS)id);
135 // id=NULL;
136 // }
137 // /* much more !! */
138 //}
139 
140 void *idrecDataInit(int t)
141 {
142  switch (t)
143  {
144  //the type with init routines:
145 #ifdef SINGULAR_4_2
146  case CNUMBER_CMD:
147  return (void*)n2Init(0,NULL);
148  case CPOLY_CMD:
149  return (void*)p2Init(0,NULL);
150  case CMATRIX_CMD:
151 #endif
152  case BIGINTMAT_CMD:
153  return (void *)new bigintmat();
154  case BUCKET_CMD:
155  if (currRing!=NULL)
156  return (void*)sBucketCreate(currRing);
157  else
158  {
159  WerrorS("need basering for polyBucket");
160  return NULL;
161  }
162  case INTVEC_CMD:
163  case INTMAT_CMD:
164  return (void *)new intvec();
165  case NUMBER_CMD:
166  {
167  if (currRing!=NULL) return (void *) nInit(0);
168  else return NULL;
169  }
170  case BIGINT_CMD:
171  return (void *) n_Init(0, coeffs_BIGINT);
172  case IDEAL_CMD:
173  case MODUL_CMD:
174  case MATRIX_CMD:
175  case SMATRIX_CMD:
176  return (void*) idInit(1,1);
177  case MAP_CMD:
178  {
179  map m = (map)idInit(1,1);
180  m->preimage = omStrDup(IDID(currRingHdl));
181  return (void *)m;
182  }
183  case STRING_CMD:
184  return (void *)omAlloc0(1);
185  case LIST_CMD:
186  {
188  l->Init();
189  return (void*)l;
190  }
191  //the types with the standard init: set the struct to zero
192  case LINK_CMD:
193  return (void*) omAlloc0Bin(sip_link_bin);
194  case PACKAGE_CMD:
195  {
196  package pa=(package)omAlloc0Bin(sip_package_bin);
197  pa->language=LANG_NONE;
198  pa->loaded = FALSE;
199  return (void*)pa;
200  }
201  case PROC_CMD:
202  {
204  pi->ref=1;
205  pi->language=LANG_NONE;
206  return (void*)pi;
207  }
208  case RESOLUTION_CMD:
209  return (void *)omAlloc0(sizeof(ssyStrategy));
210  //other types: without alloc. (int,script,poly,def,package,..)
211  case INT_CMD:
212  case DEF_CMD:
213  case POLY_CMD:
214  case VECTOR_CMD:
215  case RING_CMD:
216  case CRING_CMD:
217  case QRING_CMD:
218  return NULL;
219  default:
220  {
221  if (t>MAX_TOK)
222  {
223 #ifdef BLACKBOX_DEVEL
224  Print("bb-type %d\n",t);
225 #endif
226  blackbox *bb=getBlackboxStuff(t);
227  if (bb!=NULL)
228  return (void *)bb->blackbox_Init(bb);
229  }
230  else
231  Werror("unknown type in idrecDataInit:%d",t);
232  break;
233  }
234  }
235  return (void *)0L;
236 }
237 idhdl idrec::set(const char * s, int level, int t, BOOLEAN init)
238 {
239  //printf("define %s, %x, level: %d, typ: %d\n", s,s,level,t);
241  IDID(h) = s;
242  IDTYP(h) = t;
243  IDLEV(h) = level;
244  IDNEXT(h) = this;
245  BOOLEAN at_start=(this==IDROOT);
246  h->id_i=iiS2I(s);
247  if (t==BUCKET_CMD) WarnS("defining polyBucket");
248  if (init)
249  {
250  if ((t==IDEAL_CMD)||(t==MODUL_CMD))
251  IDFLAG(h) = Sy_bit(FLAG_STD);
252  IDSTRING(h)=(char *)idrecDataInit(t);
253  // additional settings:--------------------------------------
254 #if 0
255  // this leads to a memory leak
256  if (t == QRING_CMD)
257  {
258  // IDRING(h)=rCopy(currRing);
259  /* QRING_CMD is ring dep => currRing !=NULL */
260  }
261 #endif
262  }
263  // --------------------------------------------------------
264  if (at_start)
265  IDNEXT(h) = IDROOT;
266  return h;
267 }
268 
269 char * idrec::String(BOOLEAN typed)
270 {
271  sleftv tmp;
272  tmp.Init();
273  tmp.rtyp=IDTYP(this);
274  tmp.data=IDDATA(this);
275  tmp.name=IDID(this);
276  return tmp.String(NULL, typed);
277 }
278 
279 idhdl enterid(const char * s, int lev, int t, idhdl* root, BOOLEAN init, BOOLEAN search)
280 {
281  if (s==NULL) return NULL;
282  if (root==NULL) return NULL;
283  idhdl h;
284  s=omStrDup(s);
285  // idhdl *save_root=root;
286  if (t==PACKAGE_CMD)
287  {
288  if (root!=&(basePack->idroot))
289  {
290  root=&(basePack->idroot);
291  }
292  }
293  // is it already defined in root ?
294  if ((h=(*root)->get_level(s,lev))!=NULL)
295  {
296  if ((IDTYP(h) == t)||(t==DEF_CMD))
297  {
298  if (IDTYP(h)==PACKAGE_CMD)
299  {
300  if (strcmp(s,"Top")==0)
301  {
302  goto errlabel;
303  }
304  else return h;
305  }
306  else
307  {
308  if (BVERBOSE(V_REDEFINE))
309  {
310  const char *f=VoiceName();
311  if (strcmp(f,"STDIN")==0)
312  Warn("redefining %s (%s)",s,my_yylinebuf);
313  else
314  Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
315  }
316  if (s==IDID(h)) IDID(h)=NULL;
317  killhdl2(h,root,currRing);
318  }
319  }
320  else
321  goto errlabel;
322  }
323  // is it already defined in currRing->idroot ?
324  else if (search && (currRing!=NULL)&&((*root) != currRing->idroot))
325  {
326  if ((h=currRing->idroot->get_level(s,lev))!=NULL)
327  {
328  if ((IDTYP(h) == t)||(t==DEF_CMD))
329  {
330  if (BVERBOSE(V_REDEFINE))
331  {
332  const char *f=VoiceName();
333  if (strcmp(f,"STDIN")==0)
334  Warn("redefining %s (%s)",s,my_yylinebuf);
335  else
336  Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
337  }
338  if (s==IDID(h)) IDID(h)=NULL;
339  killhdl2(h,&currRing->idroot,currRing);
340  }
341  else
342  goto errlabel;
343  }
344  }
345  // is it already defined in idroot ?
346  else if (search && (*root != IDROOT))
347  {
348  if ((h=IDROOT->get_level(s,lev))!=NULL)
349  {
350  if ((IDTYP(h) == t)||(t==DEF_CMD))
351  {
352  if (BVERBOSE(V_REDEFINE))
353  {
354  const char *f=VoiceName();
355  if (strcmp(f,"STDIN")==0)
356  Warn("redefining %s (%s)",s,my_yylinebuf);
357  else
358  Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
359  }
360  if (s==IDID(h)) IDID(h)=NULL;
361  killhdl2(h,&IDROOT,NULL);
362  }
363  else
364  goto errlabel;
365  }
366  }
367  *root = (*root)->set(s, lev, t, init);
368 #ifndef SING_NDEBUG
369  checkall();
370 #endif
371  return *root;
372 
373  errlabel:
374  //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
375  Werror("identifier `%s` in use",s);
376  //listall();
378  return NULL;
379 }
380 void killid(const char * id, idhdl * ih)
381 {
382  if (id!=NULL)
383  {
384  idhdl h = (*ih)->get(id,myynest);
385 
386  // id not found in global list, is it defined in current ring ?
387  if (h==NULL)
388  {
389  if ((currRing!=NULL) && (*ih != (currRing->idroot)))
390  {
391  h = currRing->idroot->get(id,myynest);
392  if (h!=NULL)
393  {
394  killhdl2(h,&(currRing->idroot),currRing);
395  return;
396  }
397  }
398  Werror("`%s` is not defined",id);
399  return;
400  }
401  killhdl2(h,ih,currRing);
402  }
403  else
404  WerrorS("kill what ?");
405 }
406 
407 void killhdl(idhdl h, package proot)
408 {
409  int t=IDTYP(h);
410  if (((BEGIN_RING<t) && (t<END_RING))
411  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
412  killhdl2(h,&currRing->idroot,currRing);
413  else
414  {
415  if(t==PACKAGE_CMD)
416  {
417  killhdl2(h,&(basePack->idroot),NULL);
418  }
419  else
420  {
421  idhdl s=proot->idroot;
422  while ((s!=h) && (s!=NULL)) s=s->next;
423  if (s!=NULL)
424  killhdl2(h,&(proot->idroot),NULL);
425  else if (basePack!=proot)
426  {
427  idhdl s=basePack->idroot;
428  while ((s!=h) && (s!=NULL)) s=s->next;
429  if (s!=NULL)
430  killhdl2(h,&(basePack->idroot),currRing);
431  else
432  killhdl2(h,&(currRing->idroot),currRing);
433  }
434  }
435  }
436 }
437 
438 void killhdl2(idhdl h, idhdl * ih, ring r)
439 {
440  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
441  idhdl hh;
442 
443  if (TEST_V_ALLWARN
444  && (IDLEV(h)!=myynest)
445  &&(IDLEV(h)==0))
446  {
447  if (((*ih)==basePack->idroot)
448  || ((currRing!=NULL)&&((*ih)==currRing->idroot)))
449  Warn("kill global `%s` at line >>%s<<\n",IDID(h),my_yylinebuf);
450  }
451  if (h->attribute!=NULL)
452  {
453  if ((IDTYP(h)==RING_CMD)&&(IDRING(h)!=r))
454  h->attribute->killAll(IDRING(h));
455  else
456  h->attribute->killAll(r);
457  h->attribute=NULL;
458  }
459  if (IDTYP(h) == PACKAGE_CMD)
460  {
461  if (((IDPACKAGE(h)->language==LANG_C)&&(IDPACKAGE(h)->idroot!=NULL))
462  || (strcmp(IDID(h),"Top")==0))
463  {
464  Warn("cannot kill `%s`",IDID(h));
465  return;
466  }
467  // any objects defined for this package ?
468  if ((IDPACKAGE(h)->ref<=0) && (IDPACKAGE(h)->idroot!=NULL))
469  {
470  if (currPack==IDPACKAGE(h))
471  {
474  }
475  idhdl * hd = &IDRING(h)->idroot;
476  idhdl hdh = IDNEXT(*hd);
477  idhdl temp;
478  while (hdh!=NULL)
479  {
480  temp = IDNEXT(hdh);
481  killhdl2(hdh,&(IDPACKAGE(h)->idroot),NULL);
482  hdh = temp;
483  }
484  killhdl2(*hd,hd,NULL);
485  if (IDPACKAGE(h)->libname!=NULL) omFreeBinAddr((ADDRESS)(IDPACKAGE(h)->libname));
486  }
487  paKill(IDPACKAGE(h));
490  }
491  else if (IDTYP(h)==RING_CMD)
492  rKill(h);
493  else if (IDDATA(h)!=NULL)
495  // general -------------------------------------------------------------
496  // now dechain it and delete idrec
497  if (IDID(h)!=NULL) // OB: ?????
499  IDID(h)=NULL;
500  IDDATA(h)=NULL;
501  if (h == (*ih))
502  {
503  // h is at the beginning of the list
504  *ih = IDNEXT(h) /* ==*ih */;
505  }
506  else if (ih!=NULL)
507  {
508  // h is somethere in the list:
509  hh = *ih;
510  loop
511  {
512  if (hh==NULL)
513  {
514  PrintS(">>?<< not found for kill\n");
515  return;
516  }
517  idhdl hhh = IDNEXT(hh);
518  if (hhh == h)
519  {
520  IDNEXT(hh) = IDNEXT(hhh);
521  break;
522  }
523  hh = hhh;
524  }
525  }
527 }
528 
529 #if 0
530 idhdl ggetid(const char *n, BOOLEAN /*local*/, idhdl *packhdl)
531 {
532  idhdl h = IDROOT->get(n,myynest);
533  idhdl h2=NULL;
534  *packhdl = NULL;
535  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
536  {
537  h2 = currRing->idroot->get(n,myynest);
538  }
539  if (h2==NULL) return h;
540  return h2;
541 }
542 #endif
543 
544 #if 0
545 // debug version
546 idhdl ggetid(const char *n)
547 {
548  if (currRing!=NULL)
549  {
550  idhdl h2 = currRing->idroot->get(n,myynest);
551  idhdl h = IDROOT->get(n,myynest);
552  if ((h!=NULL)&&(h2!=NULL)&&(IDLEV(h)==IDLEV(h2)))
553  {
554  Warn("SHADOW %s(%s) vs %s(%s) in %s\n",IDID(h),Tok2Cmdname(IDTYP(h)),IDID(h2),Tok2Cmdname(IDTYP(h2)),my_yylinebuf);
555  }
556  if ((h2!=NULL)&&(IDLEV(h2)==myynest)) return h2;
557  if (h!=NULL) return h;
558  if (h2!=NULL) return h2;
559  }
560  else
561  {
562  idhdl h = IDROOT->get(n,myynest);
563  if (h!=NULL) return h;
564  }
565  if (basePack!=currPack)
566  return basePack->idroot->get(n,myynest);
567  return NULL;
568 }
569 #endif
570 #if 1
571 // try currRing before non-ring stuff
572 idhdl ggetid(const char *n)
573 {
574  if (currRing!=NULL)
575  {
576  idhdl h2 = currRing->idroot->get(n,myynest);
577  if ((h2!=NULL)&&(IDLEV(h2)==myynest)) return h2;
578  idhdl h = IDROOT->get(n,myynest);
579  if (h!=NULL) return h;
580  if (h2!=NULL) return h2;
581  }
582  else
583  {
584  idhdl h = IDROOT->get(n,myynest);
585  if (h!=NULL) return h;
586  }
587  if (basePack!=currPack)
588  return basePack->idroot->get(n,myynest);
589  return NULL;
590 }
591 #endif
592 #if 0
593 // try non-ring stuff before ring stuff
594 idhdl ggetid(const char *n)
595 {
596  idhdl h = IDROOT->get(n,myynest);
597  if ((h!=NULL)&&(IDLEV(h)==myynest)) return h;
598  if (currRing!=NULL)
599  {
600  idhdl h2 = currRing->idroot->get(n,myynest);
601  if (h2!=NULL) return h2;
602  }
603  if (h!=NULL) return h;
604  if (basePack!=currPack)
605  return basePack->idroot->get(n,myynest);
606  return NULL;
607 }
608 #endif
609 
611 {
612  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
613 #ifdef HAVE_PLURAL
614  if (hasFlag(h,FLAG_TWOSTD)) PrintS(" (2SB)");
615 #endif
616 }
617 
619 {
620  idhdl h=root;
621  /* compute the length */
622  int l=0;
623  while (h!=NULL) { l++; h=IDNEXT(h); }
624  /* allocate list */
626  L->Init(l);
627  /* copy names */
628  h=root;
629  l=0;
630  while (h!=NULL)
631  {
632  /* list is initialized with 0 => no need to clear anything */
633  L->m[l].rtyp=STRING_CMD;
634  L->m[l].data=omStrDup(IDID(h));
635  l++;
636  h=IDNEXT(h);
637  }
638  return L;
639 }
640 
641 lists ipNameListLev(idhdl root, int lev)
642 {
643  idhdl h=root;
644  /* compute the length */
645  int l=0;
646  while (h!=NULL) { if (IDLEV(h)==lev) l++; h=IDNEXT(h); }
647  /* allocate list */
649  L->Init(l);
650  /* copy names */
651  h=root;
652  l=0;
653  while (h!=NULL)
654  {
655  if (IDLEV(h)==lev)
656  {
657  /* list is initialized with 0 => no need to clear anything */
658  L->m[l].rtyp=STRING_CMD;
659  L->m[l].data=omStrDup(IDID(h));
660  l++;
661  }
662  h=IDNEXT(h);
663  }
664  return L;
665 }
666 
667 /*
668 * move 'tomove' from root1 list to root2 list
669 */
670 static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
671 {
672  idhdl h;
673  /* search 'tomove' in root2 : if found -> do nothing */
674  h=root2;
675  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
676  if (h!=NULL) return FALSE; /*okay */
677  /* search predecessor of h in root1, remove 'tomove' */
678  h=root1;
679  if (tomove==h)
680  {
681  root1=IDNEXT(h);
682  }
683  else
684  {
685  while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
686  if (h==NULL) return TRUE; /* not in the list root1 -> do nothing */
687  IDNEXT(h)=IDNEXT(tomove);
688  }
689  /* add to root2 list */
690  IDNEXT(tomove)=root2;
691  root2=tomove;
692  return FALSE;
693 }
694 
695 void ipMoveId(idhdl tomove)
696 {
697  if ((currRing!=NULL)&&(tomove!=NULL))
698  {
699  if (RingDependend(IDTYP(tomove))
700  || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
701  {
702  /*move 'tomove' to ring id's*/
703  if (ipSwapId(tomove,IDROOT,currRing->idroot))
704  ipSwapId(tomove,basePack->idroot,currRing->idroot);
705  }
706  else
707  {
708  /*move 'tomove' to global id's*/
709  ipSwapId(tomove,currRing->idroot,IDROOT);
710  }
711  }
712 }
713 
714 const char * piProcinfo(procinfov pi, const char *request)
715 {
716  if((pi == NULL)||(pi->language==LANG_NONE)) return "empty proc";
717  else if (strcmp(request, "libname") == 0) return pi->libname;
718  else if (strcmp(request, "procname") == 0) return pi->procname;
719  else if (strcmp(request, "type") == 0)
720  {
721  switch (pi->language)
722  {
723  case LANG_SINGULAR: return "singular"; break;
724  case LANG_C: return "object"; break;
725  case LANG_NONE: return "none"; break;
726  default: return "unknown language";
727  }
728  }
729  else if (strcmp(request, "ref") == 0)
730  {
731  char p[8];
732  sprintf(p, "%d", pi->ref);
733  return omStrDup(p); // MEMORY-LEAK
734  }
735  return "??";
736 }
737 
739 {
740  (pi->ref)--;
741  if (pi->ref == 0)
742  {
743  if (pi->language==LANG_SINGULAR)
744  {
746  while (p!=NULL)
747  {
748  if (p->pi==pi && pi->ref <= 1)
749  {
750  Warn("`%s` in use, can not be killed",pi->procname);
751  return TRUE;
752  }
753  p=p->next;
754  }
755  }
756  if (pi->libname != NULL) // OB: ????
757  omFreeBinAddr((ADDRESS)pi->libname);
758  if (pi->procname != NULL) // OB: ????
759  omFreeBinAddr((ADDRESS)pi->procname);
760 
761  if( pi->language == LANG_SINGULAR)
762  {
763  if (pi->data.s.body != NULL) // OB: ????
764  omFree((ADDRESS)pi->data.s.body);
765  }
766  if( pi->language == LANG_C)
767  {
768  }
769  memset((void *) pi, 0, sizeof(procinfo));
770  //pi->language=LANG_NONE;
772  }
773  return FALSE;
774 }
775 
776 void paCleanUp(package pack)
777 {
778  (pack->ref)--;
779  if (pack->ref < 0)
780  {
781  if( pack->language == LANG_C)
782  {
783  Print("//dlclose(%s)\n",pack->libname);
784 #ifdef HAVE_DYNAMIC_LOADING
785  dynl_close (pack->handle);
786 #endif /* HAVE_DYNAMIC_LOADING */
787  }
788  omFreeBinAddr((ADDRESS)pack->libname);
789  memset((void *) pack, 0, sizeof(sip_package));
790  pack->language=LANG_NONE;
791  }
792 }
793 
794 void proclevel::push(char *n)
795 {
796  //Print("push %s\n",n);
797  proclevel *p=(proclevel*)omAlloc0(sizeof(proclevel));
798  p->name=n;
799  p->cPackHdl=currPackHdl;
800  p->cPack=currPack;
801  p->next=this;
802  procstack=p;
803 }
805 {
806  //Print("pop %s\n",name);
807  //if (currRing!=::currRing) PrintS("currRing wrong\n");;
808  //::currRing=this->currRing;
809  //if (r==NULL) Print("set ring to NULL at lev %d(%s)\n",myynest,name);
810  //::currRingHdl=this->currRingHdl;
811  //if((::currRingHdl==NULL)||(IDRING(::currRingHdl)!=(::currRing)))
812  // ::currRingHdl=rFindHdl(::currRing,NULL,NULL);
813  //Print("restore pack=%s,1.obj=%s\n",IDID(currPackHdl),IDID(currPack->idroot));
814  currPackHdl=this->cPackHdl;
815  currPack=this->cPack;
817  proclevel *p=this;
818  procstack=next;
819  omFreeSize(p,sizeof(proclevel));
820 }
821 
823 {
824  idhdl h=basePack->idroot;
825  while (h!=NULL)
826  {
827  if ((IDTYP(h)==PACKAGE_CMD)
828  && (IDPACKAGE(h)==r))
829  return h;
830  h=IDNEXT(h);
831  }
832  return NULL;
833 }
834 
836 {
837  if (iiCurrArgs==NULL)
838  {
839  Werror("not enough arguments for proc %s",VoiceName());
840  p->CleanUp();
841  return TRUE;
842  }
844  iiCurrArgs=h->next;
845  h->next=NULL;
846  if (h->rtyp!=IDHDL)
847  {
849  h->CleanUp();
851  return res;
852  }
853  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
854  {
855  WerrorS("type mismatch");
856  return TRUE;
857  }
858  idhdl pp=(idhdl)p->data;
859  switch(pp->typ)
860  {
861  case CRING_CMD:
862  nKillChar((coeffs)pp);
863  break;
864  case DEF_CMD:
865  case INT_CMD:
866  break;
867  case INTVEC_CMD:
868  case INTMAT_CMD:
869  delete IDINTVEC(pp);
870  break;
871  case NUMBER_CMD:
872  nDelete(&IDNUMBER(pp));
873  break;
874  case BIGINT_CMD:
876  break;
877  case MAP_CMD:
878  {
879  map im = IDMAP(pp);
880  omFreeBinAddr((ADDRESS)im->preimage);
881  im->preimage=NULL;// and continue
882  }
883  // continue as ideal:
884  case IDEAL_CMD:
885  case MODUL_CMD:
886  case MATRIX_CMD:
887  idDelete(&IDIDEAL(pp));
888  break;
889  case PROC_CMD:
890  case RESOLUTION_CMD:
891  case STRING_CMD:
893  break;
894  case LIST_CMD:
895  IDLIST(pp)->Clean();
896  break;
897  case LINK_CMD:
899  break;
900  // case ring: cannot happen
901  default:
902  Werror("unknown type %d",p->Typ());
903  return TRUE;
904  }
905  pp->typ=ALIAS_CMD;
906  IDDATA(pp)=(char*)h->data;
907  int eff_typ=h->Typ();
908  if ((RingDependend(eff_typ))
909  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
910  {
911  ipSwapId(pp,IDROOT,currRing->idroot);
912  }
913  h->CleanUp();
915  return FALSE;
916 }
917 
int BOOLEAN
Definition: auxiliary.h:87
#define TRUE
Definition: auxiliary.h:100
#define FALSE
Definition: auxiliary.h:96
void * ADDRESS
Definition: auxiliary.h:119
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:17
CanonicalForm FACTORY_PUBLIC pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:676
int level(const CanonicalForm &f)
int l
Definition: cfEzgcd.cc:100
int m
Definition: cfEzgcd.cc:128
int i
Definition: cfEzgcd.cc:132
int p
Definition: cfModGcd.cc:4078
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:504
FILE * f
Definition: checklibs.c:9
Definition: fevoices.h:59
Matrices of numbers.
Definition: bigintmat.h:51
Definition: idrec.h:35
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
idhdl get_level(const char *s, int lev)
Definition: ipid.cc:104
idhdl set(const char *s, int lev, int t, BOOLEAN init=TRUE)
Definition: ipid.cc:237
char * String(BOOLEAN typed=FALSE)
Definition: ipid.cc:269
Definition: intvec.h:23
Definition: ipid.h:56
void pop()
Definition: ipid.cc:804
void push(char *)
Definition: ipid.cc:794
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
const char * name
Definition: subexpr.h:87
int rtyp
Definition: subexpr.h:91
void Init()
Definition: subexpr.h:107
char * String(void *d=NULL, BOOLEAN typed=FALSE, int dim=1)
Called for conversion to string (used by string(..), write(..),..)
Definition: subexpr.cc:761
void * data
Definition: subexpr.h:88
Definition: lists.h:24
sleftv * m
Definition: lists.h:46
INLINE_THIS void Init(int l=0)
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:538
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:522
BOOLEAN pa(leftv res, leftv args)
Definition: cohomo.cc:4344
#define Print
Definition: emacs.cc:80
#define Warn
Definition: emacs.cc:77
#define WarnS
Definition: emacs.cc:78
const CanonicalForm int s
Definition: facAbsFact.cc:51
CanonicalForm res
Definition: facAbsFact.cc:60
bool found
Definition: facFactorize.cc:55
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
void WerrorS(const char *s)
Definition: feFopen.cc:24
VAR int yylineno
Definition: febase.cc:40
VAR char my_yylinebuf[80]
Definition: febase.cc:44
VAR int myynest
Definition: febase.cc:41
VAR Voice * currentVoice
Definition: fevoices.cc:47
const char * VoiceName()
Definition: fevoices.cc:56
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
#define VAR
Definition: globaldefs.h:5
@ END_RING
Definition: grammar.cc:310
@ IDEAL_CMD
Definition: grammar.cc:284
@ MATRIX_CMD
Definition: grammar.cc:286
@ BUCKET_CMD
Definition: grammar.cc:283
@ BIGINTMAT_CMD
Definition: grammar.cc:278
@ MAP_CMD
Definition: grammar.cc:285
@ PROC_CMD
Definition: grammar.cc:280
@ BEGIN_RING
Definition: grammar.cc:282
@ INTMAT_CMD
Definition: grammar.cc:279
@ MODUL_CMD
Definition: grammar.cc:287
@ SMATRIX_CMD
Definition: grammar.cc:291
@ VECTOR_CMD
Definition: grammar.cc:292
@ RESOLUTION_CMD
Definition: grammar.cc:290
@ NUMBER_CMD
Definition: grammar.cc:288
@ POLY_CMD
Definition: grammar.cc:289
@ RING_CMD
Definition: grammar.cc:281
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1963
VAR omBin sip_command_bin
Definition: ipid.cc:45
const char * piProcinfo(procinfov pi, const char *request)
Definition: ipid.cc:714
lists ipNameListLev(idhdl root, int lev)
Definition: ipid.cc:641
VAR omBin sip_package_bin
Definition: ipid.cc:46
void paCleanUp(package pack)
Definition: ipid.cc:776
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:670
void killid(const char *id, idhdl *ih)
Definition: ipid.cc:380
idhdl ggetid(const char *n)
Definition: ipid.cc:572
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:438
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:279
VAR package basePack
Definition: ipid.cc:58
void * idrecDataInit(int t)
Definition: ipid.cc:140
VAR omBin idrec_bin
Definition: ipid.cc:48
void ipListFlag(idhdl h)
Definition: ipid.cc:610
VAR proclevel * procstack
Definition: ipid.cc:52
static long iiS2I(const char *s)
Definition: ipid.cc:65
VAR idhdl currRingHdl
Definition: ipid.cc:59
VAR package currPack
Definition: ipid.cc:57
BOOLEAN iiAlias(leftv p)
Definition: ipid.cc:835
void killhdl(idhdl h, package proot)
Definition: ipid.cc:407
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:822
VAR idhdl basePackHdl
Definition: ipid.cc:56
lists ipNameList(idhdl root)
Definition: ipid.cc:618
void ipMoveId(idhdl tomove)
Definition: ipid.cc:695
BOOLEAN piKill(procinfov pi)
Definition: ipid.cc:738
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
#define IDMAP(a)
Definition: ipid.h:135
#define IDSTRING(a)
Definition: ipid.h:136
#define IDNEXT(a)
Definition: ipid.h:118
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
#define IDDATA(a)
Definition: ipid.h:126
#define hasFlag(A, F)
Definition: ipid.h:112
#define IDINTVEC(a)
Definition: ipid.h:128
#define IDLINK(a)
Definition: ipid.h:138
#define IDIDEAL(a)
Definition: ipid.h:133
#define IDFLAG(a)
Definition: ipid.h:120
#define IDID(a)
Definition: ipid.h:122
#define IDROOT
Definition: ipid.h:19
#define FLAG_TWOSTD
Definition: ipid.h:107
#define IDNUMBER(a)
Definition: ipid.h:132
#define IDPACKAGE(a)
Definition: ipid.h:139
#define IDLEV(a)
Definition: ipid.h:121
void paKill(package pack)
Definition: ipid.h:50
#define IDRING(a)
Definition: ipid.h:127
#define IDTYP(a)
Definition: ipid.h:119
#define FLAG_STD
Definition: ipid.h:106
#define IDLIST(a)
Definition: ipid.h:137
void iiCheckPack(package &p)
Definition: ipshell.cc:1634
void rKill(ring r)
Definition: ipshell.cc:6174
VAR leftv iiCurrArgs
Definition: ipshell.cc:80
STATIC_VAR Poly * h
Definition: janet.cc:971
ListNode * next
Definition: janet.h:31
#define pi
Definition: libparse.cc:1145
VAR omBin slists_bin
Definition: lists.cc:23
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
#define assume(x)
Definition: mod2.h:387
int dynl_close(void *handle)
Definition: mod_raw.cc:170
slists * lists
Definition: mpr_numeric.h:146
void init()
Definition: lintree.cc:864
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nDelete(n)
Definition: numbers.h:16
#define nInit(i)
Definition: numbers.h:24
#define omStrDup(s)
Definition: omAllocDecl.h:263
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
#define omFreeBinAddr(addr)
Definition: omAllocDecl.h:258
#define omGetSpecBin(size)
Definition: omBin.h:11
#define NULL
Definition: omList.c:12
omBin_t * omBin
Definition: omStructs.h:12
#define BVERBOSE(a)
Definition: options.h:34
#define TEST_V_ALLWARN
Definition: options.h:143
#define Sy_bit(x)
Definition: options.h:31
#define V_REDEFINE
Definition: options.h:44
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Compatiblity layer for legacy polynomial operations (over currRing)
void PrintS(const char *s)
Definition: reporter.cc:284
void Werror(const char *fmt,...)
Definition: reporter.cc:189
idrec * idhdl
Definition: ring.h:21
sBucket_pt sBucketCreate(const ring r)
Definition: sbuckets.cc:96
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
ip_package * package
Definition: structs.h:43
#define loop
Definition: structs.h:75
procinfo * procinfov
Definition: structs.h:60
VAR omBin procinfo_bin
Definition: subexpr.cc:42
void s_internalDelete(const int t, void *d, const ring r)
Definition: subexpr.cc:514
@ LANG_SINGULAR
Definition: subexpr.h:22
@ LANG_NONE
Definition: subexpr.h:22
@ LANG_C
Definition: subexpr.h:22
BOOLEAN RingDependend(int t)
Definition: subexpr.h:142
#define IDHDL
Definition: tok.h:31
@ ALIAS_CMD
Definition: tok.h:34
@ BIGINT_CMD
Definition: tok.h:38
@ CRING_CMD
Definition: tok.h:56
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ PACKAGE_CMD
Definition: tok.h:149
@ CMATRIX_CMD
Definition: tok.h:46
@ DEF_CMD
Definition: tok.h:58
@ CNUMBER_CMD
Definition: tok.h:47
@ LINK_CMD
Definition: tok.h:117
@ QRING_CMD
Definition: tok.h:158
@ STRING_CMD
Definition: tok.h:185
@ CPOLY_CMD
Definition: tok.h:48
@ INT_CMD
Definition: tok.h:96
@ MAX_TOK
Definition: tok.h:218