scope.c

   1 /*    scope.c
   2  *
   3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
   4  *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  *
   9  */
  10
  11 /*
  12  * For the fashion of Minas Tirith was such that it was built on seven
  13  * levels...
  14  *
  15  *     [p.751 of _The Lord of the Rings_, V/i: "Minas Tirith"]
  16  */
  17
  18 /* This file contains functions to manipulate several of Perl's stacks;
  19  * in particular it contains code to push various types of things onto
  20  * the savestack, then to pop them off and perform the correct restorative
  21  * action for each one. This corresponds to the cleanup Perl does at
  22  * each scope exit.
  23  */
  24
  25 #include "EXTERN.h"
  26 #define PERL_IN_SCOPE_C
  27 #include "perl.h"
  28
  29 SV**
  30 Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
  31 {
  32     dVAR;
  33
  34     PERL_ARGS_ASSERT_STACK_GROW;
  35
  36     PL_stack_sp = sp;
  37 #ifndef STRESS_REALLOC
  38     av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
  39 #else
  40     av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
  41 #endif
  42     return PL_stack_sp;
  43 }
  44
  45 #ifndef STRESS_REALLOC
  46 #define GROW(old) ((old) * 3 / 2)
  47 #else
  48 #define GROW(old) ((old) + 1)
  49 #endif
  50
  51 PERL_SI *
  52 Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
  53 {
  54     dVAR;
  55     PERL_SI *si;
  56     Newx(si, 1, PERL_SI);
  57     si->si_stack = newAV();
  58     AvREAL_off(si->si_stack);
  59     av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0);
  60     AvALLOC(si->si_stack)[0] = &PL_sv_undef;
  61     AvFILLp(si->si_stack) = 0;
  62     si->si_prev = 0;
  63     si->si_next = 0;
  64     si->si_cxmax = cxitems - 1;
  65     si->si_cxix = -1;
  66     si->si_type = PERLSI_UNDEF;
  67     Newx(si->si_cxstack, cxitems, PERL_CONTEXT);
  68     /* Without any kind of initialising PUSHSUBST()
  69      * in pp_subst() will read uninitialised heap. */
  70     PoisonNew(si->si_cxstack, cxitems, PERL_CONTEXT);
  71     return si;
  72 }
  73
  74 I32
  75 Perl_cxinc(pTHX)
  76 {
  77     dVAR;
  78     const IV old_max = cxstack_max;
  79     cxstack_max = GROW(cxstack_max);
  80     Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);      /* XXX should fix CXINC macro */
  81     /* Without any kind of initialising deep enough recursion
  82      * will end up reading uninitialised PERL_CONTEXTs. */
  83     PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
  84     return cxstack_ix + 1;
  85 }
  86
  87 void
  88 Perl_push_scope(pTHX)
  89 {
  90     dVAR;
  91     if (PL_scopestack_ix == PL_scopestack_max) {
  92         PL_scopestack_max = GROW(PL_scopestack_max);
  93         Renew(PL_scopestack, PL_scopestack_max, I32);
  94     }
  95     PL_scopestack[PL_scopestack_ix++] = PL_savestack_ix;
  96
  97 }
  98
  99 void
 100 Perl_pop_scope(pTHX)
 101 {
 102     dVAR;
 103     const I32 oldsave = PL_scopestack[--PL_scopestack_ix];
 104     LEAVE_SCOPE(oldsave);
 105 }
 106
 107 void
 108 Perl_markstack_grow(pTHX)
 109 {
 110     dVAR;
 111     const I32 oldmax = PL_markstack_max - PL_markstack;
 112     const I32 newmax = GROW(oldmax);
 113
 114     Renew(PL_markstack, newmax, I32);
 115     PL_markstack_ptr = PL_markstack + oldmax;
 116     PL_markstack_max = PL_markstack + newmax;
 117 }
 118
 119 void
 120 Perl_savestack_grow(pTHX)
 121 {
 122     dVAR;
 123     PL_savestack_max = GROW(PL_savestack_max) + 4;
 124     Renew(PL_savestack, PL_savestack_max, ANY);
 125 }
 126
 127 void
 128 Perl_savestack_grow_cnt(pTHX_ I32 need)
 129 {
 130     dVAR;
 131     PL_savestack_max = PL_savestack_ix + need;
 132     Renew(PL_savestack, PL_savestack_max, ANY);
 133 }
 134
 135 #undef GROW
 136
 137 void
 138 Perl_tmps_grow(pTHX_ I32 n)
 139 {
 140     dVAR;
 141 #ifndef STRESS_REALLOC
 142     if (n < 128)
 143         n = (PL_tmps_max < 512) ? 128 : 512;
 144 #endif
 145     PL_tmps_max = PL_tmps_ix + n + 1;
 146     Renew(PL_tmps_stack, PL_tmps_max, SV*);
 147 }
 148
 149
 150 void
 151 Perl_free_tmps(pTHX)
 152 {
 153     dVAR;
 154     /* XXX should tmps_floor live in cxstack? */
 155     const I32 myfloor = PL_tmps_floor;
 156     while (PL_tmps_ix > myfloor) {      /* clean up after last statement */
 157         SV* const sv = PL_tmps_stack[PL_tmps_ix];
 158         PL_tmps_stack[PL_tmps_ix--] = NULL;
 159         if (sv && sv != &PL_sv_undef) {
 160             SvTEMP_off(sv);
 161             SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
 162         }
 163     }
 164 }
 165
 166 STATIC SV *
 167 S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
 168 {
 169     dVAR;
 170     SV * const osv = *sptr;
 171     register SV * const sv = *sptr = newSV(0);
 172
 173     PERL_ARGS_ASSERT_SAVE_SCALAR_AT;
 174
 175     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
 176         if (SvGMAGICAL(osv)) {
 177             const bool oldtainted = PL_tainted;
 178             SvFLAGS(osv) |= (SvFLAGS(osv) &
 179                (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 180             PL_tainted = oldtainted;
 181         }
 182         mg_localize(osv, sv, (flags & SAVEf_SETMAGIC) != 0);
 183     }
 184     return sv;
 185 }
 186
 187 SV *
 188 Perl_save_scalar(pTHX_ GV *gv)
 189 {
 190     dVAR;
 191     SV ** const sptr = &GvSVn(gv);
 192
 193     PERL_ARGS_ASSERT_SAVE_SCALAR;
 194
 195     PL_localizing = 1;
 196     SvGETMAGIC(*sptr);
 197     PL_localizing = 0;
 198     SSCHECK(3);
 199     SSPUSHPTR(SvREFCNT_inc_simple(gv));
 200     SSPUSHPTR(SvREFCNT_inc(*sptr));
 201     SSPUSHINT(SAVEt_SV);
 202     return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 203 }
 204
 205 /* Like save_sptr(), but also SvREFCNT_dec()s the new value.  Can be used to
 206  * restore a global SV to its prior contents, freeing new value. */
 207 void
 208 Perl_save_generic_svref(pTHX_ SV **sptr)
 209 {
 210     dVAR;
 211
 212     PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF;
 213
 214     SSCHECK(3);
 215     SSPUSHPTR(sptr);
 216     SSPUSHPTR(SvREFCNT_inc(*sptr));
 217     SSPUSHINT(SAVEt_GENERIC_SVREF);
 218 }
 219
 220 /* Like save_pptr(), but also Safefree()s the new value if it is different
 221  * from the old one.  Can be used to restore a global char* to its prior
 222  * contents, freeing new value. */
 223 void
 224 Perl_save_generic_pvref(pTHX_ char **str)
 225 {
 226     dVAR;
 227
 228     PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF;
 229
 230     SSCHECK(3);
 231     SSPUSHPTR(*str);
 232     SSPUSHPTR(str);
 233     SSPUSHINT(SAVEt_GENERIC_PVREF);
 234 }
 235
 236 /* Like save_generic_pvref(), but uses PerlMemShared_free() rather than Safefree().
 237  * Can be used to restore a shared global char* to its prior
 238  * contents, freeing new value. */
 239 void
 240 Perl_save_shared_pvref(pTHX_ char **str)
 241 {
 242     dVAR;
 243
 244     PERL_ARGS_ASSERT_SAVE_SHARED_PVREF;
 245
 246     SSCHECK(3);
 247     SSPUSHPTR(str);
 248     SSPUSHPTR(*str);
 249     SSPUSHINT(SAVEt_SHARED_PVREF);
 250 }
 251
 252 /* set the SvFLAGS specified by mask to the values in val */
 253
 254 void
 255 Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
 256 {
 257     dVAR;
 258
 259     PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS;
 260
 261     SSCHECK(4);
 262     SSPUSHPTR(sv);
 263     SSPUSHINT(mask);
 264     SSPUSHINT(val);
 265     SSPUSHINT(SAVEt_SET_SVFLAGS);
 266 }
 267
 268 void
 269 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 270 {
 271     dVAR;
 272
 273     PERL_ARGS_ASSERT_SAVE_GP;
 274
 275     SSGROW(3);
 276     SSPUSHPTR(SvREFCNT_inc(gv));
 277     SSPUSHPTR(GvGP(gv));
 278     SSPUSHINT(SAVEt_GP);
 279
 280     if (empty) {
 281         GP *gp = Perl_newGP(aTHX_ gv);
 282
 283         if (GvCVu(gv))
 284             mro_method_changed_in(GvSTASH(gv)); /* taking a method out of circulation ("local")*/
 285         if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) {
 286             gp->gp_io = newIO();
 287             IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
 288         }
 289 #ifdef PERL_DONT_CREATE_GVSV
 290         if (gv == PL_errgv) {
 291             /* We could scatter this logic everywhere by changing the
 292                definition of ERRSV from GvSV() to GvSVn(), but it seems more
 293                efficient to do this check once here.  */
 294             gp->gp_sv = newSV(0);
 295         }
 296 #endif
 297         GvGP(gv) = gp;
 298     }
 299     else {
 300         gp_ref(GvGP(gv));
 301         GvINTRO_on(gv);
 302     }
 303 }
 304
 305 AV *
 306 Perl_save_ary(pTHX_ GV *gv)
 307 {
 308     dVAR;
 309     AV * const oav = GvAVn(gv);
 310     AV *av;
 311
 312     PERL_ARGS_ASSERT_SAVE_ARY;
 313
 314     if (!AvREAL(oav) && AvREIFY(oav))
 315         av_reify(oav);
 316     SSCHECK(3);
 317     SSPUSHPTR(gv);
 318     SSPUSHPTR(oav);
 319     SSPUSHINT(SAVEt_AV);
 320
 321     GvAV(gv) = NULL;
 322     av = GvAVn(gv);
 323     if (SvMAGIC(oav))
 324         mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE);
 325     return av;
 326 }
 327
 328 HV *
 329 Perl_save_hash(pTHX_ GV *gv)
 330 {
 331     dVAR;
 332     HV *ohv, *hv;
 333
 334     PERL_ARGS_ASSERT_SAVE_HASH;
 335
 336     SSCHECK(3);
 337     SSPUSHPTR(gv);
 338     SSPUSHPTR(ohv = GvHVn(gv));
 339     SSPUSHINT(SAVEt_HV);
 340
 341     GvHV(gv) = NULL;
 342     hv = GvHVn(gv);
 343     if (SvMAGIC(ohv))
 344         mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE);
 345     return hv;
 346 }
 347
 348 void
 349 Perl_save_item(pTHX_ register SV *item)
 350 {
 351     dVAR;
 352     register SV * const sv = newSVsv(item);
 353
 354     PERL_ARGS_ASSERT_SAVE_ITEM;
 355
 356     SSCHECK(3);
 357     SSPUSHPTR(item);            /* remember the pointer */
 358     SSPUSHPTR(sv);              /* remember the value */
 359     SSPUSHINT(SAVEt_ITEM);
 360 }
 361
 362 void
 363 Perl_save_int(pTHX_ int *intp)
 364 {
 365     dVAR;
 366
 367     PERL_ARGS_ASSERT_SAVE_INT;
 368
 369     SSCHECK(3);
 370     SSPUSHINT(*intp);
 371     SSPUSHPTR(intp);
 372     SSPUSHINT(SAVEt_INT);
 373 }
 374
 375 void
 376 Perl_save_bool(pTHX_ bool *boolp)
 377 {
 378     dVAR;
 379
 380     PERL_ARGS_ASSERT_SAVE_BOOL;
 381
 382     SSCHECK(3);
 383     SSPUSHBOOL(*boolp);
 384     SSPUSHPTR(boolp);
 385     SSPUSHINT(SAVEt_BOOL);
 386 }
 387
 388 void
 389 Perl_save_I8(pTHX_ I8 *bytep)
 390 {
 391     dVAR;
 392
 393     PERL_ARGS_ASSERT_SAVE_I8;
 394
 395     SSCHECK(3);
 396     SSPUSHINT(*bytep);
 397     SSPUSHPTR(bytep);
 398     SSPUSHINT(SAVEt_I8);
 399 }
 400
 401 void
 402 Perl_save_I16(pTHX_ I16 *intp)
 403 {
 404     dVAR;
 405
 406     PERL_ARGS_ASSERT_SAVE_I16;
 407
 408     SSCHECK(3);
 409     SSPUSHINT(*intp);
 410     SSPUSHPTR(intp);
 411     SSPUSHINT(SAVEt_I16);
 412 }
 413
 414 void
 415 Perl_save_I32(pTHX_ I32 *intp)
 416 {
 417     dVAR;
 418
 419     PERL_ARGS_ASSERT_SAVE_I32;
 420
 421     SSCHECK(3);
 422     SSPUSHINT(*intp);
 423     SSPUSHPTR(intp);
 424     SSPUSHINT(SAVEt_I32);
 425 }
 426
 427 /* Cannot use save_sptr() to store a char* since the SV** cast will
 428  * force word-alignment and we'll miss the pointer.
 429  */
 430 void
 431 Perl_save_pptr(pTHX_ char **pptr)
 432 {
 433     dVAR;
 434
 435     PERL_ARGS_ASSERT_SAVE_PPTR;
 436
 437     SSCHECK(3);
 438     SSPUSHPTR(*pptr);
 439     SSPUSHPTR(pptr);
 440     SSPUSHINT(SAVEt_PPTR);
 441 }
 442
 443 void
 444 Perl_save_vptr(pTHX_ void *ptr)
 445 {
 446     dVAR;
 447
 448     PERL_ARGS_ASSERT_SAVE_VPTR;
 449
 450     SSCHECK(3);
 451     SSPUSHPTR(*(char**)ptr);
 452     SSPUSHPTR(ptr);
 453     SSPUSHINT(SAVEt_VPTR);
 454 }
 455
 456 void
 457 Perl_save_sptr(pTHX_ SV **sptr)
 458 {
 459     dVAR;
 460
 461     PERL_ARGS_ASSERT_SAVE_SPTR;
 462
 463     SSCHECK(3);
 464     SSPUSHPTR(*sptr);
 465     SSPUSHPTR(sptr);
 466     SSPUSHINT(SAVEt_SPTR);
 467 }
 468
 469 void
 470 Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
 471 {
 472     dVAR;
 473     SSCHECK(4);
 474     ASSERT_CURPAD_ACTIVE("save_padsv");
 475     SSPUSHPTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
 476     SSPUSHPTR(PL_comppad);
 477     SSPUSHLONG((long)off);
 478     SSPUSHINT(SAVEt_PADSV_AND_MORTALIZE);
 479 }
 480
 481 void
 482 Perl_save_hptr(pTHX_ HV **hptr)
 483 {
 484     dVAR;
 485
 486     PERL_ARGS_ASSERT_SAVE_HPTR;
 487
 488     SSCHECK(3);
 489     SSPUSHPTR(*hptr);
 490     SSPUSHPTR(hptr);
 491     SSPUSHINT(SAVEt_HPTR);
 492 }
 493
 494 void
 495 Perl_save_aptr(pTHX_ AV **aptr)
 496 {
 497     dVAR;
 498
 499     PERL_ARGS_ASSERT_SAVE_APTR;
 500
 501     SSCHECK(3);
 502     SSPUSHPTR(*aptr);
 503     SSPUSHPTR(aptr);
 504     SSPUSHINT(SAVEt_APTR);
 505 }
 506
 507 void
 508 Perl_save_freesv(pTHX_ SV *sv)
 509 {
 510     dVAR;
 511     SSCHECK(2);
 512     SSPUSHPTR(sv);
 513     SSPUSHINT(SAVEt_FREESV);
 514 }
 515
 516 void
 517 Perl_save_mortalizesv(pTHX_ SV *sv)
 518 {
 519     dVAR;
 520
 521     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
 522
 523     SSCHECK(2);
 524     SSPUSHPTR(sv);
 525     SSPUSHINT(SAVEt_MORTALIZESV);
 526 }
 527
 528 void
 529 Perl_save_freeop(pTHX_ OP *o)
 530 {
 531     dVAR;
 532     SSCHECK(2);
 533     SSPUSHPTR(o);
 534     SSPUSHINT(SAVEt_FREEOP);
 535 }
 536
 537 void
 538 Perl_save_freepv(pTHX_ char *pv)
 539 {
 540     dVAR;
 541     SSCHECK(2);
 542     SSPUSHPTR(pv);
 543     SSPUSHINT(SAVEt_FREEPV);
 544 }
 545
 546 void
 547 Perl_save_clearsv(pTHX_ SV **svp)
 548 {
 549     dVAR;
 550
 551     PERL_ARGS_ASSERT_SAVE_CLEARSV;
 552
 553     ASSERT_CURPAD_ACTIVE("save_clearsv");
 554     SSCHECK(2);
 555     SSPUSHLONG((long)(svp-PL_curpad));
 556     SSPUSHINT(SAVEt_CLEARSV);
 557     SvPADSTALE_off(*svp); /* mark lexical as active */
 558 }
 559
 560 void
 561 Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 562 {
 563     dVAR;
 564
 565     PERL_ARGS_ASSERT_SAVE_DELETE;
 566
 567     SSCHECK(4);
 568     SSPUSHINT(klen);
 569     SSPUSHPTR(key);
 570     SSPUSHPTR(SvREFCNT_inc_simple(hv));
 571     SSPUSHINT(SAVEt_DELETE);
 572 }
 573
 574 void
 575 Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 576 {
 577     dVAR;
 578
 579     PERL_ARGS_ASSERT_SAVE_DESTRUCTOR;
 580
 581     SSCHECK(3);
 582     SSPUSHDPTR(f);
 583     SSPUSHPTR(p);
 584     SSPUSHINT(SAVEt_DESTRUCTOR);
 585 }
 586
 587 void
 588 Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
 589 {
 590     dVAR;
 591     SSCHECK(3);
 592     SSPUSHDXPTR(f);
 593     SSPUSHPTR(p);
 594     SSPUSHINT(SAVEt_DESTRUCTOR_X);
 595 }
 596
 597 void
 598 Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
 599 {
 600     dVAR;
 601     SV *sv;
 602
 603     PERL_ARGS_ASSERT_SAVE_AELEM;
 604
 605     SvGETMAGIC(*sptr);
 606     SSCHECK(4);
 607     SSPUSHPTR(SvREFCNT_inc_simple(av));
 608     SSPUSHINT(idx);
 609     SSPUSHPTR(SvREFCNT_inc(*sptr));
 610     SSPUSHINT(SAVEt_AELEM);
 611     /* if it gets reified later, the restore will have the wrong refcnt */
 612     if (!AvREAL(av) && AvREIFY(av))
 613         SvREFCNT_inc_void(*sptr);
 614     save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 615     sv = *sptr;
 616     /* If we're localizing a tied array element, this new sv
 617      * won't actually be stored in the array - so it won't get
 618      * reaped when the localize ends. Ensure it gets reaped by
 619      * mortifying it instead. DAPM */
 620     if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
 621         sv_2mortal(sv);
 622 }
 623
 624 void
 625 Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
 626 {
 627     dVAR;
 628     SV *sv;
 629
 630     PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS;
 631
 632     SvGETMAGIC(*sptr);
 633     SSCHECK(4);
 634     SSPUSHPTR(SvREFCNT_inc_simple(hv));
 635     SSPUSHPTR(newSVsv(key));
 636     SSPUSHPTR(SvREFCNT_inc(*sptr));
 637     SSPUSHINT(SAVEt_HELEM);
 638     save_scalar_at(sptr, flags);
 639     sv = *sptr;
 640     /* If we're localizing a tied hash element, this new sv
 641      * won't actually be stored in the hash - so it won't get
 642      * reaped when the localize ends. Ensure it gets reaped by
 643      * mortifying it instead. DAPM */
 644     if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
 645         sv_2mortal(sv);
 646 }
 647
 648 SV*
 649 Perl_save_svref(pTHX_ SV **sptr)
 650 {
 651     dVAR;
 652
 653     PERL_ARGS_ASSERT_SAVE_SVREF;
 654
 655     SvGETMAGIC(*sptr);
 656     SSCHECK(3);
 657     SSPUSHPTR(sptr);
 658     SSPUSHPTR(SvREFCNT_inc(*sptr));
 659     SSPUSHINT(SAVEt_SVREF);
 660     return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 661 }
 662
 663 void
 664 Perl_save_op(pTHX)
 665 {
 666     dVAR;
 667     SSCHECK(2);
 668     SSPUSHPTR(PL_op);
 669     SSPUSHINT(SAVEt_OP);
 670 }
 671
 672 I32
 673 Perl_save_alloc(pTHX_ I32 size, I32 pad)
 674 {
 675     dVAR;
 676     register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
 677                                 - (char*)PL_savestack);
 678     register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
 679
 680     SSGROW(elems + 2);
 681
 682     PL_savestack_ix += elems;
 683     SSPUSHINT(elems);
 684     SSPUSHINT(SAVEt_ALLOC);
 685     return start;
 686 }
 687
 688 void
 689 Perl_leave_scope(pTHX_ I32 base)
 690 {
 691     dVAR;
 692     register SV *sv;
 693     register SV *value;
 694     register GV *gv;
 695     register AV *av;
 696     register HV *hv;
 697     void* ptr;
 698     register char* str;
 699     I32 i;
 700
 701     TAINT_NOT;
 702
 703     if (base < -1)
 704         Perl_croak(aTHX_ "panic: corrupt saved stack index");
 705     while (PL_savestack_ix > base) {
 706         switch (SSPOPINT) {
 707         case SAVEt_ITEM:                        /* normal string */
 708             value = MUTABLE_SV(SSPOPPTR);
 709             sv = MUTABLE_SV(SSPOPPTR);
 710             sv_replace(sv,value);
 711             PL_localizing = 2;
 712             SvSETMAGIC(sv);
 713             PL_localizing = 0;
 714             break;
 715         case SAVEt_SV:                          /* scalar reference */
 716             value = MUTABLE_SV(SSPOPPTR);
 717             gv = MUTABLE_GV(SSPOPPTR);
 718             ptr = &GvSV(gv);
 719             av = MUTABLE_AV(gv); /* what to refcnt_dec */
 720         restore_sv:
 721             sv = *(SV**)ptr;
 722             *(SV**)ptr = value;
 723             SvREFCNT_dec(sv);
 724             PL_localizing = 2;
 725             SvSETMAGIC(value);
 726             PL_localizing = 0;
 727             SvREFCNT_dec(value);
 728             if (av) /* actually an av, hv or gv */
 729                 SvREFCNT_dec(av);
 730             break;
 731         case SAVEt_GENERIC_PVREF:               /* generic pv */
 732             ptr = SSPOPPTR;
 733             str = (char*)SSPOPPTR;
 734             if (*(char**)ptr != str) {
 735                 Safefree(*(char**)ptr);
 736                 *(char**)ptr = str;
 737             }
 738             break;
 739         case SAVEt_SHARED_PVREF:                /* shared pv */
 740             str = (char*)SSPOPPTR;
 741             ptr = SSPOPPTR;
 742             if (*(char**)ptr != str) {
 743 #ifdef NETWARE
 744                 PerlMem_free(*(char**)ptr);
 745 #else
 746                 PerlMemShared_free(*(char**)ptr);
 747 #endif
 748                 *(char**)ptr = str;
 749             }
 750             break;
 751         case SAVEt_GENERIC_SVREF:               /* generic sv */
 752             value = MUTABLE_SV(SSPOPPTR);
 753             ptr = SSPOPPTR;
 754             sv = *(SV**)ptr;
 755             *(SV**)ptr = value;
 756             SvREFCNT_dec(sv);
 757             SvREFCNT_dec(value);
 758             break;
 759         case SAVEt_AV:                          /* array reference */
 760             av = MUTABLE_AV(SSPOPPTR);
 761             gv = MUTABLE_GV(SSPOPPTR);
 762             if (GvAV(gv)) {
 763                 SvREFCNT_dec(GvAV(gv));
 764             }
 765             GvAV(gv) = av;
 766             if (SvMAGICAL(av)) {
 767                 PL_localizing = 2;
 768                 SvSETMAGIC(MUTABLE_SV(av));
 769                 PL_localizing = 0;
 770             }
 771             break;
 772         case SAVEt_HV:                          /* hash reference */
 773             hv = MUTABLE_HV(SSPOPPTR);
 774             gv = MUTABLE_GV(SSPOPPTR);
 775             if (GvHV(gv)) {
 776                 SvREFCNT_dec(GvHV(gv));
 777             }
 778             GvHV(gv) = hv;
 779             if (SvMAGICAL(hv)) {
 780                 PL_localizing = 2;
 781                 SvSETMAGIC(MUTABLE_SV(hv));
 782                 PL_localizing = 0;
 783             }
 784             break;
 785         case SAVEt_INT:                         /* int reference */
 786             ptr = SSPOPPTR;
 787             *(int*)ptr = (int)SSPOPINT;
 788             break;
 789         case SAVEt_BOOL:                        /* bool reference */
 790             ptr = SSPOPPTR;
 791             *(bool*)ptr = (bool)SSPOPBOOL;
 792             break;
 793         case SAVEt_I32:                         /* I32 reference */
 794             ptr = SSPOPPTR;
 795 #ifdef PERL_DEBUG_READONLY_OPS
 796             {
 797                 const I32 val = SSPOPINT;
 798                 if (*(I32*)ptr != val)
 799                     *(I32*)ptr = val;
 800             }
 801 #else
 802             *(I32*)ptr = (I32)SSPOPINT;
 803 #endif
 804             break;
 805         case SAVEt_SPTR:                        /* SV* reference */
 806             ptr = SSPOPPTR;
 807             *(SV**)ptr = MUTABLE_SV(SSPOPPTR);
 808             break;
 809         case SAVEt_VPTR:                        /* random* reference */
 810         case SAVEt_PPTR:                        /* char* reference */
 811             ptr = SSPOPPTR;
 812             *(char**)ptr = (char*)SSPOPPTR;
 813             break;
 814         case SAVEt_HPTR:                        /* HV* reference */
 815             ptr = SSPOPPTR;
 816             *(HV**)ptr = MUTABLE_HV(SSPOPPTR);
 817             break;
 818         case SAVEt_APTR:                        /* AV* reference */
 819             ptr = SSPOPPTR;
 820             *(AV**)ptr = MUTABLE_AV(SSPOPPTR);
 821             break;
 822         case SAVEt_GP:                          /* scalar reference */
 823             ptr = SSPOPPTR;
 824             gv = MUTABLE_GV(SSPOPPTR);
 825             gp_free(gv);
 826             GvGP(gv) = (GP*)ptr;
 827             /* putting a method back into circulation ("local")*/
 828             if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
 829                 mro_method_changed_in(hv);
 830             SvREFCNT_dec(gv);
 831             break;
 832         case SAVEt_FREESV:
 833             ptr = SSPOPPTR;
 834             SvREFCNT_dec(MUTABLE_SV(ptr));
 835             break;
 836         case SAVEt_MORTALIZESV:
 837             ptr = SSPOPPTR;
 838             sv_2mortal(MUTABLE_SV(ptr));
 839             break;
 840         case SAVEt_FREEOP:
 841             ptr = SSPOPPTR;
 842             ASSERT_CURPAD_LEGAL("SAVEt_FREEOP"); /* XXX DAPM tmp */
 843             op_free((OP*)ptr);
 844             break;
 845         case SAVEt_FREEPV:
 846             ptr = SSPOPPTR;
 847             Safefree(ptr);
 848             break;
 849         case SAVEt_CLEARSV:
 850             ptr = (void*)&PL_curpad[SSPOPLONG];
 851             sv = *(SV**)ptr;
 852
 853             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 854              "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
 855                 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
 856                 (long)((SV **)ptr-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
 857                 (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
 858             ));
 859
 860             /* Can clear pad variable in place? */
 861             if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
 862                 /*
 863                  * if a my variable that was made readonly is going out of
 864                  * scope, we want to remove the readonlyness so that it can
 865                  * go out of scope quietly
 866                  */
 867                 if (SvPADMY(sv) && !SvFAKE(sv))
 868                     SvREADONLY_off(sv);
 869
 870                 if (SvTHINKFIRST(sv))
 871                     sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
 872                 if (SvMAGICAL(sv))
 873                     mg_free(sv);
 874
 875                 switch (SvTYPE(sv)) {
 876                 case SVt_NULL:
 877                     break;
 878                 case SVt_PVAV:
 879                     av_clear(MUTABLE_AV(sv));
 880                     break;
 881                 case SVt_PVHV:
 882                     hv_clear(MUTABLE_HV(sv));
 883                     break;
 884                 case SVt_PVCV:
 885                     Perl_croak(aTHX_ "panic: leave_scope pad code");
 886                 default:
 887                     SvOK_off(sv);
 888                     break;
 889                 }
 890                 SvPADSTALE_on(sv); /* mark as no longer live */
 891             }
 892             else {      /* Someone has a claim on this, so abandon it. */
 893                 const U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP);
 894                 switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
 895                 case SVt_PVAV:  *(SV**)ptr = MUTABLE_SV(newAV());       break;
 896                 case SVt_PVHV:  *(SV**)ptr = MUTABLE_SV(newHV());       break;
 897                 default:        *(SV**)ptr = newSV(0);          break;
 898                 }
 899                 SvREFCNT_dec(sv);       /* Cast current value to the winds. */
 900                 /* preserve pad nature, but also mark as not live
 901                  * for any closure capturing */
 902                 SvFLAGS(*(SV**)ptr) |= padflags | SVs_PADSTALE;
 903             }
 904             break;
 905         case SAVEt_DELETE:
 906             ptr = SSPOPPTR;
 907             hv = MUTABLE_HV(ptr);
 908             ptr = SSPOPPTR;
 909             (void)hv_delete(hv, (char*)ptr, (I32)SSPOPINT, G_DISCARD);
 910             SvREFCNT_dec(hv);
 911             Safefree(ptr);
 912             break;
 913         case SAVEt_DESTRUCTOR_X:
 914             ptr = SSPOPPTR;
 915             (*SSPOPDXPTR)(aTHX_ ptr);
 916             break;
 917         case SAVEt_REGCONTEXT:
 918         case SAVEt_ALLOC:
 919             i = SSPOPINT;
 920             PL_savestack_ix -= i;       /* regexp must have croaked */
 921             break;
 922         case SAVEt_STACK_POS:           /* Position on Perl stack */
 923             i = SSPOPINT;
 924             PL_stack_sp = PL_stack_base + i;
 925             break;
 926         case SAVEt_STACK_CXPOS:         /* blk_oldsp on context stack */
 927             i = SSPOPINT;
 928             cxstack[i].blk_oldsp = SSPOPINT;
 929             break;
 930         case SAVEt_AELEM:               /* array element */
 931             value = MUTABLE_SV(SSPOPPTR);
 932             i = SSPOPINT;
 933             av = MUTABLE_AV(SSPOPPTR);
 934             ptr = av_fetch(av,i,1);
 935             if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */
 936                 SvREFCNT_dec(value);
 937             if (ptr) {
 938                 sv = *(SV**)ptr;
 939                 if (sv && sv != &PL_sv_undef) {
 940                     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
 941                         SvREFCNT_inc_void_NN(sv);
 942                     goto restore_sv;
 943                 }
 944             }
 945             SvREFCNT_dec(av);
 946             SvREFCNT_dec(value);
 947             break;
 948         case SAVEt_HELEM:               /* hash element */
 949             value = MUTABLE_SV(SSPOPPTR);
 950             sv = MUTABLE_SV(SSPOPPTR);
 951             hv = MUTABLE_HV(SSPOPPTR);
 952             ptr = hv_fetch_ent(hv, sv, 1, 0);
 953             if (ptr) {
 954                 const SV * const oval = HeVAL((HE*)ptr);
 955                 if (oval && oval != &PL_sv_undef) {
 956                     ptr = &HeVAL((HE*)ptr);
 957                     if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))
 958                         SvREFCNT_inc_void(*(SV**)ptr);
 959                     SvREFCNT_dec(sv);
 960                     av = MUTABLE_AV(hv); /* what to refcnt_dec */
 961                     goto restore_sv;
 962                 }
 963             }
 964             SvREFCNT_dec(hv);
 965             SvREFCNT_dec(sv);
 966             SvREFCNT_dec(value);
 967             break;
 968         case SAVEt_OP:
 969             PL_op = (OP*)SSPOPPTR;
 970             break;
 971         case SAVEt_HINTS:
 972             if ((PL_hints & HINT_LOCALIZE_HH) && GvHV(PL_hintgv)) {
 973                 SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
 974                 GvHV(PL_hintgv) = NULL;
 975             }
 976             *(I32*)&PL_hints = (I32)SSPOPINT;
 977             Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
 978             PL_compiling.cop_hints_hash = (struct refcounted_he *) SSPOPPTR;
 979             if (PL_hints & HINT_LOCALIZE_HH) {
 980                 SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
 981                 GvHV(PL_hintgv) = MUTABLE_HV(SSPOPPTR);
 982                 assert(GvHV(PL_hintgv));
 983             } else if (!GvHV(PL_hintgv)) {
 984                 /* Need to add a new one manually, else gv_fetchpv() can
 985                    add one in this code:
 986
 987                    if (SvTYPE(gv) == SVt_PVGV) {
 988                        if (add) {
 989                        GvMULTI_on(gv);
 990                        gv_init_sv(gv, sv_type);
 991                        if (*name=='!' && sv_type == SVt_PVHV && len==1)
 992                            require_errno(gv);
 993                        }
 994                        return gv;
 995                    }
 996
 997                    and it won't have the magic set.  */
 998
 999                 HV *const hv = newHV();
1000                 hv_magic(hv, NULL, PERL_MAGIC_hints);
1001                 GvHV(PL_hintgv) = hv;
1002             }
1003             assert(GvHV(PL_hintgv));
1004             break;
1005         case SAVEt_COMPPAD:
1006             PL_comppad = (PAD*)SSPOPPTR;
1007             if (PL_comppad)
1008                 PL_curpad = AvARRAY(PL_comppad);
1009             else
1010                 PL_curpad = NULL;
1011             break;
1012         case SAVEt_PADSV_AND_MORTALIZE:
1013             {
1014                 const PADOFFSET off = (PADOFFSET)SSPOPLONG;
1015                 SV **svp;
1016                 ptr = SSPOPPTR;
1017                 assert (ptr);
1018                 svp = AvARRAY((PAD*)ptr) + off;
1019                 /* This mortalizing used to be done by POPLOOP() via itersave.
1020                    But as we have all the information here, we can do it here,
1021                    save even having to have itersave in the struct.  */
1022                 sv_2mortal(*svp);
1023                 *svp = MUTABLE_SV(SSPOPPTR);
1024             }
1025             break;
1026         case SAVEt_SAVESWITCHSTACK:
1027             {
1028                 dSP;
1029                 AV *const t = MUTABLE_AV(SSPOPPTR);
1030                 AV *const f = MUTABLE_AV(SSPOPPTR);
1031                 SWITCHSTACK(t,f);
1032                 PL_curstackinfo->si_stack = f;
1033             }
1034             break;
1035         case SAVEt_SET_SVFLAGS:
1036             {
1037                 const U32 val  = (U32)SSPOPINT;
1038                 const U32 mask = (U32)SSPOPINT;
1039                 sv = MUTABLE_SV(SSPOPPTR);
1040                 SvFLAGS(sv) &= ~mask;
1041                 SvFLAGS(sv) |= val;
1042             }
1043             break;
1044
1045             /* This would be a mathom, but Perl_save_svref() calls a static
1046                function, S_save_scalar_at(), so has to stay in this file.  */
1047         case SAVEt_SVREF:                       /* scalar reference */
1048             value = MUTABLE_SV(SSPOPPTR);
1049             ptr = SSPOPPTR;
1050             av = NULL; /* what to refcnt_dec */
1051             goto restore_sv;
1052
1053             /* These are only saved in mathoms.c */
1054         case SAVEt_NSTAB:
1055             gv = MUTABLE_GV(SSPOPPTR);
1056             (void)sv_clear(MUTABLE_SV(gv));
1057             break;
1058         case SAVEt_LONG:                        /* long reference */
1059             ptr = SSPOPPTR;
1060             *(long*)ptr = (long)SSPOPLONG;
1061             break;
1062         case SAVEt_IV:                          /* IV reference */
1063             ptr = SSPOPPTR;
1064             *(IV*)ptr = (IV)SSPOPIV;
1065             break;
1066
1067         case SAVEt_I16:                         /* I16 reference */
1068             ptr = SSPOPPTR;
1069             *(I16*)ptr = (I16)SSPOPINT;
1070             break;
1071         case SAVEt_I8:                          /* I8 reference */
1072             ptr = SSPOPPTR;
1073             *(I8*)ptr = (I8)SSPOPINT;
1074             break;
1075         case SAVEt_DESTRUCTOR:
1076             ptr = SSPOPPTR;
1077             (*SSPOPDPTR)(ptr);
1078             break;
1079         case SAVEt_COP_ARYBASE:
1080             ptr = SSPOPPTR;
1081             i = SSPOPINT;
1082             CopARYBASE_set((COP *)ptr, i);
1083             break;
1084         case SAVEt_COMPILE_WARNINGS:
1085             ptr = SSPOPPTR;
1086
1087             if (!specialWARN(PL_compiling.cop_warnings))
1088                 PerlMemShared_free(PL_compiling.cop_warnings);
1089
1090             PL_compiling.cop_warnings = (STRLEN*)ptr;
1091             break;
1092         case SAVEt_RE_STATE:
1093             {
1094                 const struct re_save_state *const state
1095                     = (struct re_save_state *)
1096                     (PL_savestack + PL_savestack_ix
1097                      - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
1098                 PL_savestack_ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
1099
1100                 if (PL_reg_start_tmp != state->re_state_reg_start_tmp) {
1101                     Safefree(PL_reg_start_tmp);
1102                 }
1103                 if (PL_reg_poscache != state->re_state_reg_poscache) {
1104                     Safefree(PL_reg_poscache);
1105                 }
1106                 Copy(state, &PL_reg_state, 1, struct re_save_state);
1107             }
1108             break;
1109         case SAVEt_PARSER:
1110             ptr = SSPOPPTR;
1111             parser_free((yy_parser *) ptr);
1112             break;
1113         default:
1114             Perl_croak(aTHX_ "panic: leave_scope inconsistency");
1115         }
1116     }
1117 }
1118
1119 void
1120 Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
1121 {
1122     dVAR;
1123
1124     PERL_ARGS_ASSERT_CX_DUMP;
1125
1126 #ifdef DEBUGGING
1127     PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
1128     if (CxTYPE(cx) != CXt_SUBST) {
1129         PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
1130         PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
1131                       PTR2UV(cx->blk_oldcop));
1132         PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
1133         PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
1134         PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
1135                       PTR2UV(cx->blk_oldpm));
1136         PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
1137     }
1138     switch (CxTYPE(cx)) {
1139     case CXt_NULL:
1140     case CXt_BLOCK:
1141         break;
1142     case CXt_FORMAT:
1143         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%"UVxf"\n",
1144                 PTR2UV(cx->blk_format.cv));
1145         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%"UVxf"\n",
1146                 PTR2UV(cx->blk_format.gv));
1147         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%"UVxf"\n",
1148                 PTR2UV(cx->blk_format.dfoutgv));
1149         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n",
1150                       (int)CxHASARGS(cx));
1151         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%"UVxf"\n",
1152                 PTR2UV(cx->blk_format.retop));
1153         break;
1154     case CXt_SUB:
1155         PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
1156                 PTR2UV(cx->blk_sub.cv));
1157         PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
1158                 (long)cx->blk_sub.olddepth);
1159         PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
1160                 (int)CxHASARGS(cx));
1161         PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx));
1162         PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
1163                 PTR2UV(cx->blk_sub.retop));
1164         break;
1165     case CXt_EVAL:
1166         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
1167                 (long)CxOLD_IN_EVAL(cx));
1168         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
1169                 PL_op_name[CxOLD_OP_TYPE(cx)],
1170                 PL_op_desc[CxOLD_OP_TYPE(cx)]);
1171         if (cx->blk_eval.old_namesv)
1172             PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
1173                           SvPVX_const(cx->blk_eval.old_namesv));
1174         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
1175                 PTR2UV(cx->blk_eval.old_eval_root));
1176         PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n",
1177                 PTR2UV(cx->blk_eval.retop));
1178         break;
1179
1180     case CXt_LOOP_LAZYIV:
1181     case CXt_LOOP_LAZYSV:
1182     case CXt_LOOP_FOR:
1183     case CXt_LOOP_PLAIN:
1184         PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx));
1185         PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
1186                 (long)cx->blk_loop.resetsp);
1187         PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
1188                 PTR2UV(cx->blk_loop.my_op));
1189         PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
1190                 PTR2UV(CX_LOOP_NEXTOP_GET(cx)));
1191         /* XXX: not accurate for LAZYSV/IV */
1192         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
1193                 PTR2UV(cx->blk_loop.state_u.ary.ary));
1194         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
1195                 (long)cx->blk_loop.state_u.ary.ix);
1196         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
1197                 PTR2UV(CxITERVAR(cx)));
1198         break;
1199
1200     case CXt_SUBST:
1201         PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
1202                 (long)cx->sb_iters);
1203         PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
1204                 (long)cx->sb_maxiters);
1205         PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
1206                 (long)cx->sb_rflags);
1207         PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
1208                 (long)CxONCE(cx));
1209         PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
1210                 cx->sb_orig);
1211         PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
1212                 PTR2UV(cx->sb_dstr));
1213         PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
1214                 PTR2UV(cx->sb_targ));
1215         PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
1216                 PTR2UV(cx->sb_s));
1217         PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
1218                 PTR2UV(cx->sb_m));
1219         PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
1220                 PTR2UV(cx->sb_strend));
1221         PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
1222                 PTR2UV(cx->sb_rxres));
1223         break;
1224     }
1225 #else
1226     PERL_UNUSED_CONTEXT;
1227     PERL_UNUSED_ARG(cx);
1228 #endif  /* DEBUGGING */
1229 }
1230
1231 /*
1232  * Local variables:
1233  * c-indentation-style: bsd
1234  * c-basic-offset: 4
1235  * indent-tabs-mode: t
1236  * End:
1237  *
1238  * ex: set ts=8 sts=4 sw=4 noet:
1239  */