Sync with libnet-1.13

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index a1fdfd1..a5cc4f4 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1,6 +1,6 @@
 /*    scope.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (c) 1991-2003, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -81,14 +81,21 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
     si->si_cxix = -1;
     si->si_type = PERLSI_UNDEF;
     New(56, si->si_cxstack, cxitems, PERL_CONTEXT);
+    /* Without any kind of initialising PUSHSUBST()
+     * in pp_subst() will read uninitialised heap. */
+    Poison(si->si_cxstack, cxitems, PERL_CONTEXT);
     return si;
 }
 
 I32
 Perl_cxinc(pTHX)
 {
+    IV old_max = cxstack_max;
     cxstack_max = GROW(cxstack_max);
     Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);     /* XXX should fix CXINC macro */
+    /* Without any kind of initialising deep enough recursion
+     * will end up reading uninitialised PERL_CONTEXTs. */
+    Poison(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
     return cxstack_ix + 1;
 }
 
@@ -384,6 +391,15 @@ Perl_save_long(pTHX_ long int *longp)
 }
 
 void
+Perl_save_bool(pTHX_ bool *boolp)
+{
+    SSCHECK(3);
+    SSPUSHBOOL(*boolp);
+    SSPUSHPTR(boolp);
+    SSPUSHINT(SAVEt_BOOL);
+}
+
+void
 Perl_save_I32(pTHX_ I32 *intp)
 {
     SSCHECK(3);
@@ -453,8 +469,9 @@ void
 Perl_save_padsv(pTHX_ PADOFFSET off)
 {
     SSCHECK(4);
+    ASSERT_CURPAD_ACTIVE("save_padsv");
     SSPUSHPTR(PL_curpad[off]);
-    SSPUSHPTR(PL_curpad);
+    SSPUSHPTR(PL_comppad);
     SSPUSHLONG((long)off);
     SSPUSHINT(SAVEt_PADSV);
 }
@@ -462,16 +479,8 @@ Perl_save_padsv(pTHX_ PADOFFSET off)
 SV **
 Perl_save_threadsv(pTHX_ PADOFFSET i)
 {
-#ifdef USE_5005THREADS
-    SV **svp = &THREADSV(i);   /* XXX Change to save by offset */
-    DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
-                         (UV)i, svp, *svp, SvPEEK(*svp)));
-    save_svref(svp);
-    return svp;
-#else
     Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
     return 0;
-#endif /* USE_5005THREADS */
 }
 
 void
@@ -535,9 +544,11 @@ Perl_save_freepv(pTHX_ char *pv)
 void
 Perl_save_clearsv(pTHX_ SV **svp)
 {
+    ASSERT_CURPAD_ACTIVE("save_clearsv");
     SSCHECK(2);
     SSPUSHLONG((long)(svp-PL_curpad));
     SSPUSHINT(SAVEt_CLEARSV);
+    SvPADSTALE_off(*svp); /* mark lexical as active */
 }
 
 void
@@ -788,6 +799,10 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            *(long*)ptr = (long)SSPOPLONG;
            break;
+       case SAVEt_BOOL:                        /* bool reference */
+           ptr = SSPOPPTR;
+           *(bool*)ptr = (bool)SSPOPBOOL;
+           break;
        case SAVEt_I32:                         /* I32 reference */
            ptr = SSPOPPTR;
            *(I32*)ptr = (I32)SSPOPINT;
@@ -850,8 +865,7 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
        case SAVEt_FREEOP:
            ptr = SSPOPPTR;
-           if (PL_comppad)
-               PL_curpad = AvARRAY(PL_comppad);
+           ASSERT_CURPAD_LEGAL("SAVEt_FREEOP"); /* XXX DAPM tmp */
            op_free((OP*)ptr);
            break;
        case SAVEt_FREEPV:
@@ -861,6 +875,14 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_CLEARSV:
            ptr = (void*)&PL_curpad[SSPOPLONG];
            sv = *(SV**)ptr;
+
+           DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+            "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
+               PTR2UV(PL_comppad), PTR2UV(PL_curpad),
+               (long)((SV **)ptr-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
+               (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
+           ));
+
            /* Can clear pad variable in place? */
            if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
                /*
@@ -897,16 +919,19 @@ Perl_leave_scope(pTHX_ I32 base)
                    (void)SvOOK_off(sv);
                    break;
                }
+               SvPADSTALE_on(sv); /* mark as no longer live */
            }
            else {      /* Someone has a claim on this, so abandon it. */
-               U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
+               U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP);
                switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
                case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
                case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
                default:        *(SV**)ptr = NEWSV(0,0);        break;
                }
                SvREFCNT_dec(sv);       /* Cast current value to the winds. */
-               SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
+               /* preserve pad nature, but also mark as not live
+                * for any closure capturing */
+               SvFLAGS(*(SV**)ptr) |= padflags & SVs_PADSTALE;
            }
            break;
        case SAVEt_DELETE:
@@ -982,7 +1007,7 @@ Perl_leave_scope(pTHX_ I32 base)
            *(I32*)&PL_hints = (I32)SSPOPINT;
            break;
        case SAVEt_COMPPAD:
-           PL_comppad = (AV*)SSPOPPTR;
+           PL_comppad = (PAD*)SSPOPPTR;
            if (PL_comppad)
                PL_curpad = AvARRAY(PL_comppad);
            else
@@ -993,7 +1018,7 @@ Perl_leave_scope(pTHX_ I32 base)
                PADOFFSET off = (PADOFFSET)SSPOPLONG;
                ptr = SSPOPPTR;
                if (ptr)
-                   ((SV**)ptr)[off] = (SV*)SSPOPPTR;
+                   AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
            }
            break;
        default: