X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ad64d0ecd555e97c5a216efca1ec5a96b7fd0b34..93136d17f9881a8e1aebaec99f2febb8e56aefa3:/scope.c?ds=sidebyside

diff --git a/scope.c b/scope.c
index 6e74978..fb93db0 100644
--- a/scope.c
+++ b/scope.c
@@ -9,8 +9,10 @@
  */
 
 /*
- * "For the fashion of Minas Tirith was such that it was built on seven
- * levels..."
+ * For the fashion of Minas Tirith was such that it was built on seven
+ * levels...
+ *
+ *     [p.751 of _The Lord of the Rings_, V/i: "Minas Tirith"]
  */
 
 /* This file contains functions to manipulate several of Perl's stacks;
@@ -75,7 +77,7 @@ Perl_cxinc(pTHX)
     dVAR;
     const IV old_max = cxstack_max;
     cxstack_max = GROW(cxstack_max);
-    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);	/* XXX should fix CXINC macro */
+    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
     /* Without any kind of initialising deep enough recursion
      * will end up reading uninitialised PERL_CONTEXTs. */
     PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
@@ -89,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;
 
 }
@@ -162,26 +170,39 @@ Perl_free_tmps(pTHX)
 }
 
 STATIC SV *
-S_save_scalar_at(pTHX_ SV **sptr)
+S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
 {
     dVAR;
-    SV * const osv = *sptr;
-    register SV * const sv = *sptr = newSV(0);
+    SV * osv;
+    register SV *sv;
 
     PERL_ARGS_ASSERT_SAVE_SCALAR_AT;
 
+    osv = *sptr;
+    sv  = (flags & SAVEf_KEEPOLDELEM) ? osv : (*sptr = newSV(0));
+
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
 	if (SvGMAGICAL(osv)) {
-	    const bool oldtainted = PL_tainted;
 	    SvFLAGS(osv) |= (SvFLAGS(osv) &
 	       (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
-	    PL_tainted = oldtainted;
 	}
-	mg_localize(osv, sv);
+	if (!(flags & SAVEf_KEEPOLDELEM))
+	    mg_localize(osv, sv, cBOOL(flags & SAVEf_SETMAGIC));
     }
+
     return sv;
 }
 
+void
+Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
+{
+    dVAR;
+    SSCHECK(3);
+    SSPUSHPTR(ptr1);
+    SSPUSHPTR(ptr2);
+    SSPUSHUV(type);
+}
+
 SV *
 Perl_save_scalar(pTHX_ GV *gv)
 {
@@ -193,11 +214,8 @@ Perl_save_scalar(pTHX_ GV *gv)
     PL_localizing = 1;
     SvGETMAGIC(*sptr);
     PL_localizing = 0;
-    SSCHECK(3);
-    SSPUSHPTR(SvREFCNT_inc_simple(gv));
-    SSPUSHPTR(SvREFCNT_inc(*sptr));
-    SSPUSHINT(SAVEt_SV);
-    return save_scalar_at(sptr);
+    save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(*sptr), SAVEt_SV);
+    return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 }
 
 /* Like save_sptr(), but also SvREFCNT_dec()s the new value.  Can be used to
@@ -209,10 +227,7 @@ Perl_save_generic_svref(pTHX_ SV **sptr)
 
     PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF;
 
-    SSCHECK(3);
-    SSPUSHPTR(sptr);
-    SSPUSHPTR(SvREFCNT_inc(*sptr));
-    SSPUSHINT(SAVEt_GENERIC_SVREF);
+    save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_GENERIC_SVREF);
 }
 
 /* Like save_pptr(), but also Safefree()s the new value if it is different
@@ -225,10 +240,7 @@ Perl_save_generic_pvref(pTHX_ char **str)
 
     PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF;
 
-    SSCHECK(3);
-    SSPUSHPTR(*str);
-    SSPUSHPTR(str);
-    SSPUSHINT(SAVEt_GENERIC_PVREF);
+    save_pushptrptr(*str, str, SAVEt_GENERIC_PVREF);
 }
 
 /* Like save_generic_pvref(), but uses PerlMemShared_free() rather than Safefree().
@@ -241,10 +253,7 @@ Perl_save_shared_pvref(pTHX_ char **str)
 
     PERL_ARGS_ASSERT_SAVE_SHARED_PVREF;
 
-    SSCHECK(3);
-    SSPUSHPTR(str);
-    SSPUSHPTR(*str);
-    SSPUSHINT(SAVEt_SHARED_PVREF);
+    save_pushptrptr(str, *str, SAVEt_SHARED_PVREF);
 }
 
 /* set the SvFLAGS specified by mask to the values in val */
@@ -260,7 +269,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
@@ -270,10 +279,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
 
     PERL_ARGS_ASSERT_SAVE_GP;
 
-    SSGROW(3);
-    SSPUSHPTR(SvREFCNT_inc(gv));
-    SSPUSHPTR(GvGP(gv));
-    SSPUSHINT(SAVEt_GP);
+    save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
 
     if (empty) {
 	GP *gp = Perl_newGP(aTHX_ gv);
@@ -311,15 +317,12 @@ Perl_save_ary(pTHX_ GV *gv)
 
     if (!AvREAL(oav) && AvREIFY(oav))
 	av_reify(oav);
-    SSCHECK(3);
-    SSPUSHPTR(gv);
-    SSPUSHPTR(oav);
-    SSPUSHINT(SAVEt_AV);
+    save_pushptrptr(gv, oav, SAVEt_AV);
 
     GvAV(gv) = NULL;
     av = GvAVn(gv);
     if (SvMAGIC(oav))
-	mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av));
+	mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE);
     return av;
 }
 
@@ -331,15 +334,12 @@ Perl_save_hash(pTHX_ GV *gv)
 
     PERL_ARGS_ASSERT_SAVE_HASH;
 
-    SSCHECK(3);
-    SSPUSHPTR(gv);
-    SSPUSHPTR(ohv = GvHVn(gv));
-    SSPUSHINT(SAVEt_HV);
+    save_pushptrptr(gv, (ohv = GvHVn(gv)), SAVEt_HV);
 
     GvHV(gv) = NULL;
     hv = GvHVn(gv);
     if (SvMAGIC(ohv))
-	mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv));
+	mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE);
     return hv;
 }
 
@@ -351,36 +351,47 @@ Perl_save_item(pTHX_ register SV *item)
 
     PERL_ARGS_ASSERT_SAVE_ITEM;
 
-    SSCHECK(3);
-    SSPUSHPTR(item);		/* remember the pointer */
-    SSPUSHPTR(sv);		/* remember the value */
-    SSPUSHINT(SAVEt_ITEM);
+    save_pushptrptr(item, /* remember the pointer */
+		    sv,   /* remember the value */
+		    SAVEt_ITEM);
 }
 
 void
-Perl_save_int(pTHX_ int *intp)
+Perl_save_bool(pTHX_ bool *boolp)
 {
     dVAR;
 
-    PERL_ARGS_ASSERT_SAVE_INT;
+    PERL_ARGS_ASSERT_SAVE_BOOL;
+
+    SSCHECK(2);
+    SSPUSHPTR(boolp);
+    SSPUSHUV(SAVEt_BOOL | (*boolp << 8));
+}
 
+void
+Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type)
+{
+    dVAR;
     SSCHECK(3);
-    SSPUSHINT(*intp);
-    SSPUSHPTR(intp);
-    SSPUSHINT(SAVEt_INT);
+    SSPUSHINT(i);
+    SSPUSHPTR(ptr);
+    SSPUSHUV(type);
 }
 
 void
-Perl_save_bool(pTHX_ bool *boolp)
+Perl_save_int(pTHX_ int *intp)
 {
     dVAR;
+    const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
 
-    PERL_ARGS_ASSERT_SAVE_BOOL;
+    PERL_ARGS_ASSERT_SAVE_INT;
 
-    SSCHECK(3);
-    SSPUSHBOOL(*boolp);
-    SSPUSHPTR(boolp);
-    SSPUSHINT(SAVEt_BOOL);
+    if ((int)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+	SSCHECK(2);
+	SSPUSHPTR(intp);
+	SSPUSHUV(SAVEt_INT_SMALL | shifted);
+    } else
+	save_pushi32ptr(*intp, intp, SAVEt_INT);
 }
 
 void
@@ -390,10 +401,9 @@ Perl_save_I8(pTHX_ I8 *bytep)
 
     PERL_ARGS_ASSERT_SAVE_I8;
 
-    SSCHECK(3);
-    SSPUSHINT(*bytep);
+    SSCHECK(2);
     SSPUSHPTR(bytep);
-    SSPUSHINT(SAVEt_I8);
+    SSPUSHUV(SAVEt_I8 | ((UV)*bytep << 8));
 }
 
 void
@@ -403,23 +413,25 @@ Perl_save_I16(pTHX_ I16 *intp)
 
     PERL_ARGS_ASSERT_SAVE_I16;
 
-    SSCHECK(3);
-    SSPUSHINT(*intp);
+    SSCHECK(2);
     SSPUSHPTR(intp);
-    SSPUSHINT(SAVEt_I16);
+    SSPUSHUV(SAVEt_I16 | ((UV)*intp << 8));
 }
 
 void
 Perl_save_I32(pTHX_ I32 *intp)
 {
     dVAR;
+    const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
 
     PERL_ARGS_ASSERT_SAVE_I32;
 
-    SSCHECK(3);
-    SSPUSHINT(*intp);
-    SSPUSHPTR(intp);
-    SSPUSHINT(SAVEt_I32);
+    if ((I32)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+	SSCHECK(2);
+	SSPUSHPTR(intp);
+	SSPUSHUV(SAVEt_I32_SMALL | shifted);
+    } else
+	save_pushi32ptr(*intp, intp, SAVEt_I32);
 }
 
 /* Cannot use save_sptr() to store a char* since the SV** cast will
@@ -432,10 +444,7 @@ Perl_save_pptr(pTHX_ char **pptr)
 
     PERL_ARGS_ASSERT_SAVE_PPTR;
 
-    SSCHECK(3);
-    SSPUSHPTR(*pptr);
-    SSPUSHPTR(pptr);
-    SSPUSHINT(SAVEt_PPTR);
+    save_pushptrptr(*pptr, pptr, SAVEt_PPTR);
 }
 
 void
@@ -445,10 +454,7 @@ Perl_save_vptr(pTHX_ void *ptr)
 
     PERL_ARGS_ASSERT_SAVE_VPTR;
 
-    SSCHECK(3);
-    SSPUSHPTR(*(char**)ptr);
-    SSPUSHPTR(ptr);
-    SSPUSHINT(SAVEt_VPTR);
+    save_pushptrptr(*(char**)ptr, ptr, SAVEt_VPTR);
 }
 
 void
@@ -458,10 +464,7 @@ Perl_save_sptr(pTHX_ SV **sptr)
 
     PERL_ARGS_ASSERT_SAVE_SPTR;
 
-    SSCHECK(3);
-    SSPUSHPTR(*sptr);
-    SSPUSHPTR(sptr);
-    SSPUSHINT(SAVEt_SPTR);
+    save_pushptrptr(*sptr, sptr, SAVEt_SPTR);
 }
 
 void
@@ -473,7 +476,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
@@ -483,10 +486,7 @@ Perl_save_hptr(pTHX_ HV **hptr)
 
     PERL_ARGS_ASSERT_SAVE_HPTR;
 
-    SSCHECK(3);
-    SSPUSHPTR(*hptr);
-    SSPUSHPTR(hptr);
-    SSPUSHINT(SAVEt_HPTR);
+    save_pushptrptr(*hptr, hptr, SAVEt_HPTR);
 }
 
 void
@@ -496,77 +496,71 @@ Perl_save_aptr(pTHX_ AV **aptr)
 
     PERL_ARGS_ASSERT_SAVE_APTR;
 
-    SSCHECK(3);
-    SSPUSHPTR(*aptr);
-    SSPUSHPTR(aptr);
-    SSPUSHINT(SAVEt_APTR);
+    save_pushptrptr(*aptr, aptr, SAVEt_APTR);
 }
 
 void
-Perl_save_freesv(pTHX_ SV *sv)
+Perl_save_pushptr(pTHX_ void *const ptr, const int type)
 {
     dVAR;
     SSCHECK(2);
-    SSPUSHPTR(sv);
-    SSPUSHINT(SAVEt_FREESV);
+    SSPUSHPTR(ptr);
+    SSPUSHUV(type);
 }
 
 void
-Perl_save_mortalizesv(pTHX_ SV *sv)
+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_MORTALIZESV;
+    PERL_ARGS_ASSERT_SAVE_CLEARSV;
 
-    SSCHECK(2);
-    SSPUSHPTR(sv);
-    SSPUSHINT(SAVEt_MORTALIZESV);
-}
+    ASSERT_CURPAD_ACTIVE("save_clearsv");
+    if ((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)
+	Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
+		   offset, svp, PL_curpad);
 
-void
-Perl_save_freeop(pTHX_ OP *o)
-{
-    dVAR;
-    SSCHECK(2);
-    SSPUSHPTR(o);
-    SSPUSHINT(SAVEt_FREEOP);
+    SSCHECK(1);
+    SSPUSHUV(offset_shifted | SAVEt_CLEARSV);
+    SvPADSTALE_off(*svp); /* mark lexical as active */
 }
 
 void
-Perl_save_freepv(pTHX_ char *pv)
+Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 {
     dVAR;
-    SSCHECK(2);
-    SSPUSHPTR(pv);
-    SSPUSHINT(SAVEt_FREEPV);
+
+    PERL_ARGS_ASSERT_SAVE_DELETE;
+
+    save_pushptri32ptr(key, klen, SvREFCNT_inc_simple(hv), SAVEt_DELETE);
 }
 
 void
-Perl_save_clearsv(pTHX_ SV **svp)
+Perl_save_hdelete(pTHX_ HV *hv, SV *keysv)
 {
-    dVAR;
+    STRLEN len;
+    I32 klen;
+    const char *key;
 
-    PERL_ARGS_ASSERT_SAVE_CLEARSV;
+    PERL_ARGS_ASSERT_SAVE_HDELETE;
 
-    ASSERT_CURPAD_ACTIVE("save_clearsv");
-    SSCHECK(2);
-    SSPUSHLONG((long)(svp-PL_curpad));
-    SSPUSHINT(SAVEt_CLEARSV);
-    SvPADSTALE_off(*svp); /* mark lexical as active */
+    key  = SvPV_const(keysv, len);
+    klen = SvUTF8(keysv) ? -(I32)len : (I32)len;
+    SvREFCNT_inc_simple_void_NN(hv);
+    save_pushptri32ptr(savepvn(key, len), klen, hv, SAVEt_DELETE);
 }
 
 void
-Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
+Perl_save_adelete(pTHX_ AV *av, I32 key)
 {
     dVAR;
 
-    PERL_ARGS_ASSERT_SAVE_DELETE;
+    PERL_ARGS_ASSERT_SAVE_ADELETE;
 
-    SSCHECK(4);
-    SSPUSHINT(klen);
-    SSPUSHPTR(key);
-    SSPUSHPTR(SvREFCNT_inc_simple(hv));
-    SSPUSHINT(SAVEt_DELETE);
+    SvREFCNT_inc_void(av);
+    save_pushi32ptr(key, av, SAVEt_ADELETE);
 }
 
 void
@@ -579,7 +573,7 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
     SSCHECK(3);
     SSPUSHDPTR(f);
     SSPUSHPTR(p);
-    SSPUSHINT(SAVEt_DESTRUCTOR);
+    SSPUSHUV(SAVEt_DESTRUCTOR);
 }
 
 void
@@ -589,57 +583,82 @@ 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
-Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
+Perl_save_hints(pTHX)
+{
+    dVAR;
+    COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
+    if (PL_hints & HINT_LOCALIZE_HH) {
+	save_pushptri32ptr(GvHV(PL_hintgv), PL_hints, save_cophh, SAVEt_HINTS);
+	GvHV(PL_hintgv) = hv_copy_hints_hv(GvHV(PL_hintgv));
+    } else {
+	save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS);
+    }
+}
+
+static void
+S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2,
+			const int type)
+{
+    SSCHECK(4);
+    SSPUSHPTR(ptr1);
+    SSPUSHINT(i);
+    SSPUSHPTR(ptr2);
+    SSPUSHUV(type);
+}
+
+void
+Perl_save_aelem_flags(pTHX_ AV *av, I32 idx, SV **sptr, const U32 flags)
 {
     dVAR;
     SV *sv;
 
-    PERL_ARGS_ASSERT_SAVE_AELEM;
+    PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS;
 
     SvGETMAGIC(*sptr);
-    SSCHECK(4);
-    SSPUSHPTR(SvREFCNT_inc_simple(av));
-    SSPUSHINT(idx);
-    SSPUSHPTR(SvREFCNT_inc(*sptr));
-    SSPUSHINT(SAVEt_AELEM);
+    save_pushptri32ptr(SvREFCNT_inc_simple(av), idx, SvREFCNT_inc(*sptr),
+		       SAVEt_AELEM);
     /* if it gets reified later, the restore will have the wrong refcnt */
     if (!AvREAL(av) && AvREIFY(av))
 	SvREFCNT_inc_void(*sptr);
-    save_scalar_at(sptr);
+    save_scalar_at(sptr, flags); /* XXX - FIXME - see #60360 */
+    if (flags & SAVEf_KEEPOLDELEM)
+	return;
     sv = *sptr;
     /* If we're localizing a tied array element, this new sv
      * 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);
 }
 
 void
-Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
+Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
 {
     dVAR;
     SV *sv;
 
-    PERL_ARGS_ASSERT_SAVE_HELEM;
+    PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS;
 
     SvGETMAGIC(*sptr);
     SSCHECK(4);
     SSPUSHPTR(SvREFCNT_inc_simple(hv));
     SSPUSHPTR(newSVsv(key));
     SSPUSHPTR(SvREFCNT_inc(*sptr));
-    SSPUSHINT(SAVEt_HELEM);
-    save_scalar_at(sptr);
+    SSPUSHUV(SAVEt_HELEM);
+    save_scalar_at(sptr, flags);
+    if (flags & SAVEf_KEEPOLDELEM)
+	return;
     sv = *sptr;
     /* If we're localizing a tied hash element, this new sv
      * 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);
 }
 
@@ -651,20 +670,8 @@ Perl_save_svref(pTHX_ SV **sptr)
     PERL_ARGS_ASSERT_SAVE_SVREF;
 
     SvGETMAGIC(*sptr);
-    SSCHECK(3);
-    SSPUSHPTR(sptr);
-    SSPUSHPTR(SvREFCNT_inc(*sptr));
-    SSPUSHINT(SAVEt_SVREF);
-    return save_scalar_at(sptr);
-}
-
-void
-Perl_save_op(pTHX)
-{
-    dVAR;
-    SSCHECK(2);
-    SSPUSHPTR(PL_op);
-    SSPUSHINT(SAVEt_OP);
+    save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_SVREF);
+    return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 }
 
 I32
@@ -673,13 +680,17 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
     dVAR;
     register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
 				- (char*)PL_savestack);
-    register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+    const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+    const UV elems_shifted = elems << SAVE_TIGHT_SHIFT;
+
+    if ((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)
+	Perl_croak(aTHX_ "panic: save_alloc elems %"UVuf" out of range (%ld-%ld)",
+		   elems, size, pad);
 
-    SSGROW(elems + 2);
+    SSGROW(elems + 1);
 
     PL_savestack_ix += elems;
-    SSPUSHINT(elems);
-    SSPUSHINT(SAVEt_ALLOC);
+    SSPUSHUV(SAVEt_ALLOC | elems_shifted);
     return start;
 }
 
@@ -695,11 +706,19 @@ Perl_leave_scope(pTHX_ I32 base)
     void* ptr;
     register char* str;
     I32 i;
+    /* Localise the effects of the TAINT_NOT inside the loop.  */
+    const bool was = PL_tainted;
 
     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) {
-	switch (SSPOPINT) {
+	UV uv = SSPOPUV;
+	const U8 type = (U8)uv & SAVE_MASK;
+	TAINT_NOT;
+
+	switch (type) {
 	case SAVEt_ITEM:			/* normal string */
 	    value = MUTABLE_SV(SSPOPPTR);
 	    sv = MUTABLE_SV(SSPOPPTR);
@@ -710,7 +729,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    break;
 	case SAVEt_SV:				/* scalar reference */
 	    value = MUTABLE_SV(SSPOPPTR);
-	    gv = (GV*)SSPOPPTR;
+	    gv = MUTABLE_GV(SSPOPPTR);
 	    ptr = &GvSV(gv);
 	    av = MUTABLE_AV(gv); /* what to refcnt_dec */
 	restore_sv:
@@ -744,9 +763,15 @@ Perl_leave_scope(pTHX_ I32 base)
 		*(char**)ptr = str;
 	    }
 	    break;
+	case SAVEt_GVSV:			/* scalar slot in GV */
+	    value = MUTABLE_SV(SSPOPPTR);
+	    gv = MUTABLE_GV(SSPOPPTR);
+	    ptr = &GvSV(gv);
+	    goto restore_svp;
 	case SAVEt_GENERIC_SVREF:		/* generic sv */
 	    value = MUTABLE_SV(SSPOPPTR);
 	    ptr = SSPOPPTR;
+	restore_svp:
 	    sv = *(SV**)ptr;
 	    *(SV**)ptr = value;
 	    SvREFCNT_dec(sv);
@@ -754,10 +779,8 @@ Perl_leave_scope(pTHX_ I32 base)
 	    break;
 	case SAVEt_AV:				/* array reference */
 	    av = MUTABLE_AV(SSPOPPTR);
-	    gv = (GV*)SSPOPPTR;
-	    if (GvAV(gv)) {
-		SvREFCNT_dec(GvAV(gv));
-	    }
+	    gv = MUTABLE_GV(SSPOPPTR);
+	    SvREFCNT_dec(GvAV(gv));
 	    GvAV(gv) = av;
 	    if (SvMAGICAL(av)) {
 		PL_localizing = 2;
@@ -767,10 +790,8 @@ Perl_leave_scope(pTHX_ I32 base)
 	    break;
 	case SAVEt_HV:				/* hash reference */
 	    hv = MUTABLE_HV(SSPOPPTR);
-	    gv = (GV*)SSPOPPTR;
-	    if (GvHV(gv)) {
-		SvREFCNT_dec(GvHV(gv));
-	    }
+	    gv = MUTABLE_GV(SSPOPPTR);
+	    SvREFCNT_dec(GvHV(gv));
 	    GvHV(gv) = hv;
 	    if (SvMAGICAL(hv)) {
 		PL_localizing = 2;
@@ -778,13 +799,21 @@ Perl_leave_scope(pTHX_ I32 base)
 		PL_localizing = 0;
 	    }
 	    break;
+	case SAVEt_INT_SMALL:
+	    ptr = SSPOPPTR;
+	    *(int*)ptr = (int)(uv >> SAVE_TIGHT_SHIFT);
+	    break;
 	case SAVEt_INT:				/* int reference */
 	    ptr = SSPOPPTR;
 	    *(int*)ptr = (int)SSPOPINT;
 	    break;
 	case SAVEt_BOOL:			/* bool reference */
 	    ptr = SSPOPPTR;
-	    *(bool*)ptr = (bool)SSPOPBOOL;
+	    *(bool*)ptr = cBOOL(uv >> 8);
+	    break;
+	case SAVEt_I32_SMALL:
+	    ptr = SSPOPPTR;
+	    *(I32*)ptr = (I32)(uv >> SAVE_TIGHT_SHIFT);
 	    break;
 	case SAVEt_I32:				/* I32 reference */
 	    ptr = SSPOPPTR;
@@ -817,11 +846,11 @@ Perl_leave_scope(pTHX_ I32 base)
 	    break;
 	case SAVEt_GP:				/* scalar reference */
 	    ptr = SSPOPPTR;
-	    gv = (GV*)SSPOPPTR;
+	    gv = MUTABLE_GV(SSPOPPTR);
 	    gp_free(gv);
 	    GvGP(gv) = (GP*)ptr;
             /* putting a method back into circulation ("local")*/
-	    if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
+	    if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvENAME_get(hv))
                 mro_method_changed_in(hv);
 	    SvREFCNT_dec(gv);
 	    break;
@@ -829,6 +858,10 @@ Perl_leave_scope(pTHX_ I32 base)
 	    ptr = SSPOPPTR;
 	    SvREFCNT_dec(MUTABLE_SV(ptr));
 	    break;
+	case SAVEt_FREECOPHH:
+	    ptr = SSPOPPTR;
+	    cophh_free((COPHH *)ptr);
+	    break;
 	case SAVEt_MORTALIZESV:
 	    ptr = SSPOPPTR;
 	    sv_2mortal(MUTABLE_SV(ptr));
@@ -843,7 +876,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,
@@ -901,19 +934,27 @@ Perl_leave_scope(pTHX_ I32 base)
 	case SAVEt_DELETE:
 	    ptr = SSPOPPTR;
 	    hv = MUTABLE_HV(ptr);
+	    i = SSPOPINT;
 	    ptr = SSPOPPTR;
-	    (void)hv_delete(hv, (char*)ptr, (I32)SSPOPINT, G_DISCARD);
+	    (void)hv_delete(hv, (char*)ptr, i, G_DISCARD);
 	    SvREFCNT_dec(hv);
 	    Safefree(ptr);
 	    break;
+	case SAVEt_ADELETE:
+	    ptr = SSPOPPTR;
+	    av = MUTABLE_AV(ptr);
+	    i = SSPOPINT;
+	    (void)av_delete(av, i, G_DISCARD);
+	    SvREFCNT_dec(av);
+	    break;
 	case SAVEt_DESTRUCTOR_X:
 	    ptr = SSPOPPTR;
 	    (*SSPOPDXPTR)(aTHX_ ptr);
 	    break;
 	case SAVEt_REGCONTEXT:
+	    /* regexp must have croaked */
 	case SAVEt_ALLOC:
-	    i = SSPOPINT;
-	    PL_savestack_ix -= i;  	/* regexp must have croaked */
+	    PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT;
 	    break;
 	case SAVEt_STACK_POS:		/* Position on Perl stack */
 	    i = SSPOPINT;
@@ -946,19 +987,18 @@ Perl_leave_scope(pTHX_ I32 base)
 	    sv = MUTABLE_SV(SSPOPPTR);
 	    hv = MUTABLE_HV(SSPOPPTR);
 	    ptr = hv_fetch_ent(hv, sv, 1, 0);
+	    SvREFCNT_dec(sv);
 	    if (ptr) {
 		const SV * const oval = HeVAL((HE*)ptr);
 		if (oval && oval != &PL_sv_undef) {
 		    ptr = &HeVAL((HE*)ptr);
 		    if (SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))
 			SvREFCNT_inc_void(*(SV**)ptr);
-		    SvREFCNT_dec(sv);
 		    av = MUTABLE_AV(hv); /* what to refcnt_dec */
 		    goto restore_sv;
 		}
 	    }
 	    SvREFCNT_dec(hv);
-	    SvREFCNT_dec(sv);
 	    SvREFCNT_dec(value);
 	    break;
 	case SAVEt_OP:
@@ -969,9 +1009,9 @@ Perl_leave_scope(pTHX_ I32 base)
 		SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
 		GvHV(PL_hintgv) = NULL;
 	    }
+	    cophh_free(CopHINTHASH_get(&PL_compiling));
+	    CopHINTHASH_set(&PL_compiling, (COPHH*)SSPOPPTR);
 	    *(I32*)&PL_hints = (I32)SSPOPINT;
-	    Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
-	    PL_compiling.cop_hints_hash = (struct refcounted_he *) SSPOPPTR;
 	    if (PL_hints & HINT_LOCALIZE_HH) {
 		SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
 		GvHV(PL_hintgv) = MUTABLE_HV(SSPOPPTR);
@@ -1048,7 +1088,7 @@ Perl_leave_scope(pTHX_ I32 base)
 
 	    /* These are only saved in mathoms.c */
 	case SAVEt_NSTAB:
-	    gv = (GV*)SSPOPPTR;
+	    gv = MUTABLE_GV(SSPOPPTR);
 	    (void)sv_clear(MUTABLE_SV(gv));
 	    break;
 	case SAVEt_LONG:			/* long reference */
@@ -1062,11 +1102,11 @@ Perl_leave_scope(pTHX_ I32 base)
 
 	case SAVEt_I16:				/* I16 reference */
 	    ptr = SSPOPPTR;
-	    *(I16*)ptr = (I16)SSPOPINT;
+	    *(I16*)ptr = (I16)(uv >> 8);
 	    break;
 	case SAVEt_I8:				/* I8 reference */
 	    ptr = SSPOPPTR;
-	    *(I8*)ptr = (I8)SSPOPINT;
+	    *(I8*)ptr = (I8)(uv >> 8);
 	    break;
 	case SAVEt_DESTRUCTOR:
 	    ptr = SSPOPPTR;
@@ -1110,6 +1150,10 @@ Perl_leave_scope(pTHX_ I32 base)
 	    Perl_croak(aTHX_ "panic: leave_scope inconsistency");
 	}
     }
+
+    PL_tainted = was;
+
+    PERL_ASYNC_CHECK();
 }
 
 void
@@ -1182,8 +1226,6 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
 		(long)cx->blk_loop.resetsp);
 	PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
 		PTR2UV(cx->blk_loop.my_op));
-	PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
-		PTR2UV(CX_LOOP_NEXTOP_GET(cx)));
 	/* XXX: not accurate for LAZYSV/IV */
 	PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
 		PTR2UV(cx->blk_loop.state_u.ary.ary));