Add comment to top of reentr.c and fix typos in other files

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 33d891e..492ce60 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 various 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) {
@@ -199,9 +187,9 @@ S_save_scalar_at(pTHX_ SV **sptr)
 
     sv = *sptr = NEWSV(0,0);
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+       MAGIC *mg;
        sv_upgrade(sv, SvTYPE(osv));
        if (SvGMAGICAL(osv)) {
-           MAGIC* mg;
            bool oldtainted = PL_tainted;
            mg_get(osv);                /* note, can croak! */
            if (PL_tainting && PL_tainted &&
@@ -214,7 +202,17 @@ S_save_scalar_at(pTHX_ SV **sptr)
            PL_tainted = oldtainted;
        }
        SvMAGIC(sv) = SvMAGIC(osv);
-       SvFLAGS(sv) |= SvMAGICAL(osv) | SvREADONLY(osv);
+       /* 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 (mg->mg_type == '\0'
+                   || !(mg->mg_virtual && mg->mg_virtual->svt_set))
+           {
+               SvFLAGS(sv) |= SvREADONLY(osv);
+               break;
+           }
+       }
+       SvFLAGS(sv) |= SvMAGICAL(osv);
        /* XXX SvMAGIC() is *shared* between osv and sv.  This can
         * lead to coredumps when both SVs are destroyed without one
         * of their SvMAGIC() slots being NULLed. */
@@ -772,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;
@@ -935,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);
                    break;
                }
                SvPADSTALE_on(sv); /* mark as no longer live */
@@ -1032,6 +1024,11 @@ 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;
@@ -1048,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;
@@ -1074,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");
@@ -1092,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",
@@ -1102,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",
@@ -1114,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: