From f815dc14d7c5540dfb5d02d001e0101c6266f281 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 30 Jun 2013 00:20:33 -0700 Subject: [PATCH] Inline list constants These are inlined the same way as 1..5. We have two ops: rv2av | `-- const The const op returns an AV, which is stored in the op tree, and then rv2av flattens it. --- embed.fnc | 1 + embed.h | 1 + op.c | 11 +++++++++++ proto.h | 3 +++ toke.c | 15 ++++++++++----- 5 files changed, 26 insertions(+), 5 deletions(-) diff --git a/embed.fnc b/embed.fnc index 8aed92a..1426d57 100644 --- a/embed.fnc +++ b/embed.fnc @@ -300,6 +300,7 @@ p |void |cv_ckproto_len_flags |NN const CV* cv|NULLOK const GV* gv\ : Used in pp.c and pp_sys.c ApdR |SV* |gv_const_sv |NN GV* gv ApdR |SV* |cv_const_sv |NULLOK const CV *const cv +pR |SV* |cv_const_sv_or_av|NULLOK const CV *const cv : Used in pad.c pR |SV* |op_const_sv |NULLOK const OP* o|NULLOK CV* cv Apd |void |cv_undef |NN CV* cv diff --git a/embed.h b/embed.h index 353357b..039cde4 100644 --- a/embed.h +++ b/embed.h @@ -1069,6 +1069,7 @@ #define croak_popstack Perl_croak_popstack #define cv_ckproto_len_flags(a,b,c,d,e) Perl_cv_ckproto_len_flags(aTHX_ a,b,c,d,e) #define cv_clone_into(a,b) Perl_cv_clone_into(aTHX_ a,b) +#define cv_const_sv_or_av(a) Perl_cv_const_sv_or_av(aTHX_ a) #define cv_forget_slab(a) Perl_cv_forget_slab(aTHX_ a) #define cvgv_set(a,b) Perl_cvgv_set(aTHX_ a,b) #define cvstash_set(a,b) Perl_cvstash_set(aTHX_ a,b) diff --git a/op.c b/op.c index f9ca03f..a6312d3 100644 --- a/op.c +++ b/op.c @@ -6875,6 +6875,16 @@ Perl_cv_const_sv(pTHX_ const CV *const cv) return sv; } +SV * +Perl_cv_const_sv_or_av(pTHX_ const CV * const cv) +{ + PERL_UNUSED_CONTEXT; + if (!cv) + return NULL; + assert (SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM); + return CvCONST(cv) ? MUTABLE_SV(CvXSUBANY(cv).any_ptr) : NULL; +} + /* op_const_sv: examine an optree to determine whether it's in-lineable. * Can be called in 3 ways: * @@ -8582,6 +8592,7 @@ Perl_ck_rvconst(pTHX_ OP *o) Perl_croak(aTHX_ "Constant is not %s reference", badtype); return o; } + if (SvTYPE(kidsv) == SVt_PVAV) return o; if ((o->op_private & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) { const char *badthing; switch (o->op_type) { diff --git a/proto.h b/proto.h index 89c7316..aca7030 100644 --- a/proto.h +++ b/proto.h @@ -746,6 +746,9 @@ PERL_CALLCONV CV* Perl_cv_clone_into(pTHX_ CV* proto, CV *target) PERL_CALLCONV SV* Perl_cv_const_sv(pTHX_ const CV *const cv) __attribute__warn_unused_result__; +PERL_CALLCONV SV* Perl_cv_const_sv_or_av(pTHX_ const CV *const cv) + __attribute__warn_unused_result__; + PERL_CALLCONV void Perl_cv_forget_slab(pTHX_ CV *cv) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_CV_FORGET_SLAB \ diff --git a/toke.c b/toke.c index 1781899..c030aec 100644 --- a/toke.c +++ b/toke.c @@ -7323,7 +7323,7 @@ Perl_yylex(pTHX) d = s + 1; while (SPACE_OR_TAB(*d)) d++; - if (*d == ')' && (sv = cv_const_sv(cv))) { + if (*d == ')' && (sv = cv_const_sv_or_av(cv))) { s = d + 1; goto its_constant; } @@ -7387,14 +7387,19 @@ Perl_yylex(pTHX) UTF8fARG(UTF, l, PL_tokenbuf)); } /* Check for a constant sub */ - if ((sv = cv_const_sv(cv))) { + if ((sv = cv_const_sv_or_av(cv))) { its_constant: op_free(rv2cv_op); SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv); ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv); - pl_yylval.opval->op_private = OPpCONST_FOLDED; - pl_yylval.opval->op_folded = 1; - pl_yylval.opval->op_flags |= OPf_SPECIAL; + if (SvTYPE(sv) == SVt_PVAV) + pl_yylval.opval = newUNOP(OP_RV2AV, OPf_PARENS, + pl_yylval.opval); + else { + pl_yylval.opval->op_private = OPpCONST_FOLDED; + pl_yylval.opval->op_folded = 1; + pl_yylval.opval->op_flags |= OPf_SPECIAL; + } TOKEN(WORD); } -- 1.8.3.1