Fix c6bf6a65 - 64 bit big endian builds were broken.

[p5sagit/p5-mst-13.2.git] / scope.c

diff --git a/scope.c b/scope.c
index 50798e4..f1d4db5 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -91,7 +91,13 @@ Perl_push_scope(pTHX)
     if (PL_scopestack_ix == PL_scopestack_max) {
        PL_scopestack_max = GROW(PL_scopestack_max);
        Renew(PL_scopestack, PL_scopestack_max, I32);
+#ifdef DEBUGGING
+       Renew(PL_scopestack_name, PL_scopestack_max, const char*);
+#endif
     }
+#ifdef DEBUGGING
+    PL_scopestack_name[PL_scopestack_ix] = "unknown";
+#endif
     PL_scopestack[PL_scopestack_ix++] = PL_savestack_ix;
 
 }
@@ -196,7 +202,7 @@ Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
     SSCHECK(3);
     SSPUSHPTR(ptr1);
     SSPUSHPTR(ptr2);
-    SSPUSHINT(type);
+    SSPUSHUV(type);
 }
 
 SV *
@@ -265,7 +271,7 @@ Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
     SSPUSHPTR(sv);
     SSPUSHINT(mask);
     SSPUSHINT(val);
-    SSPUSHINT(SAVEt_SET_SVFLAGS);
+    SSPUSHUV(SAVEt_SET_SVFLAGS);
 }
 
 void
@@ -275,7 +281,15 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
 
     PERL_ARGS_ASSERT_SAVE_GP;
 
-    save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
+    SSCHECK(4);
+    SSPUSHINT(SvFAKE(gv));
+    SSPUSHPTR(GvGP(gv));
+    SSPUSHPTR(SvREFCNT_inc(gv));
+    SSPUSHUV(SAVEt_GP);
+
+    /* Don't let the localized GV coerce into non-glob, otherwise we would
+     * not be able to restore GP upon leave from context if that happened */
+    SvFAKE_off(gv);
 
     if (empty) {
        GP *gp = Perl_newGP(aTHX_ gv);
@@ -362,7 +376,7 @@ Perl_save_bool(pTHX_ bool *boolp)
     SSCHECK(3);
     SSPUSHBOOL(*boolp);
     SSPUSHPTR(boolp);
-    SSPUSHINT(SAVEt_BOOL);
+    SSPUSHUV(SAVEt_BOOL);
 }
 
 void
@@ -372,7 +386,7 @@ Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type)
     SSCHECK(3);
     SSPUSHINT(i);
     SSPUSHPTR(ptr);
-    SSPUSHINT(type);
+    SSPUSHUV(type);
 }
 
 void
@@ -457,7 +471,7 @@ Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
     SSPUSHPTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
     SSPUSHPTR(PL_comppad);
     SSPUSHLONG((long)off);
-    SSPUSHINT(SAVEt_PADSV_AND_MORTALIZE);
+    SSPUSHUV(SAVEt_PADSV_AND_MORTALIZE);
 }
 
 void
@@ -486,20 +500,25 @@ Perl_save_pushptr(pTHX_ void *const ptr, const int type)
     dVAR;
     SSCHECK(2);
     SSPUSHPTR(ptr);
-    SSPUSHINT(type);
+    SSPUSHUV(type);
 }
 
 void
 Perl_save_clearsv(pTHX_ SV **svp)
 {
     dVAR;
+    const UV offset = svp - PL_curpad;
+    const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
 
     PERL_ARGS_ASSERT_SAVE_CLEARSV;
 
     ASSERT_CURPAD_ACTIVE("save_clearsv");
-    SSCHECK(2);
-    SSPUSHLONG((long)(svp-PL_curpad));
-    SSPUSHINT(SAVEt_CLEARSV);
+    if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)
+       Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
+                  offset, svp, PL_curpad);
+
+    SSCHECK(1);
+    SSPUSHUV(offset_shifted | SAVEt_CLEARSV);
     SvPADSTALE_off(*svp); /* mark lexical as active */
 }
 
@@ -549,7 +568,7 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
     SSCHECK(3);
     SSPUSHDPTR(f);
     SSPUSHPTR(p);
-    SSPUSHINT(SAVEt_DESTRUCTOR);
+    SSPUSHUV(SAVEt_DESTRUCTOR);
 }
 
 void
@@ -559,7 +578,7 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
     SSCHECK(3);
     SSPUSHDXPTR(f);
     SSPUSHPTR(p);
-    SSPUSHINT(SAVEt_DESTRUCTOR_X);
+    SSPUSHUV(SAVEt_DESTRUCTOR_X);
 }
 
 void
@@ -588,7 +607,7 @@ S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2,
     SSPUSHPTR(ptr1);
     SSPUSHINT(i);
     SSPUSHPTR(ptr2);
-    SSPUSHINT(type);
+    SSPUSHUV(type);
 }
 
 void
@@ -613,7 +632,7 @@ Perl_save_aelem_flags(pTHX_ AV *av, I32 idx, SV **sptr, const U32 flags)
      * won't actually be stored in the array - so it won't get
      * reaped when the localize ends. Ensure it gets reaped by
      * mortifying it instead. DAPM */
-    if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
+    if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
        sv_2mortal(sv);
 }
 
@@ -630,7 +649,7 @@ Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
     SSPUSHPTR(SvREFCNT_inc_simple(hv));
     SSPUSHPTR(newSVsv(key));
     SSPUSHPTR(SvREFCNT_inc(*sptr));
-    SSPUSHINT(SAVEt_HELEM);
+    SSPUSHUV(SAVEt_HELEM);
     save_scalar_at(sptr, flags);
     if (flags & SAVEf_KEEPOLDELEM)
        return;
@@ -639,7 +658,7 @@ Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
      * won't actually be stored in the hash - so it won't get
      * reaped when the localize ends. Ensure it gets reaped by
      * mortifying it instead. DAPM */
-    if (SvTIED_mg(sv, PERL_MAGIC_tiedelem))
+    if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))
        sv_2mortal(sv);
 }
 
@@ -667,7 +686,7 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
 
     PL_savestack_ix += elems;
     SSPUSHINT(elems);
-    SSPUSHINT(SAVEt_ALLOC);
+    SSPUSHUV(SAVEt_ALLOC);
     return start;
 }
 
@@ -688,10 +707,14 @@ Perl_leave_scope(pTHX_ I32 base)
 
     if (base < -1)
        Perl_croak(aTHX_ "panic: corrupt saved stack index");
+    DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n",
+                       (long)PL_savestack_ix, (long)base));
     while (PL_savestack_ix > base) {
+       UV uv = SSPOPUV;
+       const U8 type = (U8)uv & SAVE_MASK;
        TAINT_NOT;
 
-       switch (SSPOPINT) {
+       switch (type) {
        case SAVEt_ITEM:                        /* normal string */
            value = MUTABLE_SV(SSPOPPTR);
            sv = MUTABLE_SV(SSPOPPTR);
@@ -747,9 +770,7 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_AV:                          /* array reference */
            av = MUTABLE_AV(SSPOPPTR);
            gv = MUTABLE_GV(SSPOPPTR);
-           if (GvAV(gv)) {
-               SvREFCNT_dec(GvAV(gv));
-           }
+           SvREFCNT_dec(GvAV(gv));
            GvAV(gv) = av;
            if (SvMAGICAL(av)) {
                PL_localizing = 2;
@@ -760,9 +781,7 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_HV:                          /* hash reference */
            hv = MUTABLE_HV(SSPOPPTR);
            gv = MUTABLE_GV(SSPOPPTR);
-           if (GvHV(gv)) {
-               SvREFCNT_dec(GvHV(gv));
-           }
+           SvREFCNT_dec(GvHV(gv));
            GvHV(gv) = hv;
            if (SvMAGICAL(hv)) {
                PL_localizing = 2;
@@ -776,7 +795,7 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
        case SAVEt_BOOL:                        /* bool reference */
            ptr = SSPOPPTR;
-           *(bool*)ptr = (bool)SSPOPBOOL;
+           *(bool*)ptr = cBOOL(SSPOPBOOL);
            break;
        case SAVEt_I32:                         /* I32 reference */
            ptr = SSPOPPTR;
@@ -808,10 +827,11 @@ Perl_leave_scope(pTHX_ I32 base)
            *(AV**)ptr = MUTABLE_AV(SSPOPPTR);
            break;
        case SAVEt_GP:                          /* scalar reference */
-           ptr = SSPOPPTR;
            gv = MUTABLE_GV(SSPOPPTR);
            gp_free(gv);
-           GvGP(gv) = (GP*)ptr;
+           GvGP(gv) = (GP*)SSPOPPTR;
+           if (SSPOPINT)
+               SvFAKE_on(gv);
             /* putting a method back into circulation ("local")*/
            if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
                 mro_method_changed_in(hv);
@@ -835,7 +855,7 @@ Perl_leave_scope(pTHX_ I32 base)
            Safefree(ptr);
            break;
        case SAVEt_CLEARSV:
-           ptr = (void*)&PL_curpad[SSPOPLONG];
+           ptr = (void*)&PL_curpad[uv >> SAVE_TIGHT_SHIFT];
            sv = *(SV**)ptr;
 
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
@@ -1111,6 +1131,8 @@ Perl_leave_scope(pTHX_ I32 base)
     }
 
     PL_tainted = was;
+
+    PERL_ASYNC_CHECK();
 }
 
 void