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