X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=6bd77da23ed346d15f849767c5cc4462c3d69cfc;hb=a2edbdc9c7ad63359455c7aff3db47e75ffe578b;hp=a2a0f3a6af47c448993c8e3d1bf9c8b10345a091;hpb=10edeb5d2457364a70a6848a864cfa6b89dfc882;p=p5sagit%2Fp5-mst-13.2.git diff --git a/scope.c b/scope.c index a2a0f3a..6bd77da 100644 --- a/scope.c +++ b/scope.c @@ -1,7 +1,7 @@ /* scope.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + * 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. @@ -165,12 +165,6 @@ S_save_scalar_at(pTHX_ SV **sptr) SV * const osv = *sptr; register SV * const sv = *sptr = newSV(0); -#ifdef PERL_MAD - /* FIXME for MAD - this is causing ext/Safe/t/safeops.t to abort. */ - if (PL_formfeed && sv == PL_formfeed) - abort(); -#endif - if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) { if (SvGMAGICAL(osv)) { const bool oldtainted = PL_tainted; @@ -188,10 +182,6 @@ Perl_save_scalar(pTHX_ GV *gv) { dVAR; SV ** const sptr = &GvSVn(gv); -#ifdef PERL_MAD - if (PL_formfeed && *sptr == PL_formfeed) - abort(); -#endif PL_localizing = 1; SvGETMAGIC(*sptr); PL_localizing = 0; @@ -208,10 +198,6 @@ void Perl_save_generic_svref(pTHX_ SV **sptr) { dVAR; -#ifdef PERL_MAD - if (PL_formfeed && *sptr == PL_formfeed) - abort(); -#endif SSCHECK(3); SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); @@ -328,11 +314,6 @@ Perl_save_item(pTHX_ register SV *item) dVAR; register SV * const sv = newSVsv(item); -#ifdef PERL_MAD - if (PL_formfeed && item == PL_formfeed) - abort(); -#endif - SSCHECK(3); SSPUSHPTR(item); /* remember the pointer */ SSPUSHPTR(sv); /* remember the value */ @@ -360,6 +341,16 @@ Perl_save_bool(pTHX_ bool *boolp) } void +Perl_save_I8(pTHX_ I8 *bytep) +{ + dVAR; + SSCHECK(3); + SSPUSHINT(*bytep); + SSPUSHPTR(bytep); + SSPUSHINT(SAVEt_I8); +} + +void Perl_save_I32(pTHX_ I32 *intp) { dVAR; @@ -493,6 +484,16 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen) } void +Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) +{ + dVAR; + SSCHECK(3); + SSPUSHDPTR(f); + SSPUSHPTR(p); + SSPUSHINT(SAVEt_DESTRUCTOR); +} + +void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) { dVAR; @@ -551,10 +552,6 @@ SV* Perl_save_svref(pTHX_ SV **sptr) { dVAR; -#ifdef PERL_MAD - if (PL_formfeed && *sptr == PL_formfeed) - abort(); -#endif SvGETMAGIC(*sptr); SSCHECK(3); SSPUSHPTR(sptr); @@ -622,7 +619,8 @@ Perl_leave_scope(pTHX_ I32 base) 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))); + (void*)ptr, (void*)sv, SvPEEK(sv), + (void*)value, SvPEEK(value))); *(SV**)ptr = value; SvREFCNT_dec(sv); PL_localizing = 2; @@ -831,6 +829,10 @@ 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; @@ -999,6 +1001,10 @@ Perl_leave_scope(pTHX_ I32 base) 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"); } @@ -1069,12 +1075,10 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) cx->blk_loop.label); 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)); + PTR2UV(CX_LOOP_NEXTOP_GET(cx))); PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n", (long)cx->blk_loop.iterix); PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",