X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=6bd77da23ed346d15f849767c5cc4462c3d69cfc;hb=a2edbdc9c7ad63359455c7aff3db47e75ffe578b;hp=ff063d22a0531c91feefaaa0fb3616dc6c75cc34;hpb=49e9cc5f6815d33ebfa1aabf8837d4a6b16c3bea;p=p5sagit%2Fp5-mst-13.2.git diff --git a/scope.c b/scope.c index ff063d2..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. @@ -62,7 +62,7 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) 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; } @@ -75,7 +75,7 @@ Perl_cxinc(pTHX) 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; } @@ -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)); @@ -226,8 +212,8 @@ Perl_save_generic_pvref(pTHX_ char **str) { dVAR; SSCHECK(3); - SSPUSHPTR(str); SSPUSHPTR(*str); + SSPUSHPTR(str); SSPUSHINT(SAVEt_GENERIC_PVREF); } @@ -267,9 +253,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) SSPUSHINT(SAVEt_GP); if (empty) { - register GP *gp; - - Newxz(gp, 1, GP); + GP *gp = Perl_newGP(aTHX_ gv); if (GvCVu(gv)) PL_sub_generation++; /* taking a method out of circulation */ @@ -277,15 +261,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) gp->gp_io = newIO(); IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START; } - GvGP(gv) = gp_ref(gp); -#ifndef PERL_DONT_CREATE_GVSV - GvSV(gv) = newSV(0); -#endif - GvLINE(gv) = CopLINE(PL_curcop); - /* XXX Ideally this cast would be replaced with a change to const char* - in the struct. */ - GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) ""; - GvEGV(gv) = gv; + GvGP(gv) = gp; } else { gp_ref(GvGP(gv)); @@ -338,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 */ @@ -370,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; @@ -503,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; @@ -561,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); @@ -590,9 +577,7 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad) - (char*)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); @@ -634,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; @@ -645,8 +631,8 @@ Perl_leave_scope(pTHX_ I32 base) 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; @@ -826,7 +812,7 @@ Perl_leave_scope(pTHX_ I32 base) 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; @@ -843,13 +829,17 @@ 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) { @@ -890,11 +880,33 @@ 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; @@ -959,6 +971,40 @@ Perl_leave_scope(pTHX_ I32 base) 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"); } @@ -1029,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",