X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=6bd77da23ed346d15f849767c5cc4462c3d69cfc;hb=a2edbdc9c7ad63359455c7aff3db47e75ffe578b;hp=ebea9e13e9124c793cd0063f9c6c7d8cea75f29e;hpb=72dc9ed5af65c946f73050becea29207a1af86c1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/scope.c b/scope.c
index ebea9e1..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));
@@ -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);
@@ -632,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;
@@ -764,10 +752,6 @@ Perl_leave_scope(pTHX_ I32 base)
 	    ptr = SSPOPPTR;
 	    Safefree(ptr);
 	    break;
-	case SAVEt_FREESHAREDPV:
-	    ptr = SSPOPPTR;
-	    PerlMemShared_free(ptr);
-	    break;
 	case SAVEt_CLEARSV:
 	    ptr = (void*)&PL_curpad[SSPOPLONG];
 	    sv = *(SV**)ptr;
@@ -845,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) {
@@ -892,8 +880,8 @@ Perl_leave_scope(pTHX_ I32 base)
 		GvHV(PL_hintgv) = NULL;
 	    }
 	    *(I32*)&PL_hints = (I32)SSPOPINT;
-	    Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
-	    PL_compiling.cop_hints = (struct refcounted_he *) SSPOPPTR;
+	    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;
@@ -988,16 +976,13 @@ Perl_leave_scope(pTHX_ I32 base)
 	    i = SSPOPINT;
 	    CopARYBASE_set((COP *)ptr, i);
 	    break;
-	case SAVEt_COP_WARNINGS:
-	    {
-		COP *const cop = SSPOPPTR;
-		ptr = SSPOPPTR;
+	case SAVEt_COMPILE_WARNINGS:
+	    ptr = SSPOPPTR;
 
-		if (!specialWARN(cop->cop_warnings))
-		    PerlMemShared_free(cop->cop_warnings);
+	    if (!specialWARN(PL_compiling.cop_warnings))
+		PerlMemShared_free(PL_compiling.cop_warnings);
 
-		cop->cop_warnings = ptr;
-	    }
+	    PL_compiling.cop_warnings = (STRLEN*)ptr;
 	    break;
 	case SAVEt_RE_STATE:
 	    {
@@ -1016,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");
 	}
@@ -1086,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",