First steps towards an explicit perl.exp-less AIX build

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 33d891e..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,7 +195,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 +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;
@@ -1032,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;
@@ -1048,6 +1044,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 +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");
@@ -1092,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",
@@ -1102,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",
@@ -1114,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: