This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix multi-evals problems in pad name list api
authorDaniel Dragan <bulk88@hotmail.com>
Wed, 11 Jun 2014 23:19:17 +0000 (19:19 -0400)
committerTony Cook <tony@develop-help.com>
Tue, 24 Jun 2014 06:35:01 +0000 (16:35 +1000)
The PAD_COMPNAME api, created in dd2155a49b , originally had alot of,
multi-eval problems, since av_fetch would be repeatedly called in macro
expansions. Later in commit b21dc0313d , an incomplete attempt at removing
multi-eval was done. Also in commit 035dab7448 added more multi-eval
problems. Prior to commit dd2155a49b , the code used a seemingly random
mix of av_fetch and AvARRAY, so both are ok. To fix this, replace av_fetch
with func-free AvARRAY. Since existing code has lval 0 to av_fetch and
unconditional deref on ret, a segv is fine to detect breakage.

A #define PAD_COMPNAME_SV(po) \
((assert(!SvMAGICAL(PL_comppad_name))),(AvARRAY(PL_comppad_name)[(po)]))
shows the AV is ! magical/tied during smoke. The assert was not added for
perf reasons on debugging builds. Inline funcs were not used for better
compiler optimizing if PAD_COMPNAME_FLAGS_isOUR is immediatly
followed by PAD_COMPNAME_OURSTASH (2 statements), as in scan_inputsymbol.
Inlines are not guaranteed to be inlined all the time on all compilers in all
situations, Visual C especially. Also inline is more likely to cause readding of
multi-eval problems than the macro if future changes to the API put the inline
func in a multi-eval macro.

On VC 2003 32bit .text section of perl521.dll dropped from 0xC296F to
0xC281F bytes of machine code with this patch.

op.c
pad.c
pad.h

diff --git a/op.c b/op.c
index d7a99ad..132b58e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9210,7 +9210,7 @@ Perl_ck_sassign(pTHX_ OP *o)
             )
            )
                && (kkid->op_private & OPpLVAL_INTRO)
-               && SvPAD_STATE(*av_fetch(PL_comppad_name, kkid->op_targ, FALSE))) {
+               && SvPAD_STATE(PAD_COMPNAME_SV(kkid->op_targ))) {
            const PADOFFSET target = kkid->op_targ;
            OP *const other = newOP(OP_PADSV,
                                    kkid->op_flags
@@ -9571,7 +9571,7 @@ S_simplify_sort(pTHX_ OP *o)
        kid = kBINOP->op_first;
        do {
            if (kid->op_type == OP_PADSV) {
-               SV * const name = AvARRAY(PL_comppad_name)[kid->op_targ];
+               SV * const name = PAD_COMPNAME_SV(kid->op_targ);
                if (SvCUR(name) == 2 && *SvPVX(name) == '$'
                 && (SvPVX(name)[1] == 'a' || SvPVX(name)[1] == 'b'))
                    /* diag_listed_as: "my %s" used in sort comparison */
diff --git a/pad.c b/pad.c
index da067bf..dca1750 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -2352,9 +2352,9 @@ HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 {
     dVAR;
-    SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
-    if ( SvPAD_TYPED(*av) ) {
-        return SvSTASH(*av);
+    SV* const av = PAD_COMPNAME_SV(po);
+    if ( SvPAD_TYPED(av) ) {
+        return SvSTASH(av);
     }
     return NULL;
 }
diff --git a/pad.h b/pad.h
index b36eafb..c29a13f 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -398,7 +398,7 @@ ling pad (lvalue) to C<gen>.  Note that C<SvUV_set> is hijacked for this purpose
 */
 
 #define PAD_COMPNAME(po)       PAD_COMPNAME_SV(po)
-#define PAD_COMPNAME_SV(po) (*av_fetch(PL_comppad_name, (po), FALSE))
+#define PAD_COMPNAME_SV(po) (AvARRAY(PL_comppad_name)[(po)])
 #define PAD_COMPNAME_FLAGS(po) SvFLAGS(PAD_COMPNAME_SV(po))
 #define PAD_COMPNAME_FLAGS_isOUR(po) SvPAD_OUR(PAD_COMPNAME_SV(po))
 #define PAD_COMPNAME_PV(po) SvPV_nolen(PAD_COMPNAME_SV(po))