one more iteration on PerlIO_teardown prototype

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index b4ecd65..68aa8c2 100644 (file)
--- 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.
@@ -226,8 +226,8 @@ Perl_save_generic_pvref(pTHX_ char **str)
 {
     dVAR;
     SSCHECK(3);
-    SSPUSHPTR(str);
     SSPUSHPTR(*str);
+    SSPUSHPTR(str);
     SSPUSHINT(SAVEt_GENERIC_PVREF);
 }
 
@@ -267,9 +267,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 +275,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));
@@ -370,6 +360,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 +503,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;
@@ -590,9 +600,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 +642,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 +654,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;
@@ -843,13 +852,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,8 +903,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;
@@ -981,6 +994,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");
        }
@@ -1051,12 +1098,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",