scope.c

   1 /*    scope.c
   2  *
   3  *    Copyright (c) 1991-1997, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "For the fashion of Minas Tirith was such that it was built on seven
  12  * levels..."
  13  */
  14
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17
  18 SV**
  19 stack_grow(SV **sp, SV **p, int n)
  20 {
  21     dTHR;
  22 #if defined(DEBUGGING) && !defined(USE_THREADS)
  23     static int growing = 0;
  24     if (growing++)
  25       abort();
  26 #endif
  27     stack_sp = sp;
  28 #ifndef STRESS_REALLOC
  29     av_extend(curstack, (p - stack_base) + (n) + 128);
  30 #else
  31     av_extend(curstack, (p - stack_base) + (n) + 1);
  32 #endif
  33 #if defined(DEBUGGING) && !defined(USE_THREADS)
  34     growing--;
  35 #endif
  36     return stack_sp;
  37 }
  38
  39 #ifndef STRESS_REALLOC
  40 #define GROW(old) ((old) * 3 / 2)
  41 #else
  42 #define GROW(old) ((old) + 1)
  43 #endif
  44
  45 PERL_SI *
  46 new_stackinfo(I32 stitems, I32 cxitems)
  47 {
  48     PERL_SI *si;
  49     PERL_CONTEXT *cxt;
  50     New(56, si, 1, PERL_SI);
  51     si->si_stack = newAV();
  52     AvREAL_off(si->si_stack);
  53     av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0);
  54     AvALLOC(si->si_stack)[0] = &sv_undef;
  55     AvFILLp(si->si_stack) = 0;
  56     si->si_prev = 0;
  57     si->si_next = 0;
  58     si->si_cxmax = cxitems - 1;
  59     si->si_cxix = -1;
  60     si->si_type = SI_UNDEF;
  61     New(56, si->si_cxstack, cxitems, PERL_CONTEXT);
  62     return si;
  63 }
  64
  65 I32
  66 cxinc(void)
  67 {
  68     dTHR;
  69     cxstack_max = GROW(cxstack_max);
  70     Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);      /* XXX should fix CXINC macro */
  71     return cxstack_ix + 1;
  72 }
  73
  74 void
  75 push_return(OP *retop)
  76 {
  77     dTHR;
  78     if (retstack_ix == retstack_max) {
  79         retstack_max = GROW(retstack_max);
  80         Renew(retstack, retstack_max, OP*);
  81     }
  82     retstack[retstack_ix++] = retop;
  83 }
  84
  85 OP *
  86 pop_return(void)
  87 {
  88     dTHR;
  89     if (retstack_ix > 0)
  90         return retstack[--retstack_ix];
  91     else
  92         return Nullop;
  93 }
  94
  95 void
  96 push_scope(void)
  97 {
  98     dTHR;
  99     if (scopestack_ix == scopestack_max) {
 100         scopestack_max = GROW(scopestack_max);
 101         Renew(scopestack, scopestack_max, I32);
 102     }
 103     scopestack[scopestack_ix++] = savestack_ix;
 104
 105 }
 106
 107 void
 108 pop_scope(void)
 109 {
 110     dTHR;
 111     I32 oldsave = scopestack[--scopestack_ix];
 112     LEAVE_SCOPE(oldsave);
 113 }
 114
 115 void
 116 markstack_grow(void)
 117 {
 118     dTHR;
 119     I32 oldmax = markstack_max - markstack;
 120     I32 newmax = GROW(oldmax);
 121
 122     Renew(markstack, newmax, I32);
 123     markstack_ptr = markstack + oldmax;
 124     markstack_max = markstack + newmax;
 125 }
 126
 127 void
 128 savestack_grow(void)
 129 {
 130     dTHR;
 131     savestack_max = GROW(savestack_max) + 4;
 132     Renew(savestack, savestack_max, ANY);
 133 }
 134
 135 #undef GROW
 136
 137 void
 138 free_tmps(void)
 139 {
 140     dTHR;
 141     /* XXX should tmps_floor live in cxstack? */
 142     I32 myfloor = tmps_floor;
 143     while (tmps_ix > myfloor) {      /* clean up after last statement */
 144         SV* sv = tmps_stack[tmps_ix];
 145         tmps_stack[tmps_ix--] = Nullsv;
 146         if (sv) {
 147 #ifdef DEBUGGING
 148             SvTEMP_off(sv);
 149 #endif
 150             SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
 151         }
 152     }
 153 }
 154
 155 static SV *
 156 save_scalar_at(SV **sptr)
 157 {
 158     dTHR;
 159     register SV *sv;
 160     SV *osv = *sptr;
 161
 162     sv = *sptr = NEWSV(0,0);
 163     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
 164         sv_upgrade(sv, SvTYPE(osv));
 165         if (SvGMAGICAL(osv)) {
 166             MAGIC* mg;
 167             bool oldtainted = tainted;
 168             mg_get(osv);
 169             if (tainting && tainted && (mg = mg_find(osv, 't'))) {
 170                 SAVESPTR(mg->mg_obj);
 171                 mg->mg_obj = osv;
 172             }
 173             SvFLAGS(osv) |= (SvFLAGS(osv) &
 174                 (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 175             tainted = oldtainted;
 176         }
 177         SvMAGIC(sv) = SvMAGIC(osv);
 178         SvFLAGS(sv) |= SvMAGICAL(osv);
 179         localizing = 1;
 180         SvSETMAGIC(sv);
 181         localizing = 0;
 182     }
 183     return sv;
 184 }
 185
 186 SV *
 187 save_scalar(GV *gv)
 188 {
 189     dTHR;
 190     SV **sptr = &GvSV(gv);
 191     SSCHECK(3);
 192     SSPUSHPTR(SvREFCNT_inc(gv));
 193     SSPUSHPTR(SvREFCNT_inc(*sptr));
 194     SSPUSHINT(SAVEt_SV);
 195     return save_scalar_at(sptr);
 196 }
 197
 198 SV*
 199 save_svref(SV **sptr)
 200 {
 201     dTHR;
 202     SSCHECK(3);
 203     SSPUSHPTR(sptr);
 204     SSPUSHPTR(SvREFCNT_inc(*sptr));
 205     SSPUSHINT(SAVEt_SVREF);
 206     return save_scalar_at(sptr);
 207 }
 208
 209 void
 210 save_gp(GV *gv, I32 empty)
 211 {
 212     dTHR;
 213     SSCHECK(6);
 214     SSPUSHIV((IV)SvLEN(gv));
 215     SvLEN(gv) = 0; /* forget that anything was allocated here */
 216     SSPUSHIV((IV)SvCUR(gv));
 217     SSPUSHPTR(SvPVX(gv));
 218     SvPOK_off(gv);
 219     SSPUSHPTR(SvREFCNT_inc(gv));
 220     SSPUSHPTR(GvGP(gv));
 221     SSPUSHINT(SAVEt_GP);
 222
 223     if (empty) {
 224         register GP *gp;
 225         Newz(602, gp, 1, GP);
 226         GvGP(gv) = gp_ref(gp);
 227         GvSV(gv) = NEWSV(72,0);
 228         GvLINE(gv) = curcop->cop_line;
 229         GvEGV(gv) = gv;
 230     }
 231     else {
 232         gp_ref(GvGP(gv));
 233         GvINTRO_on(gv);
 234     }
 235 }
 236
 237 AV *
 238 save_ary(GV *gv)
 239 {
 240     dTHR;
 241     AV *oav = GvAVn(gv);
 242     AV *av;
 243
 244     if (!AvREAL(oav) && AvREIFY(oav))
 245         av_reify(oav);
 246     SSCHECK(3);
 247     SSPUSHPTR(gv);
 248     SSPUSHPTR(oav);
 249     SSPUSHINT(SAVEt_AV);
 250
 251     GvAV(gv) = Null(AV*);
 252     av = GvAVn(gv);
 253     if (SvMAGIC(oav)) {
 254         SvMAGIC(av) = SvMAGIC(oav);
 255         SvFLAGS(av) |= SvMAGICAL(oav);
 256         SvMAGICAL_off(oav);
 257         SvMAGIC(oav) = 0;
 258         localizing = 1;
 259         SvSETMAGIC((SV*)av);
 260         localizing = 0;
 261     }
 262     return av;
 263 }
 264
 265 HV *
 266 save_hash(GV *gv)
 267 {
 268     dTHR;
 269     HV *ohv, *hv;
 270
 271     SSCHECK(3);
 272     SSPUSHPTR(gv);
 273     SSPUSHPTR(ohv = GvHVn(gv));
 274     SSPUSHINT(SAVEt_HV);
 275
 276     GvHV(gv) = Null(HV*);
 277     hv = GvHVn(gv);
 278     if (SvMAGIC(ohv)) {
 279         SvMAGIC(hv) = SvMAGIC(ohv);
 280         SvFLAGS(hv) |= SvMAGICAL(ohv);
 281         SvMAGICAL_off(ohv);
 282         SvMAGIC(ohv) = 0;
 283         localizing = 1;
 284         SvSETMAGIC((SV*)hv);
 285         localizing = 0;
 286     }
 287     return hv;
 288 }
 289
 290 void
 291 save_item(register SV *item)
 292 {
 293     dTHR;
 294     register SV *sv = NEWSV(0,0);
 295
 296     sv_setsv(sv,item);
 297     SSCHECK(3);
 298     SSPUSHPTR(item);            /* remember the pointer */
 299     SSPUSHPTR(sv);              /* remember the value */
 300     SSPUSHINT(SAVEt_ITEM);
 301 }
 302
 303 void
 304 save_int(int *intp)
 305 {
 306     dTHR;
 307     SSCHECK(3);
 308     SSPUSHINT(*intp);
 309     SSPUSHPTR(intp);
 310     SSPUSHINT(SAVEt_INT);
 311 }
 312
 313 void
 314 save_long(long int *longp)
 315 {
 316     dTHR;
 317     SSCHECK(3);
 318     SSPUSHLONG(*longp);
 319     SSPUSHPTR(longp);
 320     SSPUSHINT(SAVEt_LONG);
 321 }
 322
 323 void
 324 save_I32(I32 *intp)
 325 {
 326     dTHR;
 327     SSCHECK(3);
 328     SSPUSHINT(*intp);
 329     SSPUSHPTR(intp);
 330     SSPUSHINT(SAVEt_I32);
 331 }
 332
 333 void
 334 save_I16(I16 *intp)
 335 {
 336     dTHR;
 337     SSCHECK(3);
 338     SSPUSHINT(*intp);
 339     SSPUSHPTR(intp);
 340     SSPUSHINT(SAVEt_I16);
 341 }
 342
 343 void
 344 save_iv(IV *ivp)
 345 {
 346     dTHR;
 347     SSCHECK(3);
 348     SSPUSHIV(*ivp);
 349     SSPUSHPTR(ivp);
 350     SSPUSHINT(SAVEt_IV);
 351 }
 352
 353 /* Cannot use save_sptr() to store a char* since the SV** cast will
 354  * force word-alignment and we'll miss the pointer.
 355  */
 356 void
 357 save_pptr(char **pptr)
 358 {
 359     dTHR;
 360     SSCHECK(3);
 361     SSPUSHPTR(*pptr);
 362     SSPUSHPTR(pptr);
 363     SSPUSHINT(SAVEt_PPTR);
 364 }
 365
 366 void
 367 save_sptr(SV **sptr)
 368 {
 369     dTHR;
 370     SSCHECK(3);
 371     SSPUSHPTR(*sptr);
 372     SSPUSHPTR(sptr);
 373     SSPUSHINT(SAVEt_SPTR);
 374 }
 375
 376 SV **
 377 save_threadsv(PADOFFSET i)
 378 {
 379 #ifdef USE_THREADS
 380     dTHR;
 381     SV **svp = &THREADSV(i);    /* XXX Change to save by offset */
 382     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
 383                           i, svp, *svp, SvPEEK(*svp)));
 384     save_svref(svp);
 385     return svp;
 386 #else
 387     croak("panic: save_threadsv called in non-threaded perl");
 388     return 0;
 389 #endif /* USE_THREADS */
 390 }
 391
 392 void
 393 save_nogv(GV *gv)
 394 {
 395     dTHR;
 396     SSCHECK(2);
 397     SSPUSHPTR(gv);
 398     SSPUSHINT(SAVEt_NSTAB);
 399 }
 400
 401 void
 402 save_hptr(HV **hptr)
 403 {
 404     dTHR;
 405     SSCHECK(3);
 406     SSPUSHPTR(*hptr);
 407     SSPUSHPTR(hptr);
 408     SSPUSHINT(SAVEt_HPTR);
 409 }
 410
 411 void
 412 save_aptr(AV **aptr)
 413 {
 414     dTHR;
 415     SSCHECK(3);
 416     SSPUSHPTR(*aptr);
 417     SSPUSHPTR(aptr);
 418     SSPUSHINT(SAVEt_APTR);
 419 }
 420
 421 void
 422 save_freesv(SV *sv)
 423 {
 424     dTHR;
 425     SSCHECK(2);
 426     SSPUSHPTR(sv);
 427     SSPUSHINT(SAVEt_FREESV);
 428 }
 429
 430 void
 431 save_freeop(OP *o)
 432 {
 433     dTHR;
 434     SSCHECK(2);
 435     SSPUSHPTR(o);
 436     SSPUSHINT(SAVEt_FREEOP);
 437 }
 438
 439 void
 440 save_freepv(char *pv)
 441 {
 442     dTHR;
 443     SSCHECK(2);
 444     SSPUSHPTR(pv);
 445     SSPUSHINT(SAVEt_FREEPV);
 446 }
 447
 448 void
 449 save_clearsv(SV **svp)
 450 {
 451     dTHR;
 452     SSCHECK(2);
 453     SSPUSHLONG((long)(svp-curpad));
 454     SSPUSHINT(SAVEt_CLEARSV);
 455 }
 456
 457 void
 458 save_delete(HV *hv, char *key, I32 klen)
 459 {
 460     dTHR;
 461     SSCHECK(4);
 462     SSPUSHINT(klen);
 463     SSPUSHPTR(key);
 464     SSPUSHPTR(SvREFCNT_inc(hv));
 465     SSPUSHINT(SAVEt_DELETE);
 466 }
 467
 468 void
 469 save_list(register SV **sarg, I32 maxsarg)
 470 {
 471     dTHR;
 472     register SV *sv;
 473     register I32 i;
 474
 475     for (i = 1; i <= maxsarg; i++) {
 476         sv = NEWSV(0,0);
 477         sv_setsv(sv,sarg[i]);
 478         SSCHECK(3);
 479         SSPUSHPTR(sarg[i]);             /* remember the pointer */
 480         SSPUSHPTR(sv);                  /* remember the value */
 481         SSPUSHINT(SAVEt_ITEM);
 482     }
 483 }
 484
 485 void
 486 save_destructor(void (*f) (void *), void *p)
 487 {
 488     dTHR;
 489     SSCHECK(3);
 490     SSPUSHDPTR(f);
 491     SSPUSHPTR(p);
 492     SSPUSHINT(SAVEt_DESTRUCTOR);
 493 }
 494
 495 void
 496 save_aelem(AV *av, I32 idx, SV **sptr)
 497 {
 498     dTHR;
 499     SSCHECK(4);
 500     SSPUSHPTR(SvREFCNT_inc(av));
 501     SSPUSHINT(idx);
 502     SSPUSHPTR(SvREFCNT_inc(*sptr));
 503     SSPUSHINT(SAVEt_AELEM);
 504     save_scalar_at(sptr);
 505 }
 506
 507 void
 508 save_helem(HV *hv, SV *key, SV **sptr)
 509 {
 510     dTHR;
 511     SSCHECK(4);
 512     SSPUSHPTR(SvREFCNT_inc(hv));
 513     SSPUSHPTR(SvREFCNT_inc(key));
 514     SSPUSHPTR(SvREFCNT_inc(*sptr));
 515     SSPUSHINT(SAVEt_HELEM);
 516     save_scalar_at(sptr);
 517 }
 518
 519 void
 520 save_op(void)
 521 {
 522     dTHR;
 523     SSCHECK(2);
 524     SSPUSHPTR(op);
 525     SSPUSHINT(SAVEt_OP);
 526 }
 527
 528 void
 529 leave_scope(I32 base)
 530 {
 531     dTHR;
 532     register SV *sv;
 533     register SV *value;
 534     register GV *gv;
 535     register AV *av;
 536     register HV *hv;
 537     register void* ptr;
 538     I32 i;
 539
 540     if (base < -1)
 541         croak("panic: corrupt saved stack index");
 542     while (savestack_ix > base) {
 543         switch (SSPOPINT) {
 544         case SAVEt_ITEM:                        /* normal string */
 545             value = (SV*)SSPOPPTR;
 546             sv = (SV*)SSPOPPTR;
 547             sv_replace(sv,value);
 548             localizing = 2;
 549             SvSETMAGIC(sv);
 550             localizing = 0;
 551             break;
 552         case SAVEt_SV:                          /* scalar reference */
 553             value = (SV*)SSPOPPTR;
 554             gv = (GV*)SSPOPPTR;
 555             ptr = &GvSV(gv);
 556             SvREFCNT_dec(gv);
 557             goto restore_sv;
 558         case SAVEt_SVREF:                       /* scalar reference */
 559             value = (SV*)SSPOPPTR;
 560             ptr = SSPOPPTR;
 561         restore_sv:
 562             sv = *(SV**)ptr;
 563             DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 564                                   "restore svref: %p %p:%s -> %p:%s\n",
 565                                   ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
 566             if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
 567                 SvTYPE(sv) != SVt_PVGV)
 568             {
 569                 (void)SvUPGRADE(value, SvTYPE(sv));
 570                 SvMAGIC(value) = SvMAGIC(sv);
 571                 SvFLAGS(value) |= SvMAGICAL(sv);
 572                 SvMAGICAL_off(sv);
 573                 SvMAGIC(sv) = 0;
 574             }
 575             else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
 576                      SvTYPE(value) != SVt_PVGV)
 577             {
 578                 SvFLAGS(value) |= (SvFLAGS(value) &
 579                                    (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 580                 SvMAGICAL_off(value);
 581                 SvMAGIC(value) = 0;
 582             }
 583             SvREFCNT_dec(sv);
 584             *(SV**)ptr = value;
 585             localizing = 2;
 586             SvSETMAGIC(value);
 587             localizing = 0;
 588             SvREFCNT_dec(value);
 589             break;
 590         case SAVEt_AV:                          /* array reference */
 591             av = (AV*)SSPOPPTR;
 592             gv = (GV*)SSPOPPTR;
 593             if (GvAV(gv)) {
 594                 AV *goner = GvAV(gv);
 595                 SvMAGIC(av) = SvMAGIC(goner);
 596                 SvFLAGS(av) |= SvMAGICAL(goner);
 597                 SvMAGICAL_off(goner);
 598                 SvMAGIC(goner) = 0;
 599                 SvREFCNT_dec(goner);
 600             }
 601             GvAV(gv) = av;
 602             if (SvMAGICAL(av)) {
 603                 localizing = 2;
 604                 SvSETMAGIC((SV*)av);
 605                 localizing = 0;
 606             }
 607             break;
 608         case SAVEt_HV:                          /* hash reference */
 609             hv = (HV*)SSPOPPTR;
 610             gv = (GV*)SSPOPPTR;
 611             if (GvHV(gv)) {
 612                 HV *goner = GvHV(gv);
 613                 SvMAGIC(hv) = SvMAGIC(goner);
 614                 SvFLAGS(hv) |= SvMAGICAL(goner);
 615                 SvMAGICAL_off(goner);
 616                 SvMAGIC(goner) = 0;
 617                 SvREFCNT_dec(goner);
 618             }
 619             GvHV(gv) = hv;
 620             if (SvMAGICAL(hv)) {
 621                 localizing = 2;
 622                 SvSETMAGIC((SV*)hv);
 623                 localizing = 0;
 624             }
 625             break;
 626         case SAVEt_INT:                         /* int reference */
 627             ptr = SSPOPPTR;
 628             *(int*)ptr = (int)SSPOPINT;
 629             break;
 630         case SAVEt_LONG:                        /* long reference */
 631             ptr = SSPOPPTR;
 632             *(long*)ptr = (long)SSPOPLONG;
 633             break;
 634         case SAVEt_I32:                         /* I32 reference */
 635             ptr = SSPOPPTR;
 636             *(I32*)ptr = (I32)SSPOPINT;
 637             break;
 638         case SAVEt_I16:                         /* I16 reference */
 639             ptr = SSPOPPTR;
 640             *(I16*)ptr = (I16)SSPOPINT;
 641             break;
 642         case SAVEt_IV:                          /* IV reference */
 643             ptr = SSPOPPTR;
 644             *(IV*)ptr = (IV)SSPOPIV;
 645             break;
 646         case SAVEt_SPTR:                        /* SV* reference */
 647             ptr = SSPOPPTR;
 648             *(SV**)ptr = (SV*)SSPOPPTR;
 649             break;
 650         case SAVEt_PPTR:                        /* char* reference */
 651             ptr = SSPOPPTR;
 652             *(char**)ptr = (char*)SSPOPPTR;
 653             break;
 654         case SAVEt_HPTR:                        /* HV* reference */
 655             ptr = SSPOPPTR;
 656             *(HV**)ptr = (HV*)SSPOPPTR;
 657             break;
 658         case SAVEt_APTR:                        /* AV* reference */
 659             ptr = SSPOPPTR;
 660             *(AV**)ptr = (AV*)SSPOPPTR;
 661             break;
 662         case SAVEt_NSTAB:
 663             gv = (GV*)SSPOPPTR;
 664             (void)sv_clear((SV*)gv);
 665             break;
 666         case SAVEt_GP:                          /* scalar reference */
 667             ptr = SSPOPPTR;
 668             gv = (GV*)SSPOPPTR;
 669             if (SvPOK(gv) && SvLEN(gv) > 0) {
 670                 Safefree(SvPVX(gv));
 671             }
 672             SvPVX(gv) = (char *)SSPOPPTR;
 673             SvCUR(gv) = (STRLEN)SSPOPIV;
 674             SvLEN(gv) = (STRLEN)SSPOPIV;
 675             gp_free(gv);
 676             GvGP(gv) = (GP*)ptr;
 677             SvREFCNT_dec(gv);
 678             break;
 679         case SAVEt_FREESV:
 680             ptr = SSPOPPTR;
 681             SvREFCNT_dec((SV*)ptr);
 682             break;
 683         case SAVEt_FREEOP:
 684             ptr = SSPOPPTR;
 685             if (comppad)
 686                 curpad = AvARRAY(comppad);
 687             op_free((OP*)ptr);
 688             break;
 689         case SAVEt_FREEPV:
 690             ptr = SSPOPPTR;
 691             Safefree((char*)ptr);
 692             break;
 693         case SAVEt_CLEARSV:
 694             ptr = (void*)&curpad[SSPOPLONG];
 695             sv = *(SV**)ptr;
 696             /* Can clear pad variable in place? */
 697             if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
 698                 if (SvTHINKFIRST(sv)) {
 699                     if (SvREADONLY(sv))
 700                         croak("panic: leave_scope clearsv");
 701                     if (SvROK(sv))
 702                         sv_unref(sv);
 703                 }
 704                 if (SvMAGICAL(sv))
 705                     mg_free(sv);
 706
 707                 switch (SvTYPE(sv)) {
 708                 case SVt_NULL:
 709                     break;
 710                 case SVt_PVAV:
 711                     av_clear((AV*)sv);
 712                     break;
 713                 case SVt_PVHV:
 714                     hv_clear((HV*)sv);
 715                     break;
 716                 case SVt_PVCV:
 717                     croak("panic: leave_scope pad code");
 718                 case SVt_RV:
 719                 case SVt_IV:
 720                 case SVt_NV:
 721                     (void)SvOK_off(sv);
 722                     break;
 723                 default:
 724                     (void)SvOK_off(sv);
 725                     (void)SvOOK_off(sv);
 726                     break;
 727                 }
 728             }
 729             else {      /* Someone has a claim on this, so abandon it. */
 730                 U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
 731                 switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
 732                 case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
 733                 case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
 734                 default:        *(SV**)ptr = NEWSV(0,0);        break;
 735                 }
 736                 SvREFCNT_dec(sv);       /* Cast current value to the winds. */
 737                 SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
 738             }
 739             break;
 740         case SAVEt_DELETE:
 741             ptr = SSPOPPTR;
 742             hv = (HV*)ptr;
 743             ptr = SSPOPPTR;
 744             (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
 745             SvREFCNT_dec(hv);
 746             Safefree(ptr);
 747             break;
 748         case SAVEt_DESTRUCTOR:
 749             ptr = SSPOPPTR;
 750             (*SSPOPDPTR)(ptr);
 751             break;
 752         case SAVEt_REGCONTEXT:
 753             i = SSPOPINT;
 754             savestack_ix -= i;          /* regexp must have croaked */
 755             break;
 756         case SAVEt_STACK_POS:           /* Position on Perl stack */
 757             i = SSPOPINT;
 758             stack_sp = stack_base + i;
 759             break;
 760         case SAVEt_AELEM:               /* array element */
 761             value = (SV*)SSPOPPTR;
 762             i = SSPOPINT;
 763             av = (AV*)SSPOPPTR;
 764             ptr = av_fetch(av,i,1);
 765             if (ptr) {
 766                 sv = *(SV**)ptr;
 767                 if (sv && sv != &sv_undef) {
 768                     if (SvRMAGICAL(av) && mg_find((SV*)av, 'P'))
 769                         (void)SvREFCNT_inc(sv);
 770                     SvREFCNT_dec(av);
 771                     goto restore_sv;
 772                 }
 773             }
 774             SvREFCNT_dec(av);
 775             SvREFCNT_dec(value);
 776             break;
 777         case SAVEt_HELEM:               /* hash element */
 778             value = (SV*)SSPOPPTR;
 779             sv = (SV*)SSPOPPTR;
 780             hv = (HV*)SSPOPPTR;
 781             ptr = hv_fetch_ent(hv, sv, 1, 0);
 782             if (ptr) {
 783                 SV *oval = HeVAL((HE*)ptr);
 784                 if (oval && oval != &sv_undef) {
 785                     ptr = &HeVAL((HE*)ptr);
 786                     if (SvRMAGICAL(hv) && mg_find((SV*)hv, 'P'))
 787                         (void)SvREFCNT_inc(*(SV**)ptr);
 788                     SvREFCNT_dec(hv);
 789                     SvREFCNT_dec(sv);
 790                     goto restore_sv;
 791                 }
 792             }
 793             SvREFCNT_dec(hv);
 794             SvREFCNT_dec(sv);
 795             SvREFCNT_dec(value);
 796             break;
 797         case SAVEt_OP:
 798             op = (OP*)SSPOPPTR;
 799             break;
 800         default:
 801             croak("panic: leave_scope inconsistency");
 802         }
 803     }
 804 }
 805
 806 #ifdef DEBUGGING
 807
 808 void
 809 cx_dump(PERL_CONTEXT *cx)
 810 {
 811     dTHR;
 812     PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
 813     if (cx->cx_type != CXt_SUBST) {
 814         PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
 815         PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
 816         PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
 817         PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
 818         PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
 819         PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
 820         PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
 821     }
 822     switch (cx->cx_type) {
 823     case CXt_NULL:
 824     case CXt_BLOCK:
 825         break;
 826     case CXt_SUB:
 827         PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%lx\n",
 828                 (long)cx->blk_sub.cv);
 829         PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n",
 830                 (long)cx->blk_sub.gv);
 831         PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n",
 832                 (long)cx->blk_sub.dfoutgv);
 833         PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
 834                 (long)cx->blk_sub.olddepth);
 835         PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
 836                 (int)cx->blk_sub.hasargs);
 837         break;
 838     case CXt_EVAL:
 839         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
 840                 (long)cx->blk_eval.old_in_eval);
 841         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
 842                 op_name[cx->blk_eval.old_op_type],
 843                 op_desc[cx->blk_eval.old_op_type]);
 844         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
 845                 cx->blk_eval.old_name);
 846         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
 847                 (long)cx->blk_eval.old_eval_root);
 848         break;
 849
 850     case CXt_LOOP:
 851         PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n",
 852                 cx->blk_loop.label);
 853         PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
 854                 (long)cx->blk_loop.resetsp);
 855         PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n",
 856                 (long)cx->blk_loop.redo_op);
 857         PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n",
 858                 (long)cx->blk_loop.next_op);
 859         PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n",
 860                 (long)cx->blk_loop.last_op);
 861         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
 862                 (long)cx->blk_loop.iterix);
 863         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n",
 864                 (long)cx->blk_loop.iterary);
 865         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n",
 866                 (long)cx->blk_loop.itervar);
 867         if (cx->blk_loop.itervar)
 868             PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n",
 869                 (long)cx->blk_loop.itersave);
 870         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n",
 871                 (long)cx->blk_loop.iterlval);
 872         break;
 873
 874     case CXt_SUBST:
 875         PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
 876                 (long)cx->sb_iters);
 877         PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
 878                 (long)cx->sb_maxiters);
 879         PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n",
 880                 (long)cx->sb_safebase);
 881         PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
 882                 (long)cx->sb_once);
 883         PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
 884                 cx->sb_orig);
 885         PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n",
 886                 (long)cx->sb_dstr);
 887         PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n",
 888                 (long)cx->sb_targ);
 889         PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n",
 890                 (long)cx->sb_s);
 891         PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n",
 892                 (long)cx->sb_m);
 893         PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n",
 894                 (long)cx->sb_strend);
 895         PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n",
 896                 (long)cx->sb_rxres);
 897         break;
 898     }
 899 }
 900 #endif