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