Shave off the explict 1; from the end of lib/Config.pm

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 1da8ebe..af10b71 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, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 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.
@@ -13,6 +13,13 @@
  * 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"
@@ -101,25 +108,6 @@ Perl_cxinc(pTHX)
 }
 
 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)
 {
     if (PL_scopestack_ix == PL_scopestack_max) {
@@ -217,8 +205,8 @@ S_save_scalar_at(pTHX_ SV **sptr)
        /* if it's a special scalar or if it has no 'set' magic,
         * propagate the SvREADONLY flag. --rgs 20030922 */
        for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-           if (SvMAGIC(sv)->mg_type == '\0'
-                   || !SvMAGIC(sv)->mg_virtual->svt_set)
+           if (mg->mg_type == '\0'
+                   || !(mg->mg_virtual && mg->mg_virtual->svt_set))
            {
                SvFLAGS(sv) |= SvREADONLY(osv);
                break;
@@ -782,8 +770,8 @@ Perl_leave_scope(pTHX_ I32 base)
                 * mg_get() in save_scalar_at() croaked */
                SvMAGIC(value) = 0;
            }
-           SvREFCNT_dec(sv);
            *(SV**)ptr = value;
+           SvREFCNT_dec(sv);
            PL_localizing = 2;
            SvSETMAGIC(value);
            PL_localizing = 0;
@@ -945,14 +933,8 @@ 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 */
@@ -1042,13 +1024,16 @@ Perl_leave_scope(pTHX_ I32 base)
                GvHV(PL_hintgv) = NULL;
            }
            *(I32*)&PL_hints = (I32)SSPOPINT;
+           if (PL_hints & HINT_LOCALIZE_HH) {
+               SvREFCNT_dec((SV*)GvHV(PL_hintgv));
+               GvHV(PL_hintgv) = (HV*)SSPOPPTR;
+           }
+                   
            break;
        case SAVEt_COMPPAD:
            PL_comppad = (PAD*)SSPOPPTR;
-           if (PL_comppad) {
+           if (PL_comppad)
                PL_curpad = AvARRAY(PL_comppad);
-               SvREFCNT_dec(PL_comppad);
-           }               
            else
                PL_curpad = Null(SV**);
            break;
@@ -1060,6 +1045,15 @@ Perl_leave_scope(pTHX_ I32 base)
                    AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
            }
            break;
+       case SAVEt_SAVESWITCHSTACK:
+           {
+               dSP;
+               AV* t = (AV*)SSPOPPTR;
+               AV* f = (AV*)SSPOPPTR;
+               SWITCHSTACK(t,f);
+               PL_curstackinfo->si_stack = f;
+           }
+           break;
        case SAVEt_SET_SVFLAGS:
            {
                U32 val  = (U32)SSPOPINT;
@@ -1086,7 +1080,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");
@@ -1104,6 +1097,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                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_SUB.RETOP = 0x%"UVxf"\n",
+               PTR2UV(cx->blk_sub.retop));
        break;
     case CXt_SUB:
        PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
@@ -1114,6 +1109,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                (int)cx->blk_sub.hasargs);
        PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n",
                (int)cx->blk_sub.lval);
+       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",
@@ -1126,6 +1123,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                          SvPVX(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: