This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
For SVt_CLEAR, store the pad offset with the type.
authorNicholas Clark <nick@ccl4.org>
Sat, 20 Feb 2010 13:36:21 +0000 (13:36 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 2 May 2010 07:58:00 +0000 (08:58 +0100)
This saves 1 slot on the save stack for each lexical encountered at run time.

scope.c
sv.c

diff --git a/scope.c b/scope.c
index 78e5760..2b00d34 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -507,13 +507,18 @@ 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));
-    SSPUSHUV(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 */
 }
 
@@ -850,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,
diff --git a/sv.c b/sv.c
index 31db315..a06b06c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -11509,6 +11509,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 
        TOPUV(nss,ix) = uv;
        switch (type) {
+       case SAVEt_CLEARSV:
+           break;
        case SAVEt_HELEM:               /* hash element */
            sv = (const SV *)POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup_inc(sv, param);
@@ -11555,8 +11557,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
        case SAVEt_LONG:                        /* long reference */
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
-           /* fall through */
-       case SAVEt_CLEARSV:
            longval = (long)POPLONG(ss,ix);
            TOPLONG(nss,ix) = longval;
            break;