optimize & rmv from public API Perl_tmps_grow and related code
authorDaniel Dragan <bulk88@hotmail.com>
Fri, 10 Oct 2014 17:29:33 +0000 (13:29 -0400)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 10 Oct 2014 21:30:21 +0000 (14:30 -0700)
Previously in PUSH_EXTEND_MORTAL__SV_C, "PL_tmps_ix + 1" would execute
twice, once for the nonmutable if(>=), then again after the potential
tmps_grow call. tmps_grow has an unused return register/void proto, put it
to use by returning ix.  Also change tmps_grow to take the result of
"PL_tmps_ix + the constant (usually 1) or non-constant (EXTEND_MORTAL)".
This avoid having to put the constant twice in machine code, once for the
if test, 2nd time for extend length param for tmps_grow call. For
non-constant/EXTEND_MORTAL usage, it allows the C optimizer to have the
length var to go out of liveness sooner if possible. Also the var used for
the if(>=) test is more likely to be in a register than length var.
So "if test variable" is closer on hand to the CPU than length var. In some
cases, if non-const len var isn't used again, it becomes the "ix" variable
by having PL_tmps_ix added to it. Change sv_2mortal to return sv instead
of NULL to remove a unique branch/block of machine code that assigns 0 to
return variable (Visual C didn't figure out return sv == returned NULL,
not sv). See also [perl #121845].

embed.fnc
embed.h
pod/perldelta.pod
pp.h
proto.h
scope.c
sv.c

index a06de68..a0cac62 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1787,7 +1787,7 @@ Apd       |void   |sv_utf8_encode |NN SV *const sv
 ApdM   |bool   |sv_utf8_decode |NN SV *const sv
 Apdmb  |void   |sv_force_normal|NN SV *sv
 Apd    |void   |sv_force_normal_flags|NN SV *const sv|const U32 flags
-Ap     |void   |tmps_grow      |SSize_t n
+pX     |SSize_t|tmps_grow_p    |SSize_t ix
 Apd    |SV*    |sv_rvweaken    |NN SV *const sv
 : This is indirectly referenced by globals.c. This is somewhat annoying.
 p      |int    |magic_killbackrefs|NN SV *sv|NN MAGIC *mg
diff --git a/embed.h b/embed.h
index 91b5bfe..d73816f 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define sync_locale()          Perl_sync_locale(aTHX)
 #define taint_env()            Perl_taint_env(aTHX)
 #define taint_proper(a,b)      Perl_taint_proper(aTHX_ a,b)
-#define tmps_grow(a)           Perl_tmps_grow(aTHX_ a)
 #define to_uni_lower(a,b,c)    Perl_to_uni_lower(aTHX_ a,b,c)
 #define to_uni_lower_lc(a)     Perl_to_uni_lower_lc(aTHX_ a)
 #define to_uni_title(a,b,c)    Perl_to_uni_title(aTHX_ a,b,c)
 #ifndef PERL_IMPLICIT_CONTEXT
 #define tied_method            Perl_tied_method
 #endif
+#define tmps_grow_p(a)         Perl_tmps_grow_p(aTHX_ a)
 #define unshare_hek(a)         Perl_unshare_hek(aTHX_ a)
 #define utilize(a,b,c,d,e)     Perl_utilize(aTHX_ a,b,c,d,e)
 #define vivify_ref(a,b)                Perl_vivify_ref(aTHX_ a,b)
index be43e45..12f22ab 100644 (file)
@@ -406,6 +406,12 @@ testing their values in C<pp_dbstate>.  This prevents perl from
 recursing infinity if an overloaded object is assigned to any of those
 variables. [perl #122445]
 
+=item *
+
+C<Perl_tmps_grow> which is marked as public API but undocumented has been
+removed from public API. If you use C<EXTEND_MORTAL> macro in your XS code to
+preextend the mortal stack, you are unaffected by this change.
+
 =back
 
 =head1 Selected Bug Fixes
diff --git a/pp.h b/pp.h
index 00e9420..0ced1d6 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -391,9 +391,10 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
     } STMT_END
 
 #define EXTEND_MORTAL(n) \
-    STMT_START {                                                       \
-       if (UNLIKELY(PL_tmps_ix + (n) >= PL_tmps_max))                  \
-           tmps_grow(n);                                               \
+    STMT_START {                                               \
+       SSize_t eMiX = PL_tmps_ix + (n);                        \
+       if (UNLIKELY(eMiX >= PL_tmps_max))                      \
+           (void)tmps_grow_p(eMiX);                            \
     } STMT_END
 
 #define AMGf_noright   1
diff --git a/proto.h b/proto.h
index 51eb005..c7d86dd 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4784,7 +4784,7 @@ PERL_CALLCONV OP *        Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, c
 #define PERL_ARGS_ASSERT_TIED_METHOD   \
        assert(methname); assert(sp); assert(sv); assert(mg)
 
-PERL_CALLCONV void     Perl_tmps_grow(pTHX_ SSize_t n);
+PERL_CALLCONV SSize_t  Perl_tmps_grow_p(pTHX_ SSize_t ix);
 /* PERL_CALLCONV UV    Perl_to_uni_fold(pTHX_ UV c, U8 *p, STRLEN *lenp)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3); */
diff --git a/scope.c b/scope.c
index 1084484..9fd2546 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -132,15 +132,34 @@ Perl_savestack_grow_cnt(pTHX_ I32 need)
 
 #undef GROW
 
-void
-Perl_tmps_grow(pTHX_ SSize_t n)
+/*  The original function was called Perl_tmps_grow and was removed from public
+    API, Perl_tmps_grow_p is the replacement and it used in public macros but
+    isn't public itself.
+
+    Perl_tmps_grow_p takes a proposed ix. A proposed ix is PL_tmps_ix + extend_by,
+    where the result of (PL_tmps_ix + extend_by) is >= PL_tmps_max
+    Upon return, PL_tmps_stack[ix] will be a valid address. For machine code
+    optimization and register usage reasons, the proposed ix passed into
+    tmps_grow is returned to the caller which the caller can then use to write
+    an SV * to PL_tmps_stack[ix]. If the caller was using tmps_grow in
+    pre-extend mode (EXTEND_MORTAL macro), then it ignores the return value of
+    tmps_grow. Note, tmps_grow DOES NOT write ix to PL_tmps_ix, the caller
+    must assign ix or ret val of tmps_grow to PL_temps_ix themselves if that is
+    appropriate. The assignment to PL_temps_ix can happen before or after
+    tmps_grow call since tmps_grow doesn't look at PL_tmps_ix.
+ */
+
+SSize_t
+Perl_tmps_grow_p(pTHX_ SSize_t ix)
 {
+    SSize_t extend_to = ix;
 #ifndef STRESS_REALLOC
-    if (n < 128)
-       = (PL_tmps_max < 512) ? 128 : 512;
+    if (ix - PL_tmps_max < 128)
+       extend_to += (PL_tmps_max < 512) ? 128 : 512;
 #endif
-    PL_tmps_max = PL_tmps_ix + n + 1;
+    PL_tmps_max = extend_to + 1;
     Renew(PL_tmps_stack, PL_tmps_max, SV*);
+    return ix;
 }
 
 
diff --git a/sv.c b/sv.c
index dd0a97e..665a0f6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8906,8 +8906,10 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv)
  */
 #define PUSH_EXTEND_MORTAL__SV_C(AnSv) \
     STMT_START {      \
-       EXTEND_MORTAL(1); \
-       PL_tmps_stack[++PL_tmps_ix] = (AnSv); \
+       SSize_t ix = ++PL_tmps_ix;              \
+       if (UNLIKELY(ix >= PL_tmps_max))        \
+           ix = tmps_grow_p(ix);                       \
+       PL_tmps_stack[ix] = (AnSv); \
     } STMT_END
 
 /*
@@ -9029,7 +9031,7 @@ Perl_sv_2mortal(pTHX_ SV *const sv)
 {
     dVAR;
     if (!sv)
-       return NULL;
+       return sv;
     if (SvIMMORTAL(sv))
        return sv;
     PUSH_EXTEND_MORTAL__SV_C(sv);