X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=35caf3f1de5a2748701ce955491c87b25bef3871;hb=1cd66f7c5bbf47a0c9c6f45b3eae3670bbe447db;hp=a64ec3e86d3b3e19a57b41a1b0d34b0dcb30d826;hpb=51d9a56bf5df931c436b7ede535c78bc64655187;p=p5sagit%2Fp5-mst-13.2.git diff --git a/scope.c b/scope.c index a64ec3e..35caf3f 100644 --- a/scope.c +++ b/scope.c @@ -1,6 +1,7 @@ /* scope.c * - * Copyright (c) 1991-2003, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -12,44 +13,24 @@ * levels..." */ +/* This file contains functions to manipulate several of Perl's stacks; + * in particular it contains code to push various types of things onto + * the savestack, then to pop them off and perform the correct restorative + * action for each one. This corresponds to the cleanup Perl does at + * each scope exit. + */ + #include "EXTERN.h" #define PERL_IN_SCOPE_C #include "perl.h" -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -void * -Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, - protect_body_t body, ...) -{ - void *ret; - va_list args; - va_start(args, body); - ret = vdefault_protect(pcur_env, excpt, body, &args); - va_end(args); - return ret; -} - -void * -Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, - protect_body_t body, va_list *args) -{ - int ex; - void *ret; - - JMPENV_PUSH(ex); - if (ex) - ret = NULL; - else - ret = CALL_FPTR(body)(aTHX_ *args); - *excpt = ex; - JMPENV_POP; - return ret; -} -#endif - SV** Perl_stack_grow(pTHX_ SV **sp, SV **p, int n) { + dVAR; + + PERL_ARGS_ASSERT_STACK_GROW; + PL_stack_sp = sp; #ifndef STRESS_REALLOC av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128); @@ -68,8 +49,9 @@ Perl_stack_grow(pTHX_ SV **sp, SV **p, int n) PERL_SI * Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) { + dVAR; PERL_SI *si; - New(56, si, 1, PERL_SI); + Newx(si, 1, PERL_SI); si->si_stack = newAV(); AvREAL_off(si->si_stack); av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0); @@ -80,47 +62,30 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) si->si_cxmax = cxitems - 1; si->si_cxix = -1; si->si_type = PERLSI_UNDEF; - New(56, si->si_cxstack, cxitems, PERL_CONTEXT); + Newx(si->si_cxstack, cxitems, PERL_CONTEXT); /* Without any kind of initialising PUSHSUBST() * in pp_subst() will read uninitialised heap. */ - Poison(si->si_cxstack, cxitems, PERL_CONTEXT); + PoisonNew(si->si_cxstack, cxitems, PERL_CONTEXT); return si; } I32 Perl_cxinc(pTHX) { - IV old_max = cxstack_max; + dVAR; + const IV old_max = cxstack_max; cxstack_max = GROW(cxstack_max); Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */ /* Without any kind of initialising deep enough recursion * will end up reading uninitialised PERL_CONTEXTs. */ - Poison(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT); + PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT); return cxstack_ix + 1; } void -Perl_push_return(pTHX_ OP *retop) -{ - if (PL_retstack_ix == PL_retstack_max) { - PL_retstack_max = GROW(PL_retstack_max); - Renew(PL_retstack, PL_retstack_max, OP*); - } - PL_retstack[PL_retstack_ix++] = retop; -} - -OP * -Perl_pop_return(pTHX) -{ - if (PL_retstack_ix > 0) - return PL_retstack[--PL_retstack_ix]; - else - return Nullop; -} - -void Perl_push_scope(pTHX) { + dVAR; if (PL_scopestack_ix == PL_scopestack_max) { PL_scopestack_max = GROW(PL_scopestack_max); Renew(PL_scopestack, PL_scopestack_max, I32); @@ -132,15 +97,17 @@ Perl_push_scope(pTHX) void Perl_pop_scope(pTHX) { - I32 oldsave = PL_scopestack[--PL_scopestack_ix]; + dVAR; + const I32 oldsave = PL_scopestack[--PL_scopestack_ix]; LEAVE_SCOPE(oldsave); } void Perl_markstack_grow(pTHX) { - I32 oldmax = PL_markstack_max - PL_markstack; - I32 newmax = GROW(oldmax); + dVAR; + const I32 oldmax = PL_markstack_max - PL_markstack; + const I32 newmax = GROW(oldmax); Renew(PL_markstack, newmax, I32); PL_markstack_ptr = PL_markstack + oldmax; @@ -150,15 +117,25 @@ Perl_markstack_grow(pTHX) void Perl_savestack_grow(pTHX) { + dVAR; PL_savestack_max = GROW(PL_savestack_max) + 4; Renew(PL_savestack, PL_savestack_max, ANY); } +void +Perl_savestack_grow_cnt(pTHX_ I32 need) +{ + dVAR; + PL_savestack_max = PL_savestack_ix + need; + Renew(PL_savestack, PL_savestack_max, ANY); +} + #undef GROW void Perl_tmps_grow(pTHX_ I32 n) { + dVAR; #ifndef STRESS_REALLOC if (n < 128) n = (PL_tmps_max < 512) ? 128 : 512; @@ -171,11 +148,12 @@ Perl_tmps_grow(pTHX_ I32 n) void Perl_free_tmps(pTHX) { + dVAR; /* XXX should tmps_floor live in cxstack? */ - I32 myfloor = PL_tmps_floor; + const I32 myfloor = PL_tmps_floor; while (PL_tmps_ix > myfloor) { /* clean up after last statement */ - SV* sv = PL_tmps_stack[PL_tmps_ix]; - PL_tmps_stack[PL_tmps_ix--] = Nullsv; + SV* const sv = PL_tmps_stack[PL_tmps_ix]; + PL_tmps_stack[PL_tmps_ix--] = NULL; if (sv && sv != &PL_sv_undef) { SvTEMP_off(sv); SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */ @@ -186,33 +164,20 @@ Perl_free_tmps(pTHX) STATIC SV * S_save_scalar_at(pTHX_ SV **sptr) { - register SV *sv; - SV *osv = *sptr; + dVAR; + SV * const osv = *sptr; + register SV * const sv = *sptr = newSV(0); + + PERL_ARGS_ASSERT_SAVE_SCALAR_AT; - sv = *sptr = NEWSV(0,0); if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) { - sv_upgrade(sv, SvTYPE(osv)); if (SvGMAGICAL(osv)) { - MAGIC* mg; - bool oldtainted = PL_tainted; - mg_get(osv); /* note, can croak! */ - if (PL_tainting && PL_tainted && - (mg = mg_find(osv, PERL_MAGIC_taint))) { - SAVESPTR(mg->mg_obj); - mg->mg_obj = osv; - } + const bool oldtainted = PL_tainted; SvFLAGS(osv) |= (SvFLAGS(osv) & - (SVp_NOK|SVp_POK)) >> PRIVSHIFT; + (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; PL_tainted = oldtainted; } - SvMAGIC(sv) = SvMAGIC(osv); - SvFLAGS(sv) |= SvMAGICAL(osv); - /* XXX SvMAGIC() is *shared* between osv and sv. This can - * lead to coredumps when both SVs are destroyed without one - * of their SvMAGIC() slots being NULLed. */ - PL_localizing = 1; - SvSETMAGIC(sv); - PL_localizing = 0; + mg_localize(osv, sv); } return sv; } @@ -220,21 +185,18 @@ S_save_scalar_at(pTHX_ SV **sptr) SV * Perl_save_scalar(pTHX_ GV *gv) { - SV **sptr = &GvSV(gv); - SSCHECK(3); - SSPUSHPTR(SvREFCNT_inc(gv)); - SSPUSHPTR(SvREFCNT_inc(*sptr)); - SSPUSHINT(SAVEt_SV); - return save_scalar_at(sptr); -} + dVAR; + SV ** const sptr = &GvSVn(gv); -SV* -Perl_save_svref(pTHX_ SV **sptr) -{ + PERL_ARGS_ASSERT_SAVE_SCALAR; + + PL_localizing = 1; + SvGETMAGIC(*sptr); + PL_localizing = 0; SSCHECK(3); - SSPUSHPTR(sptr); + SSPUSHPTR(SvREFCNT_inc_simple(gv)); SSPUSHPTR(SvREFCNT_inc(*sptr)); - SSPUSHINT(SAVEt_SVREF); + SSPUSHINT(SAVEt_SV); return save_scalar_at(sptr); } @@ -243,6 +205,10 @@ Perl_save_svref(pTHX_ SV **sptr) void Perl_save_generic_svref(pTHX_ SV **sptr) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF; + SSCHECK(3); SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); @@ -255,9 +221,13 @@ Perl_save_generic_svref(pTHX_ SV **sptr) void Perl_save_generic_pvref(pTHX_ char **str) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF; + SSCHECK(3); - SSPUSHPTR(str); SSPUSHPTR(*str); + SSPUSHPTR(str); SSPUSHINT(SAVEt_GENERIC_PVREF); } @@ -267,41 +237,62 @@ Perl_save_generic_pvref(pTHX_ char **str) void Perl_save_shared_pvref(pTHX_ char **str) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_SHARED_PVREF; + SSCHECK(3); SSPUSHPTR(str); SSPUSHPTR(*str); SSPUSHINT(SAVEt_SHARED_PVREF); } +/* set the SvFLAGS specified by mask to the values in val */ + +void +Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val) +{ + dVAR; + + PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS; + + SSCHECK(4); + SSPUSHPTR(sv); + SSPUSHINT(mask); + SSPUSHINT(val); + SSPUSHINT(SAVEt_SET_SVFLAGS); +} + void Perl_save_gp(pTHX_ GV *gv, I32 empty) { - SSCHECK(6); - SSPUSHIV((IV)SvLEN(gv)); - SvLEN(gv) = 0; /* forget that anything was allocated here */ - SSPUSHIV((IV)SvCUR(gv)); - SSPUSHPTR(SvPVX(gv)); - SvPOK_off(gv); + dVAR; + + PERL_ARGS_ASSERT_SAVE_GP; + + SSGROW(3); SSPUSHPTR(SvREFCNT_inc(gv)); SSPUSHPTR(GvGP(gv)); SSPUSHINT(SAVEt_GP); if (empty) { - register GP *gp; - - Newz(602, gp, 1, GP); + GP *gp = Perl_newGP(aTHX_ gv); if (GvCVu(gv)) - PL_sub_generation++; /* taking a method out of circulation */ + mro_method_changed_in(GvSTASH(gv)); /* taking a method out of circulation ("local")*/ if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) { gp->gp_io = newIO(); IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START; } - GvGP(gv) = gp_ref(gp); - GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = CopLINE(PL_curcop); - GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; - GvEGV(gv) = gv; +#ifdef PERL_DONT_CREATE_GVSV + if (gv == PL_errgv) { + /* We could scatter this logic everywhere by changing the + definition of ERRSV from GvSV() to GvSVn(), but it seems more + efficient to do this check once here. */ + gp->gp_sv = newSV(0); + } +#endif + GvGP(gv) = gp; } else { gp_ref(GvGP(gv)); @@ -312,9 +303,12 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) AV * Perl_save_ary(pTHX_ GV *gv) { - AV *oav = GvAVn(gv); + dVAR; + AV * const oav = GvAVn(gv); AV *av; + PERL_ARGS_ASSERT_SAVE_ARY; + if (!AvREAL(oav) && AvREIFY(oav)) av_reify(oav); SSCHECK(3); @@ -322,50 +316,41 @@ Perl_save_ary(pTHX_ GV *gv) SSPUSHPTR(oav); SSPUSHINT(SAVEt_AV); - GvAV(gv) = Null(AV*); + GvAV(gv) = NULL; av = GvAVn(gv); - if (SvMAGIC(oav)) { - SvMAGIC(av) = SvMAGIC(oav); - SvFLAGS((SV*)av) |= SvMAGICAL(oav); - SvMAGICAL_off(oav); - SvMAGIC(oav) = 0; - PL_localizing = 1; - SvSETMAGIC((SV*)av); - PL_localizing = 0; - } + if (SvMAGIC(oav)) + mg_localize((SV*)oav, (SV*)av); return av; } HV * Perl_save_hash(pTHX_ GV *gv) { + dVAR; HV *ohv, *hv; + PERL_ARGS_ASSERT_SAVE_HASH; + SSCHECK(3); SSPUSHPTR(gv); SSPUSHPTR(ohv = GvHVn(gv)); SSPUSHINT(SAVEt_HV); - GvHV(gv) = Null(HV*); + GvHV(gv) = NULL; hv = GvHVn(gv); - if (SvMAGIC(ohv)) { - SvMAGIC(hv) = SvMAGIC(ohv); - SvFLAGS((SV*)hv) |= SvMAGICAL(ohv); - SvMAGICAL_off(ohv); - SvMAGIC(ohv) = 0; - PL_localizing = 1; - SvSETMAGIC((SV*)hv); - PL_localizing = 0; - } + if (SvMAGIC(ohv)) + mg_localize((SV*)ohv, (SV*)hv); return hv; } void Perl_save_item(pTHX_ register SV *item) { - register SV *sv = NEWSV(0,0); + dVAR; + register SV * const sv = newSVsv(item); + + PERL_ARGS_ASSERT_SAVE_ITEM; - sv_setsv(sv,item); SSCHECK(3); SSPUSHPTR(item); /* remember the pointer */ SSPUSHPTR(sv); /* remember the value */ @@ -375,6 +360,10 @@ Perl_save_item(pTHX_ register SV *item) void Perl_save_int(pTHX_ int *intp) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_INT; + SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -382,17 +371,12 @@ Perl_save_int(pTHX_ int *intp) } void -Perl_save_long(pTHX_ long int *longp) -{ - SSCHECK(3); - SSPUSHLONG(*longp); - SSPUSHPTR(longp); - SSPUSHINT(SAVEt_LONG); -} - -void Perl_save_bool(pTHX_ bool *boolp) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_BOOL; + SSCHECK(3); SSPUSHBOOL(*boolp); SSPUSHPTR(boolp); @@ -400,17 +384,25 @@ Perl_save_bool(pTHX_ bool *boolp) } void -Perl_save_I32(pTHX_ I32 *intp) +Perl_save_I8(pTHX_ I8 *bytep) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_I8; + SSCHECK(3); - SSPUSHINT(*intp); - SSPUSHPTR(intp); - SSPUSHINT(SAVEt_I32); + SSPUSHINT(*bytep); + SSPUSHPTR(bytep); + SSPUSHINT(SAVEt_I8); } void Perl_save_I16(pTHX_ I16 *intp) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_I16; + SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -418,21 +410,16 @@ Perl_save_I16(pTHX_ I16 *intp) } void -Perl_save_I8(pTHX_ I8 *bytep) +Perl_save_I32(pTHX_ I32 *intp) { - SSCHECK(3); - SSPUSHINT(*bytep); - SSPUSHPTR(bytep); - SSPUSHINT(SAVEt_I8); -} + dVAR; + + PERL_ARGS_ASSERT_SAVE_I32; -void -Perl_save_iv(pTHX_ IV *ivp) -{ SSCHECK(3); - SSPUSHIV(*ivp); - SSPUSHPTR(ivp); - SSPUSHINT(SAVEt_IV); + SSPUSHINT(*intp); + SSPUSHPTR(intp); + SSPUSHINT(SAVEt_I32); } /* Cannot use save_sptr() to store a char* since the SV** cast will @@ -441,6 +428,10 @@ Perl_save_iv(pTHX_ IV *ivp) void Perl_save_pptr(pTHX_ char **pptr) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_PPTR; + SSCHECK(3); SSPUSHPTR(*pptr); SSPUSHPTR(pptr); @@ -450,6 +441,10 @@ Perl_save_pptr(pTHX_ char **pptr) void Perl_save_vptr(pTHX_ void *ptr) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_VPTR; + SSCHECK(3); SSPUSHPTR(*(char**)ptr); SSPUSHPTR(ptr); @@ -459,6 +454,10 @@ Perl_save_vptr(pTHX_ void *ptr) void Perl_save_sptr(pTHX_ SV **sptr) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_SPTR; + SSCHECK(3); SSPUSHPTR(*sptr); SSPUSHPTR(sptr); @@ -466,34 +465,24 @@ Perl_save_sptr(pTHX_ SV **sptr) } void -Perl_save_padsv(pTHX_ PADOFFSET off) +Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off) { + dVAR; SSCHECK(4); ASSERT_CURPAD_ACTIVE("save_padsv"); - SSPUSHPTR(PL_curpad[off]); + SSPUSHPTR(SvREFCNT_inc_simple_NN(PL_curpad[off])); SSPUSHPTR(PL_comppad); SSPUSHLONG((long)off); - SSPUSHINT(SAVEt_PADSV); -} - -SV ** -Perl_save_threadsv(pTHX_ PADOFFSET i) -{ - Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl"); - return 0; -} - -void -Perl_save_nogv(pTHX_ GV *gv) -{ - SSCHECK(2); - SSPUSHPTR(gv); - SSPUSHINT(SAVEt_NSTAB); + SSPUSHINT(SAVEt_PADSV_AND_MORTALIZE); } void Perl_save_hptr(pTHX_ HV **hptr) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_HPTR; + SSCHECK(3); SSPUSHPTR(*hptr); SSPUSHPTR(hptr); @@ -503,6 +492,10 @@ Perl_save_hptr(pTHX_ HV **hptr) void Perl_save_aptr(pTHX_ AV **aptr) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_APTR; + SSCHECK(3); SSPUSHPTR(*aptr); SSPUSHPTR(aptr); @@ -512,6 +505,7 @@ Perl_save_aptr(pTHX_ AV **aptr) void Perl_save_freesv(pTHX_ SV *sv) { + dVAR; SSCHECK(2); SSPUSHPTR(sv); SSPUSHINT(SAVEt_FREESV); @@ -520,6 +514,10 @@ Perl_save_freesv(pTHX_ SV *sv) void Perl_save_mortalizesv(pTHX_ SV *sv) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_MORTALIZESV; + SSCHECK(2); SSPUSHPTR(sv); SSPUSHINT(SAVEt_MORTALIZESV); @@ -528,6 +526,7 @@ Perl_save_mortalizesv(pTHX_ SV *sv) void Perl_save_freeop(pTHX_ OP *o) { + dVAR; SSCHECK(2); SSPUSHPTR(o); SSPUSHINT(SAVEt_FREEOP); @@ -536,6 +535,7 @@ Perl_save_freeop(pTHX_ OP *o) void Perl_save_freepv(pTHX_ char *pv) { + dVAR; SSCHECK(2); SSPUSHPTR(pv); SSPUSHINT(SAVEt_FREEPV); @@ -544,6 +544,10 @@ Perl_save_freepv(pTHX_ char *pv) void Perl_save_clearsv(pTHX_ SV **svp) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_CLEARSV; + ASSERT_CURPAD_ACTIVE("save_clearsv"); SSCHECK(2); SSPUSHLONG((long)(svp-PL_curpad)); @@ -554,32 +558,24 @@ Perl_save_clearsv(pTHX_ SV **svp) void Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_DELETE; + SSCHECK(4); SSPUSHINT(klen); SSPUSHPTR(key); - SSPUSHPTR(SvREFCNT_inc(hv)); + SSPUSHPTR(SvREFCNT_inc_simple(hv)); SSPUSHINT(SAVEt_DELETE); } void -Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) -{ - register SV *sv; - register I32 i; - - for (i = 1; i <= maxsarg; i++) { - sv = NEWSV(0,0); - sv_setsv(sv,sarg[i]); - SSCHECK(3); - SSPUSHPTR(sarg[i]); /* remember the pointer */ - SSPUSHPTR(sv); /* remember the value */ - SSPUSHINT(SAVEt_ITEM); - } -} - -void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) { + dVAR; + + PERL_ARGS_ASSERT_SAVE_DESTRUCTOR; + SSCHECK(3); SSPUSHDPTR(f); SSPUSHPTR(p); @@ -589,6 +585,7 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) { + dVAR; SSCHECK(3); SSPUSHDXPTR(f); SSPUSHPTR(p); @@ -598,15 +595,20 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) void Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) { + dVAR; SV *sv; + + PERL_ARGS_ASSERT_SAVE_AELEM; + + SvGETMAGIC(*sptr); SSCHECK(4); - SSPUSHPTR(SvREFCNT_inc(av)); + SSPUSHPTR(SvREFCNT_inc_simple(av)); SSPUSHINT(idx); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_AELEM); /* if it gets reified later, the restore will have the wrong refcnt */ if (!AvREAL(av) && AvREIFY(av)) - SvREFCNT_inc(*sptr); + SvREFCNT_inc_void(*sptr); save_scalar_at(sptr); sv = *sptr; /* If we're localizing a tied array element, this new sv @@ -620,10 +622,15 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) { + dVAR; SV *sv; + + PERL_ARGS_ASSERT_SAVE_HELEM; + + SvGETMAGIC(*sptr); SSCHECK(4); - SSPUSHPTR(SvREFCNT_inc(hv)); - SSPUSHPTR(SvREFCNT_inc(key)); + SSPUSHPTR(SvREFCNT_inc_simple(hv)); + SSPUSHPTR(newSVsv(key)); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_HELEM); save_scalar_at(sptr); @@ -636,9 +643,25 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) sv_2mortal(sv); } +SV* +Perl_save_svref(pTHX_ SV **sptr) +{ + dVAR; + + PERL_ARGS_ASSERT_SAVE_SVREF; + + SvGETMAGIC(*sptr); + SSCHECK(3); + SSPUSHPTR(sptr); + SSPUSHPTR(SvREFCNT_inc(*sptr)); + SSPUSHINT(SAVEt_SVREF); + return save_scalar_at(sptr); +} + void Perl_save_op(pTHX) { + dVAR; SSCHECK(2); SSPUSHPTR(PL_op); SSPUSHINT(SAVEt_OP); @@ -647,13 +670,12 @@ Perl_save_op(pTHX) I32 Perl_save_alloc(pTHX_ I32 size, I32 pad) { - register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] + dVAR; + register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] - (char*)PL_savestack); - register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); + register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); - /* SSCHECK may not be good enough */ - while (PL_savestack_ix + elems + 2 > PL_savestack_max) - savestack_grow(); + SSGROW(elems + 2); PL_savestack_ix += elems; SSPUSHINT(elems); @@ -664,12 +686,13 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad) void Perl_leave_scope(pTHX_ I32 base) { + dVAR; register SV *sv; register SV *value; register GV *gv; register AV *av; register HV *hv; - register void* ptr; + void* ptr; register char* str; I32 i; @@ -690,10 +713,20 @@ Perl_leave_scope(pTHX_ I32 base) gv = (GV*)SSPOPPTR; ptr = &GvSV(gv); av = (AV*)gv; /* what to refcnt_dec */ - goto restore_sv; + restore_sv: + sv = *(SV**)ptr; + *(SV**)ptr = value; + SvREFCNT_dec(sv); + PL_localizing = 2; + SvSETMAGIC(value); + PL_localizing = 0; + SvREFCNT_dec(value); + if (av) /* actually an av, hv or gv */ + SvREFCNT_dec(av); + break; case SAVEt_GENERIC_PVREF: /* generic pv */ - str = (char*)SSPOPPTR; ptr = SSPOPPTR; + str = (char*)SSPOPPTR; if (*(char**)ptr != str) { Safefree(*(char**)ptr); *(char**)ptr = str; @@ -719,58 +752,11 @@ Perl_leave_scope(pTHX_ I32 base) SvREFCNT_dec(sv); SvREFCNT_dec(value); break; - case SAVEt_SVREF: /* scalar reference */ - value = (SV*)SSPOPPTR; - ptr = SSPOPPTR; - av = Nullav; /* what to refcnt_dec */ - restore_sv: - sv = *(SV**)ptr; - DEBUG_S(PerlIO_printf(Perl_debug_log, - "restore svref: %p %p:%s -> %p:%s\n", - ptr, sv, SvPEEK(sv), value, SvPEEK(value))); - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && - SvTYPE(sv) != SVt_PVGV) - { - (void)SvUPGRADE(value, SvTYPE(sv)); - SvMAGIC(value) = SvMAGIC(sv); - SvFLAGS(value) |= SvMAGICAL(sv); - SvMAGICAL_off(sv); - SvMAGIC(sv) = 0; - } - /* XXX This branch is pretty bogus. This code irretrievably - * clears(!) the magic on the SV (either to avoid further - * croaking that might ensue when the SvSETMAGIC() below is - * called, or to avoid two different SVs pointing at the same - * SvMAGIC()). This needs a total rethink. --GSAR */ - else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) && - SvTYPE(value) != SVt_PVGV) - { - SvFLAGS(value) |= (SvFLAGS(value) & - (SVp_NOK|SVp_POK)) >> PRIVSHIFT; - SvMAGICAL_off(value); - /* XXX this is a leak when we get here because the - * mg_get() in save_scalar_at() croaked */ - SvMAGIC(value) = 0; - } - SvREFCNT_dec(sv); - *(SV**)ptr = value; - PL_localizing = 2; - SvSETMAGIC(value); - PL_localizing = 0; - SvREFCNT_dec(value); - if (av) /* actually an av, hv or gv */ - SvREFCNT_dec(av); - break; case SAVEt_AV: /* array reference */ av = (AV*)SSPOPPTR; gv = (GV*)SSPOPPTR; if (GvAV(gv)) { - AV *goner = GvAV(gv); - SvMAGIC(av) = SvMAGIC(goner); - SvFLAGS((SV*)av) |= SvMAGICAL(goner); - SvMAGICAL_off(goner); - SvMAGIC(goner) = 0; - SvREFCNT_dec(goner); + SvREFCNT_dec(GvAV(gv)); } GvAV(gv) = av; if (SvMAGICAL(av)) { @@ -783,12 +769,7 @@ Perl_leave_scope(pTHX_ I32 base) hv = (HV*)SSPOPPTR; gv = (GV*)SSPOPPTR; if (GvHV(gv)) { - HV *goner = GvHV(gv); - SvMAGIC(hv) = SvMAGIC(goner); - SvFLAGS(hv) |= SvMAGICAL(goner); - SvMAGICAL_off(goner); - SvMAGIC(goner) = 0; - SvREFCNT_dec(goner); + SvREFCNT_dec(GvHV(gv)); } GvHV(gv) = hv; if (SvMAGICAL(hv)) { @@ -801,29 +782,21 @@ Perl_leave_scope(pTHX_ I32 base) ptr = SSPOPPTR; *(int*)ptr = (int)SSPOPINT; break; - case SAVEt_LONG: /* long reference */ - ptr = SSPOPPTR; - *(long*)ptr = (long)SSPOPLONG; - break; case SAVEt_BOOL: /* bool reference */ ptr = SSPOPPTR; *(bool*)ptr = (bool)SSPOPBOOL; break; case SAVEt_I32: /* I32 reference */ ptr = SSPOPPTR; +#ifdef PERL_DEBUG_READONLY_OPS + { + const I32 val = SSPOPINT; + if (*(I32*)ptr != val) + *(I32*)ptr = val; + } +#else *(I32*)ptr = (I32)SSPOPINT; - break; - case SAVEt_I16: /* I16 reference */ - ptr = SSPOPPTR; - *(I16*)ptr = (I16)SSPOPINT; - break; - case SAVEt_I8: /* I8 reference */ - ptr = SSPOPPTR; - *(I8*)ptr = (I8)SSPOPINT; - break; - case SAVEt_IV: /* IV reference */ - ptr = SSPOPPTR; - *(IV*)ptr = (IV)SSPOPIV; +#endif break; case SAVEt_SPTR: /* SV* reference */ ptr = SSPOPPTR; @@ -842,23 +815,14 @@ Perl_leave_scope(pTHX_ I32 base) ptr = SSPOPPTR; *(AV**)ptr = (AV*)SSPOPPTR; break; - case SAVEt_NSTAB: - gv = (GV*)SSPOPPTR; - (void)sv_clear((SV*)gv); - break; case SAVEt_GP: /* scalar reference */ ptr = SSPOPPTR; gv = (GV*)SSPOPPTR; - if (SvPVX(gv) && SvLEN(gv) > 0) { - Safefree(SvPVX(gv)); - } - SvPVX(gv) = (char *)SSPOPPTR; - SvCUR(gv) = (STRLEN)SSPOPIV; - SvLEN(gv) = (STRLEN)SSPOPIV; gp_free(gv); GvGP(gv) = (GP*)ptr; - if (GvCVu(gv)) - PL_sub_generation++; /* putting a method back into circulation */ + /* putting a method back into circulation ("local")*/ + if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv)) + mro_method_changed_in(hv); SvREFCNT_dec(gv); break; case SAVEt_FREESV: @@ -876,7 +840,7 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_FREEPV: ptr = SSPOPPTR; - Safefree((char*)ptr); + Safefree(ptr); break; case SAVEt_CLEARSV: ptr = (void*)&PL_curpad[SSPOPLONG]; @@ -915,43 +879,33 @@ Perl_leave_scope(pTHX_ I32 base) break; case SVt_PVCV: Perl_croak(aTHX_ "panic: leave_scope pad code"); - case SVt_RV: - case SVt_IV: - case SVt_NV: - (void)SvOK_off(sv); - break; default: - (void)SvOK_off(sv); - (void)SvOOK_off(sv); + SvOK_off(sv); break; } SvPADSTALE_on(sv); /* mark as no longer live */ } else { /* Someone has a claim on this, so abandon it. */ - U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP); + const U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP); switch (SvTYPE(sv)) { /* Console ourselves with a new value */ case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break; case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break; - default: *(SV**)ptr = NEWSV(0,0); break; + default: *(SV**)ptr = newSV(0); break; } SvREFCNT_dec(sv); /* Cast current value to the winds. */ /* preserve pad nature, but also mark as not live * for any closure capturing */ - SvFLAGS(*(SV**)ptr) |= padflags & SVs_PADSTALE; + SvFLAGS(*(SV**)ptr) |= padflags | SVs_PADSTALE; } break; case SAVEt_DELETE: ptr = SSPOPPTR; hv = (HV*)ptr; ptr = SSPOPPTR; - (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD); + (void)hv_delete(hv, (char*)ptr, (I32)SSPOPINT, G_DISCARD); SvREFCNT_dec(hv); Safefree(ptr); break; - case SAVEt_DESTRUCTOR: - ptr = SSPOPPTR; - (*SSPOPDPTR)(ptr); - break; case SAVEt_DESTRUCTOR_X: ptr = SSPOPPTR; (*SSPOPDXPTR)(aTHX_ ptr); @@ -965,18 +919,22 @@ Perl_leave_scope(pTHX_ I32 base) i = SSPOPINT; PL_stack_sp = PL_stack_base + i; break; + case SAVEt_STACK_CXPOS: /* blk_oldsp on context stack */ + i = SSPOPINT; + cxstack[i].blk_oldsp = SSPOPINT; + break; case SAVEt_AELEM: /* array element */ value = (SV*)SSPOPPTR; i = SSPOPINT; av = (AV*)SSPOPPTR; + ptr = av_fetch(av,i,1); if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */ SvREFCNT_dec(value); - ptr = av_fetch(av,i,1); if (ptr) { sv = *(SV**)ptr; if (sv && sv != &PL_sv_undef) { if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) - (void)SvREFCNT_inc(sv); + SvREFCNT_inc_void_NN(sv); goto restore_sv; } } @@ -989,11 +947,11 @@ Perl_leave_scope(pTHX_ I32 base) hv = (HV*)SSPOPPTR; ptr = hv_fetch_ent(hv, sv, 1, 0); if (ptr) { - SV *oval = HeVAL((HE*)ptr); + const SV * const oval = HeVAL((HE*)ptr); if (oval && oval != &PL_sv_undef) { ptr = &HeVAL((HE*)ptr); if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) - (void)SvREFCNT_inc(*(SV**)ptr); + SvREFCNT_inc_void(*(SV**)ptr); SvREFCNT_dec(sv); av = (AV*)hv; /* what to refcnt_dec */ goto restore_sv; @@ -1012,22 +970,137 @@ Perl_leave_scope(pTHX_ I32 base) GvHV(PL_hintgv) = NULL; } *(I32*)&PL_hints = (I32)SSPOPINT; + Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash); + PL_compiling.cop_hints_hash = (struct refcounted_he *) SSPOPPTR; + if (PL_hints & HINT_LOCALIZE_HH) { + SvREFCNT_dec((SV*)GvHV(PL_hintgv)); + GvHV(PL_hintgv) = (HV*)SSPOPPTR; + assert(GvHV(PL_hintgv)); + } else if (!GvHV(PL_hintgv)) { + /* Need to add a new one manually, else gv_fetchpv() can + add one in this code: + + if (SvTYPE(gv) == SVt_PVGV) { + if (add) { + GvMULTI_on(gv); + gv_init_sv(gv, sv_type); + if (*name=='!' && sv_type == SVt_PVHV && len==1) + require_errno(gv); + } + return gv; + } + + and it won't have the magic set. */ + + HV *const hv = newHV(); + hv_magic(hv, NULL, PERL_MAGIC_hints); + GvHV(PL_hintgv) = hv; + } + assert(GvHV(PL_hintgv)); break; case SAVEt_COMPPAD: PL_comppad = (PAD*)SSPOPPTR; if (PL_comppad) PL_curpad = AvARRAY(PL_comppad); else - PL_curpad = Null(SV**); + PL_curpad = NULL; break; - case SAVEt_PADSV: + case SAVEt_PADSV_AND_MORTALIZE: { - PADOFFSET off = (PADOFFSET)SSPOPLONG; + const PADOFFSET off = (PADOFFSET)SSPOPLONG; + SV **svp; ptr = SSPOPPTR; - if (ptr) - AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR; + assert (ptr); + svp = AvARRAY((PAD*)ptr) + off; + /* This mortalizing used to be done by POPLOOP() via itersave. + But as we have all the information here, we can do it here, + save even having to have itersave in the struct. */ + sv_2mortal(*svp); + *svp = (SV*)SSPOPPTR; } break; + case SAVEt_SAVESWITCHSTACK: + { + dSP; + AV* const t = (AV*)SSPOPPTR; + AV* const f = (AV*)SSPOPPTR; + SWITCHSTACK(t,f); + PL_curstackinfo->si_stack = f; + } + break; + case SAVEt_SET_SVFLAGS: + { + const U32 val = (U32)SSPOPINT; + const U32 mask = (U32)SSPOPINT; + sv = (SV*)SSPOPPTR; + SvFLAGS(sv) &= ~mask; + SvFLAGS(sv) |= val; + } + break; + /* These are only saved in mathoms.c */ + case SAVEt_SVREF: /* scalar reference */ + value = (SV*)SSPOPPTR; + ptr = SSPOPPTR; + av = NULL; /* what to refcnt_dec */ + goto restore_sv; + case SAVEt_LONG: /* long reference */ + ptr = SSPOPPTR; + *(long*)ptr = (long)SSPOPLONG; + break; + case SAVEt_I16: /* I16 reference */ + ptr = SSPOPPTR; + *(I16*)ptr = (I16)SSPOPINT; + break; + case SAVEt_I8: /* I8 reference */ + ptr = SSPOPPTR; + *(I8*)ptr = (I8)SSPOPINT; + break; + case SAVEt_IV: /* IV reference */ + ptr = SSPOPPTR; + *(IV*)ptr = (IV)SSPOPIV; + break; + case SAVEt_NSTAB: + gv = (GV*)SSPOPPTR; + (void)sv_clear((SV*)gv); + break; + case SAVEt_DESTRUCTOR: + ptr = SSPOPPTR; + (*SSPOPDPTR)(ptr); + break; + case SAVEt_COP_ARYBASE: + ptr = SSPOPPTR; + i = SSPOPINT; + CopARYBASE_set((COP *)ptr, i); + break; + case SAVEt_COMPILE_WARNINGS: + ptr = SSPOPPTR; + + if (!specialWARN(PL_compiling.cop_warnings)) + PerlMemShared_free(PL_compiling.cop_warnings); + + PL_compiling.cop_warnings = (STRLEN*)ptr; + break; + case SAVEt_RE_STATE: + { + const struct re_save_state *const state + = (struct re_save_state *) + (PL_savestack + PL_savestack_ix + - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE); + PL_savestack_ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE; + + if (PL_reg_start_tmp != state->re_state_reg_start_tmp) { + Safefree(PL_reg_start_tmp); + } + if (PL_reg_poscache != state->re_state_reg_poscache) { + Safefree(PL_reg_poscache); + } + Copy(state, &PL_reg_state, 1, struct re_save_state); + } + break; + case SAVEt_PARSER: + ptr = SSPOPPTR; + parser_free((yy_parser *) ptr); + break; default: Perl_croak(aTHX_ "panic: leave_scope inconsistency"); } @@ -1037,6 +1110,10 @@ Perl_leave_scope(pTHX_ I32 base) void Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) { + dVAR; + + PERL_ARGS_ASSERT_CX_DUMP; + #ifdef DEBUGGING PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]); if (CxTYPE(cx) != CXt_SUBST) { @@ -1045,7 +1122,6 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PTR2UV(cx->blk_oldcop)); PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); - PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp); PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n", PTR2UV(cx->blk_oldpm)); PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR"); @@ -1055,14 +1131,16 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) case CXt_BLOCK: break; case CXt_FORMAT: - PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n", - PTR2UV(cx->blk_sub.cv)); - PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%"UVxf"\n", - PTR2UV(cx->blk_sub.gv)); - PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%"UVxf"\n", - PTR2UV(cx->blk_sub.dfoutgv)); - PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", - (int)cx->blk_sub.hasargs); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%"UVxf"\n", + PTR2UV(cx->blk_format.cv)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%"UVxf"\n", + PTR2UV(cx->blk_format.gv)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%"UVxf"\n", + PTR2UV(cx->blk_format.dfoutgv)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n", + (int)CxHASARGS(cx)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%"UVxf"\n", + PTR2UV(cx->blk_format.retop)); break; case CXt_SUB: PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n", @@ -1070,45 +1148,44 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n", (long)cx->blk_sub.olddepth); PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", - (int)cx->blk_sub.hasargs); - PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", - (int)cx->blk_sub.lval); + (int)CxHASARGS(cx)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n", + PTR2UV(cx->blk_sub.retop)); break; case CXt_EVAL: PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n", - (long)cx->blk_eval.old_in_eval); + (long)CxOLD_IN_EVAL(cx)); PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n", - PL_op_name[cx->blk_eval.old_op_type], - PL_op_desc[cx->blk_eval.old_op_type]); + PL_op_name[CxOLD_OP_TYPE(cx)], + PL_op_desc[CxOLD_OP_TYPE(cx)]); if (cx->blk_eval.old_namesv) PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", - SvPVX(cx->blk_eval.old_namesv)); + SvPVX_const(cx->blk_eval.old_namesv)); PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n", PTR2UV(cx->blk_eval.old_eval_root)); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n", + PTR2UV(cx->blk_eval.retop)); break; - case CXt_LOOP: - PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", - cx->blk_loop.label); + case CXt_LOOP_LAZYIV: + case CXt_LOOP_LAZYSV: + case CXt_LOOP_FOR: + case CXt_LOOP_PLAIN: + PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx)); PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n", (long)cx->blk_loop.resetsp); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%"UVxf"\n", - PTR2UV(cx->blk_loop.redo_op)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n", + PTR2UV(cx->blk_loop.my_op)); PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n", - PTR2UV(cx->blk_loop.next_op)); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%"UVxf"\n", - PTR2UV(cx->blk_loop.last_op)); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n", - (long)cx->blk_loop.iterix); + PTR2UV(CX_LOOP_NEXTOP_GET(cx))); + /* XXX: not accurate for LAZYSV/IV */ PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n", - PTR2UV(cx->blk_loop.iterary)); + PTR2UV(cx->blk_loop.state_u.ary.ary)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n", + (long)cx->blk_loop.state_u.ary.ix); PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n", PTR2UV(CxITERVAR(cx))); - if (CxITERVAR(cx)) - PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%"UVxf"\n", - PTR2UV(cx->blk_loop.itersave)); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%"UVxf"\n", - PTR2UV(cx->blk_loop.iterlval)); break; case CXt_SUBST: @@ -1119,7 +1196,7 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n", (long)cx->sb_rflags); PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n", - (long)cx->sb_once); + (long)CxONCE(cx)); PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n", cx->sb_orig); PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n", @@ -1136,5 +1213,18 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PTR2UV(cx->sb_rxres)); break; } +#else + PERL_UNUSED_CONTEXT; + PERL_UNUSED_ARG(cx); #endif /* DEBUGGING */ } + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */