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