remove binary compat from #23156 (remove PL_retstack)

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index f738b5b..54d0ac1 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.
@@ -101,25 +101,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 +180,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,6 +195,16 @@ S_save_scalar_at(pTHX_ SV **sptr)
            PL_tainted = oldtainted;
        }
        SvMAGIC(sv) = SvMAGIC(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
@@ -281,6 +272,18 @@ Perl_save_shared_pvref(pTHX_ char **str)
     SSPUSHINT(SAVEt_SHARED_PVREF);
 }
 
+/* set the SvFLAGS specified by mask to the values in val */
+
+void
+Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
+{
+    SSCHECK(4);
+    SSPUSHPTR(sv);
+    SSPUSHINT(mask);
+    SSPUSHINT(val);
+    SSPUSHINT(SAVEt_SET_SVFLAGS);
+}
+
 void
 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
@@ -760,8 +763,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,7 +948,7 @@ Perl_leave_scope(pTHX_ I32 base)
                SvREFCNT_dec(sv);       /* Cast current value to the winds. */
                /* preserve pad nature, but also mark as not live
                 * for any closure capturing */
-               SvFLAGS(*(SV**)ptr) |= padflags & SVs_PADSTALE;
+               SvFLAGS(*(SV**)ptr) |= padflags | SVs_PADSTALE;
            }
            break;
        case SAVEt_DELETE:
@@ -1020,6 +1023,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;
@@ -1036,6 +1044,24 @@ 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;
+               U32 mask = (U32)SSPOPINT;
+               sv = (SV*)SSPOPPTR;
+               SvFLAGS(sv) &= ~mask;
+               SvFLAGS(sv) |= val;
+           }
+           break;
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }
@@ -1053,7 +1079,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");
@@ -1071,6 +1096,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",
@@ -1081,6 +1108,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",
@@ -1093,6 +1122,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: