add SAVEt_TMPSFLOOR save type and Perl_savetmps()
authorDavid Mitchell <davem@iabyn.com>
Sun, 27 Dec 2015 10:41:41 +0000 (10:41 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 09:19:19 +0000 (09:19 +0000)
By making SAVETMPS have its own dedicated save type, it avoids having to
push the address of PL_tmps_floor onto the save stack each time.
By also giving it a dedicated save function, the function can do
the PL_tmpsfloor = PL_tmps_ix step too, making the binary slightly more
compact.

embed.fnc
proto.h
scope.c
scope.h
sv.c

index 7f2f7da..5368ad1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1304,6 +1304,7 @@ Ap        |void   |save_padsv_and_mortalize|PADOFFSET off
 Ap     |void   |save_sptr      |NN SV** sptr
 Xp     |void   |save_strlen    |NN STRLEN* ptr
 Ap     |SV*    |save_svref     |NN SV** sptr
+AMpo   |void   |savetmps
 Ap     |void   |save_pushptr   |NULLOK void *const ptr|const int type
 Ap     |void   |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type
 : Used by SAVESWITCHSTACK() in pp.c
diff --git a/proto.h b/proto.h
index 941854e..fa1a5ba 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2771,6 +2771,7 @@ PERL_CALLCONV char*       Perl_savesvpv(pTHX_ SV* sv)
 #define PERL_ARGS_ASSERT_SAVESVPV      \
        assert(sv)
 
+PERL_CALLCONV void     Perl_savetmps(pTHX);
 PERL_CALLCONV OP*      Perl_sawparens(pTHX_ OP* o);
 PERL_CALLCONV OP*      Perl_scalar(pTHX_ OP* o);
 PERL_CALLCONV OP*      Perl_scalarvoid(pTHX_ OP* o);
diff --git a/scope.c b/scope.c
index db2fef1..f1d1ccb 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -731,6 +731,18 @@ Perl_save_svref(pTHX_ SV **sptr)
     return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 }
 
+
+void
+Perl_savetmps(pTHX)
+{
+    dSS_ADD;
+    SS_ADD_IV(PL_tmps_floor);
+    PL_tmps_floor = PL_tmps_ix;
+    SS_ADD_UV(SAVEt_TMPSFLOOR);
+    SS_ADD_END(2);
+}
+
+
 I32
 Perl_save_alloc(pTHX_ I32 size, I32 pad)
 {
@@ -945,6 +957,9 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_STRLEN:                      /* STRLEN/size_t ref */
            *(STRLEN*)ARG0_PTR = (STRLEN)arg1.any_iv;
            break;
+       case SAVEt_TMPSFLOOR:                   /* restore PL_tmps_floor */
+           PL_tmps_floor = (SSize_t)arg0.any_iv;
+           break;
        case SAVEt_BOOL:                        /* bool reference */
            *(bool*)ARG0_PTR = cBOOL(uv >> 8);
 #ifdef NO_TAINT_SUPPORT
diff --git a/scope.h b/scope.h
index 822c8ba..e6cc5f8 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -21,7 +21,7 @@
 
 /* one arg */
 
-/*** SPARE                     4 ***/
+#define SAVEt_TMPSFLOOR                4
 #define SAVEt_BOOL             5
 #define SAVEt_COMPILE_WARNINGS 6
 #define SAVEt_COMPPAD          7
@@ -188,8 +188,8 @@ scope has the given name. Name must be a literal string.
 =cut
 */
 
-#define SAVETMPS Perl_save_strlen(aTHX_ (STRLEN *)&PL_tmps_floor), \
-                PL_tmps_floor = PL_tmps_ix
+#define SAVETMPS Perl_savetmps(aTHX)
+
 #define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps()
 
 #ifdef DEBUGGING
diff --git a/sv.c b/sv.c
index 7f33794..d0400bb 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -14255,6 +14255,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            iv = POPIV(ss,ix);
            TOPIV(nss,ix) = iv;
            break;
+       case SAVEt_TMPSFLOOR:
+           iv = POPIV(ss,ix);
+           TOPIV(nss,ix) = iv;
+           break;
        case SAVEt_HPTR:                        /* HV* reference */
        case SAVEt_APTR:                        /* AV* reference */
        case SAVEt_SPTR:                        /* SV* reference */