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     if (base < -1)
 702         Perl_croak(aTHX_ "panic: corrupt saved stack index");
 703     while (PL_savestack_ix > base) {
 704         switch (SSPOPINT) {
 705         case SAVEt_ITEM:                        /* normal string */
 706             value = MUTABLE_SV(SSPOPPTR);
 707             sv = MUTABLE_SV(SSPOPPTR);
 708             sv_replace(sv,value);
 709             PL_localizing = 2;
 710             SvSETMAGIC(sv);
 711             PL_localizing = 0;
 712             break;
 713         case SAVEt_SV:                          /* scalar reference */
 714             value = MUTABLE_SV(SSPOPPTR);
 715             gv = MUTABLE_GV(SSPOPPTR);
 716             ptr = &GvSV(gv);
 717             av = MUTABLE_AV(gv); /* what to refcnt_dec */
 718         restore_sv:
 719             sv = *(SV**)ptr;
 720             *(SV**)ptr = value;
 721             SvREFCNT_dec(sv);
 722             PL_localizing = 2;
 723             SvSETMAGIC(value);
 724             PL_localizing = 0;
 725             SvREFCNT_dec(value);
 726             if (av) /* actually an av, hv or gv */
 727                 SvREFCNT_dec(av);
 728             break;
 729         case SAVEt_GENERIC_PVREF:               /* generic pv */
 730             ptr = SSPOPPTR;
 731             str = (char*)SSPOPPTR;
 732             if (*(char**)ptr != str) {
 733                 Safefree(*(char**)ptr);
 734                 *(char**)ptr = str;
 735             }
 736             break;
 737         case SAVEt_SHARED_PVREF:                /* shared pv */
 738             str = (char*)SSPOPPTR;
 739             ptr = SSPOPPTR;
 740             if (*(char**)ptr != str) {
 741 #ifdef NETWARE
 742                 PerlMem_free(*(char**)ptr);
 743 #else
 744                 PerlMemShared_free(*(char**)ptr);
 745 #endif
 746                 *(char**)ptr = str;
 747             }
 748             break;
 749         case SAVEt_GENERIC_SVREF:               /* generic sv */
 750             value = MUTABLE_SV(SSPOPPTR);
 751             ptr = SSPOPPTR;
 752             sv = *(SV**)ptr;
 753             *(SV**)ptr = value;
 754             SvREFCNT_dec(sv);
 755             SvREFCNT_dec(value);
 756             break;
 757         case SAVEt_AV:                          /* array reference */
 758             av = MUTABLE_AV(SSPOPPTR);
 759             gv = MUTABLE_GV(SSPOPPTR);
 760             if (GvAV(gv)) {
 761                 SvREFCNT_dec(GvAV(gv));
 762             }
 763             GvAV(gv) = av;
 764             if (SvMAGICAL(av)) {
 765                 PL_localizing = 2;
 766                 SvSETMAGIC(MUTABLE_SV(av));
 767                 PL_localizing = 0;
 768             }
 769             break;
 770         case SAVEt_HV:                          /* hash reference */
 771             hv = MUTABLE_HV(SSPOPPTR);
 772             gv = MUTABLE_GV(SSPOPPTR);
 773             if (GvHV(gv)) {
 774                 SvREFCNT_dec(GvHV(gv));
 775             }
 776             GvHV(gv) = hv;
 777             if (SvMAGICAL(hv)) {
 778                 PL_localizing = 2;
 779                 SvSETMAGIC(MUTABLE_SV(hv));
 780                 PL_localizing = 0;
 781             }
 782             break;
 783         case SAVEt_INT:                         /* int reference */
 784             ptr = SSPOPPTR;
 785             *(int*)ptr = (int)SSPOPINT;
 786             break;
 787         case SAVEt_BOOL:                        /* bool reference */
 788             ptr = SSPOPPTR;
 789             *(bool*)ptr = (bool)SSPOPBOOL;
 790             break;
 791         case SAVEt_I32:                         /* I32 reference */
 792             ptr = SSPOPPTR;
 793 #ifdef PERL_DEBUG_READONLY_OPS
 794             {
 795                 const I32 val = SSPOPINT;
 796                 if (*(I32*)ptr != val)
 797                     *(I32*)ptr = val;
 798             }
 799 #else
 800             *(I32*)ptr = (I32)SSPOPINT;
 801 #endif
 802             break;
 803         case SAVEt_SPTR:                        /* SV* reference */
 804             ptr = SSPOPPTR;
 805             *(SV**)ptr = MUTABLE_SV(SSPOPPTR);
 806             break;
 807         case SAVEt_VPTR:                        /* random* reference */
 808         case SAVEt_PPTR:                        /* char* reference */
 809             ptr = SSPOPPTR;
 810             *(char**)ptr = (char*)SSPOPPTR;
 811             break;
 812         case SAVEt_HPTR:                        /* HV* reference */
 813             ptr = SSPOPPTR;
 814             *(HV**)ptr = MUTABLE_HV(SSPOPPTR);
 815             break;
 816         case SAVEt_APTR:                        /* AV* reference */
 817             ptr = SSPOPPTR;
 818             *(AV**)ptr = MUTABLE_AV(SSPOPPTR);
 819             break;
 820         case SAVEt_GP:                          /* scalar reference */
 821             ptr = SSPOPPTR;
 822             gv = MUTABLE_GV(SSPOPPTR);
 823             gp_free(gv);
 824             GvGP(gv) = (GP*)ptr;
 825             /* putting a method back into circulation ("local")*/
 826             if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
 827                 mro_method_changed_in(hv);
 828             SvREFCNT_dec(gv);
 829             break;
 830         case SAVEt_FREESV:
 831             ptr = SSPOPPTR;
 832             SvREFCNT_dec(MUTABLE_SV(ptr));
 833             break;
 834         case SAVEt_MORTALIZESV:
 835             ptr = SSPOPPTR;
 836             sv_2mortal(MUTABLE_SV(ptr));
 837             break;
 838         case SAVEt_FREEOP:
 839             ptr = SSPOPPTR;
 840             ASSERT_CURPAD_LEGAL("SAVEt_FREEOP"); /* XXX DAPM tmp */
 841             op_free((OP*)ptr);
 842             break;
 843         case SAVEt_FREEPV:
 844             ptr = SSPOPPTR;
 845             Safefree(ptr);
 846             break;
 847         case SAVEt_CLEARSV:
 848             ptr = (void*)&PL_curpad[SSPOPLONG];
 849             sv = *(SV**)ptr;
 850
 851             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 852              "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
 853                 PTR2UV(PL_comppad), PTR2UV(PL_curpad),
 854                 (long)((SV **)ptr-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
 855                 (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
 856             ));
 857
 858             /* Can clear pad variable in place? */
 859             if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
 860                 /*
 861                  * if a my variable that was made readonly is going out of
 862                  * scope, we want to remove the readonlyness so that it can
 863                  * go out of scope quietly
 864                  */
 865                 if (SvPADMY(sv) && !SvFAKE(sv))
 866                     SvREADONLY_off(sv);
 867
 868                 if (SvTHINKFIRST(sv))
 869                     sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
 870                 if (SvMAGICAL(sv))
 871                     mg_free(sv);
 872
 873                 switch (SvTYPE(sv)) {
 874                 case SVt_NULL:
 875                     break;
 876                 case SVt_PVAV:
 877                     av_clear(MUTABLE_AV(sv));
 878                     break;
 879                 case SVt_PVHV:
 880                     hv_clear(MUTABLE_HV(sv));
 881                     break;
 882                 case SVt_PVCV:
 883                     Perl_croak(aTHX_ "panic: leave_scope pad code");
 884                 default:
 885                     SvOK_off(sv);
 886                     break;
 887                 }
 888                 SvPADSTALE_on(sv); /* mark as no longer live */
 889             }
 890             else {      /* Someone has a claim on this, so abandon it. */
 891                 const U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP);
 892                 switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
 893                 case SVt_PVAV:  *(SV**)ptr = MUTABLE_SV(newAV());       break;
 894                 case SVt_PVHV:  *(SV**)ptr = MUTABLE_SV(newHV());       break;
 895                 default:        *(SV**)ptr = newSV(0);          break;
 896                 }
 897                 SvREFCNT_dec(sv);       /* Cast current value to the winds. */
 898                 /* preserve pad nature, but also mark as not live
 899                  * for any closure capturing */
 900                 SvFLAGS(*(SV**)ptr) |= padflags | SVs_PADSTALE;
 901             }
 902             break;
 903         case SAVEt_DELETE:
 904             ptr = SSPOPPTR;
 905             hv = MUTABLE_HV(ptr);
 906             ptr = SSPOPPTR;
 907             (void)hv_delete(hv, (char*)ptr, (I32)SSPOPINT, G_DISCARD);
 908             SvREFCNT_dec(hv);
 909             Safefree(ptr);
 910             break;
 911         case SAVEt_DESTRUCTOR_X:
 912             ptr = SSPOPPTR;
 913             (*SSPOPDXPTR)(aTHX_ ptr);
 914             break;
 915         case SAVEt_REGCONTEXT:
 916         case SAVEt_ALLOC:
 917             i = SSPOPINT;
 918             PL_savestack_ix -= i;       /* regexp must have croaked */
 919             break;
 920         case SAVEt_STACK_POS:           /* Position on Perl stack */
 921             i = SSPOPINT;
 922             PL_stack_sp = PL_stack_base + i;
 923             break;
 924         case SAVEt_STACK_CXPOS:         /* blk_oldsp on context stack */
 925             i = SSPOPINT;
 926             cxstack[i].blk_oldsp = SSPOPINT;
 927             break;
 928         case SAVEt_AELEM:               /* array element */
 929             value = MUTABLE_SV(SSPOPPTR);
 930             i = SSPOPINT;
 931             av = MUTABLE_AV(SSPOPPTR);
 932             ptr = av_fetch(av,i,1);
 933             if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */
 934                 SvREFCNT_dec(value);
 935             if (ptr) {
 936                 sv = *(SV**)ptr;
 937                 if (sv && sv != &PL_sv_undef) {
 938                     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
 939                         SvREFCNT_inc_void_NN(sv);
 940                     goto restore_sv;
 941                 }
 942             }
 943             SvREFCNT_dec(av);
 944             SvREFCNT_dec(value);
 945             break;
 946         case SAVEt_HELEM:               /* hash element */
 947             value = MUTABLE_SV(SSPOPPTR);
 948             sv = MUTABLE_SV(SSPOPPTR);
 949             hv = MUTABLE_HV(SSPOPPTR);
 950             ptr = hv_fetch_ent(hv, sv, 1, 0);
 951             if (ptr) {
 952                 const SV * const oval = HeVAL((HE*)ptr);
 953                 if (oval && oval != &PL_sv_undef) {
 954                     ptr = &HeVAL((HE*)ptr);
 955                     if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))
 956                         SvREFCNT_inc_void(*(SV**)ptr);
 957                     SvREFCNT_dec(sv);
 958                     av = MUTABLE_AV(hv); /* what to refcnt_dec */
 959                     goto restore_sv;
 960                 }
 961             }
 962             SvREFCNT_dec(hv);
 963             SvREFCNT_dec(sv);
 964             SvREFCNT_dec(value);
 965             break;
 966         case SAVEt_OP:
 967             PL_op = (OP*)SSPOPPTR;
 968             break;
 969         case SAVEt_HINTS:
 970             if ((PL_hints & HINT_LOCALIZE_HH) && GvHV(PL_hintgv)) {
 971                 SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
 972                 GvHV(PL_hintgv) = NULL;
 973             }
 974             *(I32*)&PL_hints = (I32)SSPOPINT;
 975             Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
 976             PL_compiling.cop_hints_hash = (struct refcounted_he *) SSPOPPTR;
 977             if (PL_hints & HINT_LOCALIZE_HH) {
 978                 SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
 979                 GvHV(PL_hintgv) = MUTABLE_HV(SSPOPPTR);
 980                 assert(GvHV(PL_hintgv));
 981             } else if (!GvHV(PL_hintgv)) {
 982                 /* Need to add a new one manually, else gv_fetchpv() can
 983                    add one in this code:
 984
 985                    if (SvTYPE(gv) == SVt_PVGV) {
 986                        if (add) {
 987                        GvMULTI_on(gv);
 988                        gv_init_sv(gv, sv_type);
 989                        if (*name=='!' && sv_type == SVt_PVHV && len==1)
 990                            require_errno(gv);
 991                        }
 992                        return gv;
 993                    }
 994
 995                    and it won't have the magic set.  */
 996
 997                 HV *const hv = newHV();
 998                 hv_magic(hv, NULL, PERL_MAGIC_hints);
 999                 GvHV(PL_hintgv) = hv;
1000             }
1001             assert(GvHV(PL_hintgv));
1002             break;
1003         case SAVEt_COMPPAD:
1004             PL_comppad = (PAD*)SSPOPPTR;
1005             if (PL_comppad)
1006                 PL_curpad = AvARRAY(PL_comppad);
1007             else
1008                 PL_curpad = NULL;
1009             break;
1010         case SAVEt_PADSV_AND_MORTALIZE:
1011             {
1012                 const PADOFFSET off = (PADOFFSET)SSPOPLONG;
1013                 SV **svp;
1014                 ptr = SSPOPPTR;
1015                 assert (ptr);
1016                 svp = AvARRAY((PAD*)ptr) + off;
1017                 /* This mortalizing used to be done by POPLOOP() via itersave.
1018                    But as we have all the information here, we can do it here,
1019                    save even having to have itersave in the struct.  */
1020                 sv_2mortal(*svp);
1021                 *svp = MUTABLE_SV(SSPOPPTR);
1022             }
1023             break;
1024         case SAVEt_SAVESWITCHSTACK:
1025             {
1026                 dSP;
1027                 AV *const t = MUTABLE_AV(SSPOPPTR);
1028                 AV *const f = MUTABLE_AV(SSPOPPTR);
1029                 SWITCHSTACK(t,f);
1030                 PL_curstackinfo->si_stack = f;
1031             }
1032             break;
1033         case SAVEt_SET_SVFLAGS:
1034             {
1035                 const U32 val  = (U32)SSPOPINT;
1036                 const U32 mask = (U32)SSPOPINT;
1037                 sv = MUTABLE_SV(SSPOPPTR);
1038                 SvFLAGS(sv) &= ~mask;
1039                 SvFLAGS(sv) |= val;
1040             }
1041             break;
1042
1043             /* This would be a mathom, but Perl_save_svref() calls a static
1044                function, S_save_scalar_at(), so has to stay in this file.  */
1045         case SAVEt_SVREF:                       /* scalar reference */
1046             value = MUTABLE_SV(SSPOPPTR);
1047             ptr = SSPOPPTR;
1048             av = NULL; /* what to refcnt_dec */
1049             goto restore_sv;
1050
1051             /* These are only saved in mathoms.c */
1052         case SAVEt_NSTAB:
1053             gv = MUTABLE_GV(SSPOPPTR);
1054             (void)sv_clear(MUTABLE_SV(gv));
1055             break;
1056         case SAVEt_LONG:                        /* long reference */
1057             ptr = SSPOPPTR;
1058             *(long*)ptr = (long)SSPOPLONG;
1059             break;
1060         case SAVEt_IV:                          /* IV reference */
1061             ptr = SSPOPPTR;
1062             *(IV*)ptr = (IV)SSPOPIV;
1063             break;
1064
1065         case SAVEt_I16:                         /* I16 reference */
1066             ptr = SSPOPPTR;
1067             *(I16*)ptr = (I16)SSPOPINT;
1068             break;
1069         case SAVEt_I8:                          /* I8 reference */
1070             ptr = SSPOPPTR;
1071             *(I8*)ptr = (I8)SSPOPINT;
1072             break;
1073         case SAVEt_DESTRUCTOR:
1074             ptr = SSPOPPTR;
1075             (*SSPOPDPTR)(ptr);
1076             break;
1077         case SAVEt_COP_ARYBASE:
1078             ptr = SSPOPPTR;
1079             i = SSPOPINT;
1080             CopARYBASE_set((COP *)ptr, i);
1081             break;
1082         case SAVEt_COMPILE_WARNINGS:
1083             ptr = SSPOPPTR;
1084
1085             if (!specialWARN(PL_compiling.cop_warnings))
1086                 PerlMemShared_free(PL_compiling.cop_warnings);
1087
1088             PL_compiling.cop_warnings = (STRLEN*)ptr;
1089             break;
1090         case SAVEt_RE_STATE:
1091             {
1092                 const struct re_save_state *const state
1093                     = (struct re_save_state *)
1094                     (PL_savestack + PL_savestack_ix
1095                      - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
1096                 PL_savestack_ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
1097
1098                 if (PL_reg_start_tmp != state->re_state_reg_start_tmp) {
1099                     Safefree(PL_reg_start_tmp);
1100                 }
1101                 if (PL_reg_poscache != state->re_state_reg_poscache) {
1102                     Safefree(PL_reg_poscache);
1103                 }
1104                 Copy(state, &PL_reg_state, 1, struct re_save_state);
1105             }
1106             break;
1107         case SAVEt_PARSER:
1108             ptr = SSPOPPTR;
1109             parser_free((yy_parser *) ptr);
1110             break;
1111         default:
1112             Perl_croak(aTHX_ "panic: leave_scope inconsistency");
1113         }
1114     }
1115 }
1116
1117 void
1118 Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
1119 {
1120     dVAR;
1121
1122     PERL_ARGS_ASSERT_CX_DUMP;
1123
1124 #ifdef DEBUGGING
1125     PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
1126     if (CxTYPE(cx) != CXt_SUBST) {
1127         PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
1128         PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
1129                       PTR2UV(cx->blk_oldcop));
1130         PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
1131         PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
1132         PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
1133                       PTR2UV(cx->blk_oldpm));
1134         PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
1135     }
1136     switch (CxTYPE(cx)) {
1137     case CXt_NULL:
1138     case CXt_BLOCK:
1139         break;
1140     case CXt_FORMAT:
1141         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%"UVxf"\n",
1142                 PTR2UV(cx->blk_format.cv));
1143         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%"UVxf"\n",
1144                 PTR2UV(cx->blk_format.gv));
1145         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%"UVxf"\n",
1146                 PTR2UV(cx->blk_format.dfoutgv));
1147         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n",
1148                       (int)CxHASARGS(cx));
1149         PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%"UVxf"\n",
1150                 PTR2UV(cx->blk_format.retop));
1151         break;
1152     case CXt_SUB:
1153         PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
1154                 PTR2UV(cx->blk_sub.cv));
1155         PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
1156                 (long)cx->blk_sub.olddepth);
1157         PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
1158                 (int)CxHASARGS(cx));
1159         PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx));
1160         PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
1161                 PTR2UV(cx->blk_sub.retop));
1162         break;
1163     case CXt_EVAL:
1164         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
1165                 (long)CxOLD_IN_EVAL(cx));
1166         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
1167                 PL_op_name[CxOLD_OP_TYPE(cx)],
1168                 PL_op_desc[CxOLD_OP_TYPE(cx)]);
1169         if (cx->blk_eval.old_namesv)
1170             PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
1171                           SvPVX_const(cx->blk_eval.old_namesv));
1172         PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
1173                 PTR2UV(cx->blk_eval.old_eval_root));
1174         PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n",
1175                 PTR2UV(cx->blk_eval.retop));
1176         break;
1177
1178     case CXt_LOOP_LAZYIV:
1179     case CXt_LOOP_LAZYSV:
1180     case CXt_LOOP_FOR:
1181     case CXt_LOOP_PLAIN:
1182         PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx));
1183         PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
1184                 (long)cx->blk_loop.resetsp);
1185         PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
1186                 PTR2UV(cx->blk_loop.my_op));
1187         PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
1188                 PTR2UV(CX_LOOP_NEXTOP_GET(cx)));
1189         /* XXX: not accurate for LAZYSV/IV */
1190         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
1191                 PTR2UV(cx->blk_loop.state_u.ary.ary));
1192         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
1193                 (long)cx->blk_loop.state_u.ary.ix);
1194         PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
1195                 PTR2UV(CxITERVAR(cx)));
1196         break;
1197
1198     case CXt_SUBST:
1199         PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n",
1200                 (long)cx->sb_iters);
1201         PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
1202                 (long)cx->sb_maxiters);
1203         PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
1204                 (long)cx->sb_rflags);
1205         PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
1206                 (long)CxONCE(cx));
1207         PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
1208                 cx->sb_orig);
1209         PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
1210                 PTR2UV(cx->sb_dstr));
1211         PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
1212                 PTR2UV(cx->sb_targ));
1213         PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
1214                 PTR2UV(cx->sb_s));
1215         PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
1216                 PTR2UV(cx->sb_m));
1217         PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
1218                 PTR2UV(cx->sb_strend));
1219         PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
1220                 PTR2UV(cx->sb_rxres));
1221         break;
1222     }
1223 #else
1224     PERL_UNUSED_CONTEXT;
1225     PERL_UNUSED_ARG(cx);
1226 #endif  /* DEBUGGING */
1227 }
1228
1229 /*
1230  * Local variables:
1231  * c-indentation-style: bsd
1232  * c-basic-offset: 4
1233  * indent-tabs-mode: t
1234  * End:
1235  *
1236  * ex: set ts=8 sts=4 sw=4 noet:
1237  */