In perl.git, the branch smueller/hash_vtable_make_hash has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0dc9ae7b6a3a95d14544f3299a85c99b2d1e167b?hp=ed7c59ab2947ee30e5ae342d194e9135e977927a>
- Log ----------------------------------------------------------------- commit 0dc9ae7b6a3a95d14544f3299a85c99b2d1e167b Author: Steffen Mueller <[email protected]> Date: Wed Feb 1 19:59:06 2017 +0100 Hash vtables: Fall through to runtime evaluation if vtbl not found If the vtable for a given constant string isn't found, we simply do the evaluation (again) at run-time. Until then, somebody may have added the right vtable to the registry. This means that compile/run-time behavior change that the previous commit introduced ("foo" vs. $foo as first argument to make_hash) is MOSTLY dealt with. The only remaining exception is that if somebody overwrites a vtable entry in the global registry. But that's so naughty that I think it's okay just to document not to do that. (You need to really know what you're doing if you'd be writing your own hash tables for perl anyway.) This does have one ancillary downside: We don't get compile time exceptions on invalid vtable names any more and downgrade them to runtime exceptions. That seems worth it, considering it fixes an ugly wart. M ext/Hash-Pluggable/Pluggable.xs commit 05f2cf41d62b8529cf2d9cd05665c71c7818235f Author: Steffen Mueller <[email protected]> Date: Wed Feb 1 19:56:08 2017 +0100 Hash vtables: Evaluate constant strings for vtbls at compile time With this change, "make_hash("some_vtable_name", ...)" will be resolved to a vtbl pointer (corresponding to 'some_vtable_name') at compile time. This speeds up make_hash by a factor of several (roughly 3x) in such cases. M ext/Hash-Pluggable/Pluggable.xs ----------------------------------------------------------------------- Summary of changes: ext/Hash-Pluggable/Pluggable.xs | 104 ++++++++++++++++++++++++++++++++-------- 1 file changed, 85 insertions(+), 19 deletions(-) diff --git a/ext/Hash-Pluggable/Pluggable.xs b/ext/Hash-Pluggable/Pluggable.xs index f21fe343db..649cba0001 100644 --- a/ext/Hash-Pluggable/Pluggable.xs +++ b/ext/Hash-Pluggable/Pluggable.xs @@ -37,10 +37,8 @@ * to avoid potential collisions. But this might prove too clunky * in practice? * - * At a future time, the implementation might be changed such that - * the vtable pointer is looked up at compile time at least for - * cases of constant strings used for vtable names in make_hash - * calls. + * The vtable pointer is looked up at compile time for cases of + * constant strings used for vtable names in make_hash calls. */ @@ -48,6 +46,9 @@ int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); /* Our anonhash-alike custom OP */ XOP pluggable_anonhash_op; +/* Our free-hook for our custom anonhash ops. */ +Perl_ophook_t next_opfreehook; + /* This is a custom OP that's VERY similar to pp_anonhash/OP_ANONHASH. @@ -65,19 +66,23 @@ pp_pluggable_anonhash(pTHX) SV *retval; HV_VTBL *vtbl = NULL; - /* TODO This logic should only be executed in the cases that the vtable - * couldn't be resolved statically. But that's not implemented yet. */ - MARK++; - hash_type_sv = *MARK; - vtable_registry = get_hv("Hash::Pluggable::VtableRegistry", GV_ADD); - he = hv_fetch_ent(vtable_registry, hash_type_sv, 0, 0); - if (he) { - vtbl = INT2PTR(HV_VTBL *, SvIV(HeVAL(he))); + if (PL_op->op_targ == 0) { + /* Resolve vtbl at run time. */ + MARK++; + hash_type_sv = *MARK; + vtable_registry = get_hv("Hash::Pluggable::VtableRegistry", GV_ADD); + he = hv_fetch_ent(vtable_registry, hash_type_sv, 0, 0); + if (he) { + vtbl = INT2PTR(HV_VTBL *, SvIV(HeVAL(he))); + } + else { + /* Couldn't look up vtable: Barf! */ + Perl_croak(aTHX_ "No hash vtable for vtable name '%s'", + SvPV_nolen_const(hash_type_sv)); + } } else { - /* Couldn't look up vtable: Barf! */ - Perl_croak(aTHX_ "No hash vtable for vtable name '%s'", - SvPV_nolen_const(hash_type_sv)); + vtbl = (HV_VTBL *)PL_op->op_targ; } hv = newHV_type(vtbl); @@ -106,15 +111,69 @@ pp_pluggable_anonhash(pTHX) RETURN; } +STATIC void +custom_anonhash_opfreehook(pTHX_ OP *o) +{ + if (next_opfreehook != NULL) + next_opfreehook(aTHX_ o); + + if (o->op_ppaddr == pp_pluggable_anonhash) + o->op_targ = 0; /* important or Perl will use it to access the pad */ +} + + +STATIC void +perform_compile_time_vtable_lookup(pTHX_ OP *anonhash_op) +{ + /* Try and see if we have a constant string for the type and if so, + * do a compile time vtable lookup and associated OP munging. */ + + OP *op; + + assert(OP_CLASS(anonhash_op) == OA_LISTOP); + + op = cLISTOPx(anonhash_op)->op_first; + assert(OP_TYPE_IS(op, OP_PUSHMARK)); + + op = OpSIBLING(op); + assert(op != NULL); + + if (OP_TYPE_IS_NN(op, OP_CONST)) { + HV_VTBL *vtbl = NULL; + HV *vtable_registry; + HE *he; + SV *op_sv; + + assert(OP_CLASS(op) == OA_SVOP); + op_sv = cSVOPx_sv(op); + + /* Okay, we DO have a constant hash vtable type identifier. + * Let's do the vtable lookup right now and then munge the OP + * tree to eschew this OP and modify the special custom + * OP traits such that we get the vtable pointer from its + * op_targ member. */ + vtable_registry = get_hv("Hash::Pluggable::VtableRegistry", GV_ADD); + he = hv_fetch_ent(vtable_registry, op_sv, 0, 0); + if (he != NULL) { + /* If the hash entry wasn't found, he being NULL, we'll fall + * through to run-time evaluation. */ + vtbl = INT2PTR(HV_VTBL *, SvIV(HeVAL(he))); + + /* First NULL out the const OP so it won't be executed. */ + op_null(op); + + /* Now set the op_targ to the vtbl pointer for the anonhash OP. */ + assert(vtbl != NULL); + anonhash_op->op_targ = (PADOFFSET)vtbl; + } + } +} /* We intend to parse constructs of the following sorts: * make_hash(LITERAL_STRING, LIST) * make_hash(EXPR, LIST) * - * The former can be evaluated at compile time and stuffed - * into the OP structure, but for now, we'll just implement - * it the same way as the (much) less efficient (EXPR, LIST) - * version. TODO + * The former version will be evaluated right now, at compile time. */ STATIC void parse_make_hash_keyword(pTHX_ OP **op_ptr) @@ -123,6 +182,7 @@ parse_make_hash_keyword(pTHX_ OP **op_ptr) OP *anonhash_op; OP *arguments_ops; + lex_read_space(0); c = lex_read_unichar(0); @@ -169,6 +229,8 @@ parse_make_hash_keyword(pTHX_ OP **op_ptr) anonhash_op->op_ppaddr = pp_pluggable_anonhash; + perform_compile_time_vtable_lookup(aTHX_ anonhash_op); + *op_ptr = anonhash_op; } @@ -207,6 +269,10 @@ BOOT: next_keyword_plugin = PL_keyword_plugin; PL_keyword_plugin = make_hash_keyword_plugin; + /* Setup our callback for cleaning up OPs during global cleanup */ + next_opfreehook = PL_opfreehook; + PL_opfreehook = custom_anonhash_opfreehook; + /* Setup our custom op that implements pluggable anonhash*/ XopENTRY_set(&pluggable_anonhash_op, xop_name, "pluggable_anonhash"); XopENTRY_set(&pluggable_anonhash_op, xop_desc, "A pluggable version of the regular anonhash OP"); -- Perl5 Master Repository
