My Project
Loading...
Searching...
No Matches
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"
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"
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
57VAR package currPack = NULL;
58VAR package basePack = NULL;
60
61void paCleanUp(package pack);
62
63/*0 implementation*/
64
65static inline long iiS2I(const char *s)
66{
67 long l;
68 strncpy((char*)&l,s,SIZEOF_LONG);
69 return l;
70}
71
72idhdl 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
104idhdl 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
140void *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}
237idhdl 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))
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
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
279idhdl 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 if((t!=PROC_CMD)||(IDPROC(h)->language!=LANG_C))
318 {
319 killhdl2(h,root,currRing);
320 }
321 }
322 }
323 else
324 goto errlabel;
325 }
326 // is it already defined in currRing->idroot ?
327 else if (search && (currRing!=NULL)&&((*root) != currRing->idroot))
328 {
329 if ((h=currRing->idroot->get_level(s,lev))!=NULL)
330 {
331 if ((IDTYP(h) == t)||(t==DEF_CMD))
332 {
333 if (BVERBOSE(V_REDEFINE))
334 {
335 const char *f=VoiceName();
336 if (strcmp(f,"STDIN")==0)
337 Warn("redefining %s (%s)",s,my_yylinebuf);
338 else
339 Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
340 }
341 if (s==IDID(h)) IDID(h)=NULL;
342 // proc is not ring-dep, no need to check for type "proc":
343 killhdl2(h,&currRing->idroot,currRing);
344 }
345 else
346 goto errlabel;
347 }
348 }
349 // is it already defined in idroot ?
350 else if (search && (*root != IDROOT))
351 {
352 if ((h=IDROOT->get_level(s,lev))!=NULL)
353 {
354 if ((IDTYP(h) == t)||(t==DEF_CMD))
355 {
356 if (BVERBOSE(V_REDEFINE))
357 {
358 const char *f=VoiceName();
359 if (strcmp(f,"STDIN")==0)
360 Warn("redefining %s (%s)",s,my_yylinebuf);
361 else
362 Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
363 }
364 if (s==IDID(h)) IDID(h)=NULL;
365 if((t!=PROC_CMD)||(IDPROC(h)->language!=LANG_C))
366 {
368 }
369 }
370 else
371 goto errlabel;
372 }
373 }
374 *root = (*root)->set(s, lev, t, init);
375#ifndef SING_NDEBUG
376 checkall();
377#endif
378 return *root;
379
380 errlabel:
381 //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
382 Werror("identifier `%s` in use",s);
383 //listall();
385 return NULL;
386}
387void killid(const char * id, idhdl * ih)
388{
389 if (id!=NULL)
390 {
391 idhdl h = (*ih)->get(id,myynest);
392
393 // id not found in global list, is it defined in current ring ?
394 if (h==NULL)
395 {
396 if ((currRing!=NULL) && (*ih != (currRing->idroot)))
397 {
398 h = currRing->idroot->get(id,myynest);
399 if (h!=NULL)
400 {
401 killhdl2(h,&(currRing->idroot),currRing);
402 return;
403 }
404 }
405 Werror("`%s` is not defined",id);
406 return;
407 }
408 killhdl2(h,ih,currRing);
409 }
410 else
411 WerrorS("kill what ?");
412}
413
414void killhdl(idhdl h, package proot)
415{
416 int t=IDTYP(h);
417 if (((BEGIN_RING<t) && (t<END_RING))
418 || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
419 killhdl2(h,&currRing->idroot,currRing);
420 else
421 {
422 if(t==PACKAGE_CMD)
423 {
424 killhdl2(h,&(basePack->idroot),NULL);
425 }
426 else
427 {
428 idhdl s=proot->idroot;
429 while ((s!=h) && (s!=NULL)) s=s->next;
430 if (s!=NULL)
431 killhdl2(h,&(proot->idroot),NULL);
432 else if (basePack!=proot)
433 {
434 idhdl s=basePack->idroot;
435 while ((s!=h) && (s!=NULL)) s=s->next;
436 if (s!=NULL)
437 killhdl2(h,&(basePack->idroot),currRing);
438 else
439 killhdl2(h,&(currRing->idroot),currRing);
440 }
441 }
442 }
443}
444
445void killhdl2(idhdl h, idhdl * ih, ring r)
446{
447 //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
448 idhdl hh;
449
451 && (IDLEV(h)!=myynest)
452 &&(IDLEV(h)==0))
453 {
454 if (((*ih)==basePack->idroot)
455 || ((currRing!=NULL)&&((*ih)==currRing->idroot)))
456 Warn("kill global `%s` at line >>%s<<\n",IDID(h),my_yylinebuf);
457 }
458 if (h->attribute!=NULL)
459 {
460 if ((IDTYP(h)==RING_CMD)&&(IDRING(h)!=r))
461 h->attribute->killAll(IDRING(h));
462 else
463 h->attribute->killAll(r);
464 h->attribute=NULL;
465 }
466 if (IDTYP(h) == PACKAGE_CMD)
467 {
468 if ((((IDPACKAGE(h)->language==LANG_C) ||(IDPACKAGE(h)->language==LANG_MIX))
469 &&(IDPACKAGE(h)->idroot!=NULL))
470 || (strcmp(IDID(h),"Top")==0))
471 {
472 Warn("cannot kill `%s`",IDID(h));
473 return;
474 }
475 // any objects defined for this package ?
476 if ((IDPACKAGE(h)->ref<=0) && (IDPACKAGE(h)->idroot!=NULL))
477 {
478 if (currPack==IDPACKAGE(h))
479 {
482 }
483 idhdl * hd = &IDRING(h)->idroot;
484 idhdl hdh = IDNEXT(*hd);
485 idhdl temp;
486 while (hdh!=NULL)
487 {
488 temp = IDNEXT(hdh);
489 killhdl2(hdh,&(IDPACKAGE(h)->idroot),NULL);
490 hdh = temp;
491 }
492 killhdl2(*hd,hd,NULL);
493 if (IDPACKAGE(h)->libname!=NULL) omFreeBinAddr((ADDRESS)(IDPACKAGE(h)->libname));
494 }
498 }
499 else if (IDTYP(h)==RING_CMD)
500 rKill(h);
501 else if (IDDATA(h)!=NULL)
503 IDDATA(h)=NULL;
504 // general -------------------------------------------------------------
505 // now dechain it and delete idrec
506 if (IDID(h)!=NULL) // OB: ?????
508 IDID(h)=NULL;
509 IDDATA(h)=NULL;
510 if (h == (*ih))
511 {
512 // h is at the beginning of the list
513 *ih = IDNEXT(h) /* ==*ih */;
514 }
515 else if (ih!=NULL)
516 {
517 // h is somethere in the list:
518 hh = *ih;
519 loop
520 {
521 if (hh==NULL)
522 {
523 PrintS(">>?<< not found for kill\n");
524 return;
525 }
526 idhdl hhh = IDNEXT(hh);
527 if (hhh == h)
528 {
529 IDNEXT(hh) = IDNEXT(hhh);
530 break;
531 }
532 hh = hhh;
533 }
534 }
536}
537
538#if 0
539idhdl ggetid(const char *n, BOOLEAN /*local*/, idhdl *packhdl)
540{
541 idhdl h = IDROOT->get(n,myynest);
542 idhdl h2=NULL;
543 *packhdl = NULL;
544 if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
545 {
546 h2 = currRing->idroot->get(n,myynest);
547 }
548 if (h2==NULL) return h;
549 return h2;
550}
551#endif
552
553#if 0
554// debug version
555idhdl ggetid(const char *n)
556{
557 if (currRing!=NULL)
558 {
559 idhdl h2 = currRing->idroot->get(n,myynest);
560 idhdl h = IDROOT->get(n,myynest);
561 if ((h!=NULL)&&(h2!=NULL)&&(IDLEV(h)==IDLEV(h2)))
562 {
563 Warn("SHADOW %s(%s) vs %s(%s) in %s\n",IDID(h),Tok2Cmdname(IDTYP(h)),IDID(h2),Tok2Cmdname(IDTYP(h2)),my_yylinebuf);
564 }
565 if ((h2!=NULL)&&(IDLEV(h2)==myynest)) return h2;
566 if (h!=NULL) return h;
567 if (h2!=NULL) return h2;
568 }
569 else
570 {
571 idhdl h = IDROOT->get(n,myynest);
572 if (h!=NULL) return h;
573 }
574 if (basePack!=currPack)
575 return basePack->idroot->get(n,myynest);
576 return NULL;
577}
578#endif
579#if 1
580// try currRing before non-ring stuff
581idhdl ggetid(const char *n)
582{
583 if (currRing!=NULL)
584 {
585 idhdl h2 = currRing->idroot->get(n,myynest);
586 if ((h2!=NULL)&&(IDLEV(h2)==myynest)) return h2;
587 idhdl h = IDROOT->get(n,myynest);
588 if (h!=NULL) return h;
589 if (h2!=NULL) return h2;
590 }
591 else
592 {
593 idhdl h = IDROOT->get(n,myynest);
594 if (h!=NULL) return h;
595 }
596 if (basePack!=currPack)
597 return basePack->idroot->get(n,myynest);
598 return NULL;
599}
600#endif
601#if 0
602// try non-ring stuff before ring stuff
603idhdl ggetid(const char *n)
604{
605 idhdl h = IDROOT->get(n,myynest);
606 if ((h!=NULL)&&(IDLEV(h)==myynest)) return h;
607 if (currRing!=NULL)
608 {
609 idhdl h2 = currRing->idroot->get(n,myynest);
610 if (h2!=NULL) return h2;
611 }
612 if (h!=NULL) return h;
613 if (basePack!=currPack)
614 return basePack->idroot->get(n,myynest);
615 return NULL;
616}
617#endif
618
620{
621 if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
622#ifdef HAVE_PLURAL
623 if (hasFlag(h,FLAG_TWOSTD)) PrintS(" (2SB)");
624#endif
625}
626
628{
629 idhdl h=root;
630 /* compute the length */
631 int l=0;
632 while (h!=NULL) { l++; h=IDNEXT(h); }
633 /* allocate list */
635 L->Init(l);
636 /* copy names */
637 h=root;
638 l=0;
639 while (h!=NULL)
640 {
641 /* list is initialized with 0 => no need to clear anything */
642 L->m[l].rtyp=STRING_CMD;
643 L->m[l].data=omStrDup(IDID(h));
644 l++;
645 h=IDNEXT(h);
646 }
647 return L;
648}
649
651{
652 idhdl h=root;
653 /* compute the length */
654 int l=0;
655 while (h!=NULL) { if (IDLEV(h)==lev) l++; h=IDNEXT(h); }
656 /* allocate list */
658 L->Init(l);
659 /* copy names */
660 h=root;
661 l=0;
662 while (h!=NULL)
663 {
664 if (IDLEV(h)==lev)
665 {
666 /* list is initialized with 0 => no need to clear anything */
667 L->m[l].rtyp=STRING_CMD;
668 L->m[l].data=omStrDup(IDID(h));
669 l++;
670 }
671 h=IDNEXT(h);
672 }
673 return L;
674}
675
676/*
677* move 'tomove' from root1 list to root2 list
678*/
679static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
680{
681 idhdl h;
682 /* search 'tomove' in root2 : if found -> do nothing */
683 h=root2;
684 while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
685 if (h!=NULL) return FALSE; /*okay */
686 /* search predecessor of h in root1, remove 'tomove' */
687 h=root1;
688 if (tomove==h)
689 {
690 root1=IDNEXT(h);
691 }
692 else
693 {
694 while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
695 if (h==NULL) return TRUE; /* not in the list root1 -> do nothing */
696 IDNEXT(h)=IDNEXT(tomove);
697 }
698 /* add to root2 list */
699 IDNEXT(tomove)=root2;
700 root2=tomove;
701 return FALSE;
702}
703
704void ipMoveId(idhdl tomove)
705{
706 if ((currRing!=NULL)&&(tomove!=NULL))
707 {
708 if (RingDependend(IDTYP(tomove))
709 || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
710 {
711 /*move 'tomove' to ring id's*/
712 if (ipSwapId(tomove,IDROOT,currRing->idroot))
713 ipSwapId(tomove,basePack->idroot,currRing->idroot);
714 }
715 else
716 {
717 /*move 'tomove' to global id's*/
718 ipSwapId(tomove,currRing->idroot,IDROOT);
719 }
720 }
721}
722
723const char * piProcinfo(procinfov pi, const char *request)
724{
725 if((pi == NULL)||(pi->language==LANG_NONE)) return "empty proc";
726 else if (strcmp(request, "libname") == 0) return pi->libname;
727 else if (strcmp(request, "procname") == 0) return pi->procname;
728 else if (strcmp(request, "type") == 0)
729 {
730 switch (pi->language)
731 {
732 case LANG_SINGULAR: return "singular"; break;
733 case LANG_C: return "object"; break;
734 case LANG_NONE: return "none"; break;
735 default: return "unknown language";
736 }
737 }
738 else if (strcmp(request, "ref") == 0)
739 {
740 char p[8];
741 sprintf(p, "%d", pi->ref);
742 return omStrDup(p); // MEMORY-LEAK
743 }
744 return "??";
745}
746
748{
749 (pi->ref)--;
750 if (pi->ref == 0)
751 {
752 if (pi->language==LANG_SINGULAR)
753 {
755 while (p!=NULL)
756 {
757 if (p->pi==pi && pi->ref <= 1)
758 {
759 Warn("`%s` in use, can not be killed",pi->procname);
760 return TRUE;
761 }
762 p=p->next;
763 }
764 }
765 if (pi->libname != NULL) // OB: ????
766 omFreeBinAddr((ADDRESS)pi->libname);
767 if (pi->procname != NULL) // OB: ????
768 omFreeBinAddr((ADDRESS)pi->procname);
769
770 if( pi->language == LANG_SINGULAR)
771 {
772 if (pi->data.s.body != NULL) // OB: ????
773 omFree((ADDRESS)pi->data.s.body);
774 }
775 if( pi->language == LANG_C)
776 {
777 }
778 memset((void *) pi, 0, sizeof(procinfo));
779 //pi->language=LANG_NONE;
781 }
782 return FALSE;
783}
784
786{
787 (pack->ref)--;
788 if (pack->ref < 0)
789 {
790 if( pack->language == LANG_C)
791 {
792 Print("//dlclose(%s)\n",pack->libname);
793#ifdef HAVE_DYNAMIC_LOADING
794 dynl_close (pack->handle);
795#endif /* HAVE_DYNAMIC_LOADING */
796 }
797 omFreeBinAddr((ADDRESS)pack->libname);
798 memset((void *) pack, 0, sizeof(sip_package));
799 pack->language=LANG_NONE;
800 }
801}
802
803void proclevel::push(char *n)
804{
805 //Print("push %s\n",n);
807 p->name=n;
808 p->cPackHdl=currPackHdl;
809 p->cPack=currPack;
810 p->next=this;
811 procstack=p;
812}
814{
815 //Print("pop %s\n",name);
816 //if (currRing!=::currRing) PrintS("currRing wrong\n");;
817 //::currRing=this->currRing;
818 //if (r==NULL) Print("set ring to NULL at lev %d(%s)\n",myynest,name);
819 //::currRingHdl=this->currRingHdl;
820 //if((::currRingHdl==NULL)||(IDRING(::currRingHdl)!=(::currRing)))
821 // ::currRingHdl=rFindHdl(::currRing,NULL,NULL);
822 //Print("restore pack=%s,1.obj=%s\n",IDID(currPackHdl),IDID(currPack->idroot));
823 currPackHdl=this->cPackHdl;
824 currPack=this->cPack;
826 proclevel *p=this;
828 omFreeSize(p,sizeof(proclevel));
829}
830
832{
833 idhdl h=basePack->idroot;
834 while (h!=NULL)
835 {
836 if ((IDTYP(h)==PACKAGE_CMD)
837 && (IDPACKAGE(h)==r))
838 return h;
839 h=IDNEXT(h);
840 }
841 return NULL;
842}
843
845{
846 if (iiCurrArgs==NULL)
847 {
848 Werror("not enough arguments for proc %s",VoiceName());
849 p->CleanUp();
850 return TRUE;
851 }
853 iiCurrArgs=h->next;
854 h->next=NULL;
855 if (h->rtyp!=IDHDL)
856 {
858 h->CleanUp();
860 return res;
861 }
862 if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
863 {
864 WerrorS("type mismatch");
865 return TRUE;
866 }
867 idhdl pp=(idhdl)p->data;
868 switch(pp->typ)
869 {
870 case CRING_CMD:
872 break;
873 case DEF_CMD:
874 case INT_CMD:
875 break;
876 case INTVEC_CMD:
877 case INTMAT_CMD:
878 delete IDINTVEC(pp);
879 break;
880 case NUMBER_CMD:
882 break;
883 case BIGINT_CMD:
885 break;
886 case MAP_CMD:
887 {
888 map im = IDMAP(pp);
889 omFreeBinAddr((ADDRESS)im->preimage);
890 im->preimage=NULL;// and continue
891 }
892 // continue as ideal:
893 case IDEAL_CMD:
894 case MODUL_CMD:
895 case MATRIX_CMD:
897 break;
898 case PROC_CMD:
899 case RESOLUTION_CMD:
900 case STRING_CMD:
902 break;
903 case LIST_CMD:
904 IDLIST(pp)->Clean();
905 break;
906 case LINK_CMD:
908 break;
909 // case ring: cannot happen
910 default:
911 Werror("unknown type %d",p->Typ());
912 return TRUE;
913 }
914 pp->typ=ALIAS_CMD;
915 IDDATA(pp)=(char*)h->data;
916 int eff_typ=h->Typ();
917 if ((RingDependend(eff_typ))
918 || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
919 {
920 ipSwapId(pp,IDROOT,currRing->idroot);
921 }
922 h->CleanUp();
924 return FALSE;
925}
926
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:813
void push(char *)
Definition: ipid.cc:803
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:452
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:535
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:568
static BOOLEAN pa(leftv res, leftv args)
Definition: cohomo.cc:3723
#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:49
const char * VoiceName()
Definition: fevoices.cc:58
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
static int RingDependend(int t)
Definition: gentable.cc:28
#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
lists ipNameListLev(idhdl root, int lev)
Definition: ipid.cc:650
VAR omBin sip_package_bin
Definition: ipid.cc:46
void paCleanUp(package pack)
Definition: ipid.cc:785
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:679
void killid(const char *id, idhdl *ih)
Definition: ipid.cc:387
idhdl ggetid(const char *n)
Definition: ipid.cc:581
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:445
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
VAR omBin idrec_bin
Definition: ipid.cc:48
void ipListFlag(idhdl h)
Definition: ipid.cc:619
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:844
void killhdl(idhdl h, package proot)
Definition: ipid.cc:414
void * idrecDataInit(int t)
Definition: ipid.cc:140
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:831
VAR idhdl basePackHdl
Definition: ipid.cc:56
lists ipNameList(idhdl root)
Definition: ipid.cc:627
void ipMoveId(idhdl tomove)
Definition: ipid.cc:704
BOOLEAN piKill(procinfov pi)
Definition: ipid.cc:747
const char * piProcinfo(procinfov pi, const char *request)
Definition: ipid.cc:723
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 IDPROC(a)
Definition: ipid.h:140
#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:1630
void rKill(ring r)
Definition: ipshell.cc:6180
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:222
#define assume(x)
Definition: mod2.h:389
int dynl_close(void *handle)
Definition: mod_raw.cc:170
slists * lists
Definition: mpr_numeric.h:146
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:35
#define TEST_V_ALLWARN
Definition: options.h:144
#define Sy_bit(x)
Definition: options.h:31
#define V_REDEFINE
Definition: options.h:45
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Compatibility 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_MIX
Definition: subexpr.h:22
@ LANG_C
Definition: subexpr.h:22
#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