Front page | perl.perl5.porters |
Postings from September 2010
Re: [perl #77548] [PATCH] Re: Runtime hinthash from XS
Thread Previous
|
Thread Next
From:
Florian Ragwitz
Date:
September 2, 2010 07:16
Subject:
Re: [perl #77548] [PATCH] Re: Runtime hinthash from XS
Message ID:
87eidckz9x.fsf@tardis.home.perldition.org
I agree, a proper API would be quite nice.
> I would also like to suggest that all references to struct refcounted_he
> be removed from the public API and the public sections of the headers.
> (This would include removing B::RHE entirely.) AFAICS it should be
> treated as an internal implementation matter, and any APIs dealing with
> the runtime hinthash should pass in COPs instead.
I agree.
>>From 0915bca68e66e3d6085302e3d67864ffaba8da69 Mon Sep 17 00:00:00 2001
> From: Ben Morrow <ben@morrow.me.uk>
> Date: Tue, 31 Aug 2010 07:10:20 +0100
> Subject: [PATCH 1/3] API functions for accessing the runtime hinthash.
>
> Add hinthash_fetch(sv|pv[ns]) as a replacement for refcounted_he_fetch,
> which is not API (and should not be). Also add caller_cx, as the correct
> XS equivalent to caller(). Lots of modules seem to have copies of this,
> so a proper API function will be more maintainable in future.
> ---
> embed.fnc | 11 +++++++++
> hv.c | 47 ++++++++++++++++++++++++++++++++++++++++++
> hv.h | 9 ++++++++
> pp_ctl.c | 68 +++++++++++++++++++++++++++++++++++++++++++++---------------
> 4 files changed, 118 insertions(+), 17 deletions(-)
>
> diff --git a/embed.fnc b/embed.fnc
> index a443e9a..65bbe0d 100644
> --- a/embed.fnc
> +++ b/embed.fnc
> @@ -220,6 +220,8 @@ p |void |boot_core_UNIVERSAL
> : Used in perl.c
> p |void |boot_core_PerlIO
> Ap |void |call_list |I32 oldscope|NN AV *paramList
> +Apd |const PERL_CONTEXT * |caller_cx|I32 level \
> + |NULLOK const PERL_CONTEXT **dbcxp
> : Used in serveral source files
> pR |bool |cando |Mode_t mode|bool effective|NN const Stat_t* statbufp
> ApR |U32 |cast_ulong |NV f
> @@ -446,6 +448,15 @@ XMpd |void |gv_try_downgrade|NN GV* gv
> Apd |HV* |gv_stashpv |NN const char* name|I32 flags
> Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags
> Apd |HV* |gv_stashsv |NN SV* sv|I32 flags
> +Apd |HV* |hinthash_2hv |NN const COP *cop
> +: used for the macros below, not API itself
> +EXopM |SV* |hinthash_fetchx|NN const COP *cop|NULLOK const SV *keysv \
> + |NULLOK const char *key|STRLEN klen \
> + |int flags|U32 hash
> +Amd |SV* |hinthash_fetchsv|NN const COP *cop|NN SV *keysv|U32 hash
> +Amd |SV* |hinthash_fetchpvn|NN const COP *cop|NN const char *key \
> + |STRLEN klen |int flags|U32 hash
> +Amd |SV* |hinthash_fetchpvs|NN const COP *cop|NN const char *const key
I'm not fully happy with the naming.
All other hints-related code in the core I've seen so far refers to the
hints hash as "hints", not "hinthash". Also a function called
hinthash_2hv not actually taking a hinthash but returning the hinthash
as an HV seems slightly off.
cop_fetch_hint_hv/cop_fetch_hint_{x,sv,pvn,pvs}, maybe?
store_cop_label is also under discussion to be API-fied. Using
cop_store_label there would give us some consistency, both with the
functions operating on COPs, as well as with many other similarly named
api functions like av_{fetch,store,len}, hv_{exists,store,fetch}, etc.
> Apd |void |hv_clear |NULLOK HV *hv
> : used in SAVEHINTS() and op.c
> poM |HV * |hv_copy_hints_hv|NULLOK HV *const ohv
> diff --git a/hv.c b/hv.c
> index d29c49c..a847234 100644
> --- a/hv.c
> +++ b/hv.c
> @@ -2623,6 +2623,53 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
> }
>
> /*
> +=for apidoc hinthash_2hv
> +
> +Generates and returns a C<HV *> from the hinthash in the provided
> +C<COP>. Returns C<NULL> if there isn't one there.
> +
> +=cut
> +*/
> +HV *
> +Perl_hinthash_2hv(pTHX_ const COP *cop)
> +{
> + PERL_ARGS_ASSERT_HINTHASH_2HV;
> +
> + if (!cop->cop_hints_hash)
> + return NULL;
> +
> + return Perl_refcounted_he_chain_2hv(aTHX_ cop->cop_hints_hash);
> +}
> +
> +/*
> +=for apidoc hinthash_fetchsv
> +
> +Fetches an entry from the hinthash in the provided C<COP>. Returns NULL
> +if the entry isn't there.
> +
> +=for apidoc hinthash_fetchpvn
> +
> +See L</hinthash_fetchsv>. If C<flags> includes C<HVhek_UTF8>, C<key> is
> +in UTF-8.
> +
> +=for apidoc hinthash_fetchpvs
> +
> +See L</hinthash_fetchpvn>. This is a macro that takes a constant string
> +for its argument.
> +
> +=cut
> +*/
> +SV *
> +Perl_hinthash_fetchx(pTHX_ const COP *cop, const SV *keysv, const char *key,
> + STRLEN klen, int flags, U32 hash)
> +{
> + PERL_ARGS_ASSERT_HINTHASH_FETCHX;
> +
> + return Perl_refcounted_he_fetch(aTHX_ cop->cop_hints_hash, keysv,
> + key, klen, flags, hash);
> +}
> +
> +/*
> =for apidoc refcounted_he_chain_2hv
>
> Generates and returns a C<HV *> by walking up the tree starting at the passed
> diff --git a/hv.h b/hv.h
> index 468c072..3e35406 100644
> --- a/hv.h
> +++ b/hv.h
> @@ -450,6 +450,15 @@ C<SV*>.
> between threads (because it hangs from OPs, which are shared), hence the
> alternate definition and mutex. */
>
> +#define hinthash_fetchsv(cop, keysv, hash) \
> + Perl_hinthash_fetchx(aTHX_ (cop), (keysv), NULL, 0, 0, (hash))
> +
> +#define hinthash_fetchpvn(cop, key, klen, flags, hash) \
> + Perl_hinthash_fetchx(aTHX_ (cop), NULL, (key), (klen), (flags), (hash))
> +
> +#define hinthash_fetchpvs(cop, key) \
> + Perl_hinthash_fetchx(aTHX_ (cop), NULL, STR_WITH_LEN(key), 0, 0)
> +
> struct refcounted_he;
>
> #ifdef PERL_CORE
> diff --git a/pp_ctl.c b/pp_ctl.c
> index 1e90894..e25fa96 100644
> --- a/pp_ctl.c
> +++ b/pp_ctl.c
> @@ -1670,20 +1670,32 @@ PP(pp_xor)
> RETSETNO;
> }
>
> -PP(pp_caller)
> +/*
> +=for apidoc caller_cx
> +
> +The XSUB-writer's equivalent of L<caller()|perlfunc/caller>. The
> +returned C<PERL_CONTEXT> structure can be interrogated to find all the
> +information returned to Perl by C<caller>. Note that XSUBs don't get a
> +stack frame, so C<caller_cx(0, NULL)> will return information for the
> +immediately-surrounding Perl code.
> +
> +This function skips over the automatic calls to C<&DB::sub> made on the
> +behalf of the debugger. If the stack frame requested was a sub called by
> +C<DB::sub>, the return value will be the frame for the call to
> +C<DB::sub>, since that has the correct line number/etc. for the call
> +site. If I<dbcxp> is non-C<NULL>, it will be set to a pointer to the
> +frame for the sub call itself.
> +
> +=cut
> +*/
> +
> +const PERL_CONTEXT *
> +Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
Does this really belong into pp_ctl.c?
Also, have you had a look at Devel::Caller's upcontext function? It was
originally based on the code you factored out into caller_cx, but is now
rather different. I'm curious if the new caller_cx function provides
everything that'd be needed to have Devel::Caller run on it.
There's also many more caller() implementation in xs, but they all seem
to be cargo-culted from Devel::Caller, so I guess it'd be nice if at
least that one was possible to be ported to caller_cx.
> {
> - dVAR;
> - dSP;
> register I32 cxix = dopoptosub(cxstack_ix);
> register const PERL_CONTEXT *cx;
> register const PERL_CONTEXT *ccstack = cxstack;
> const PERL_SI *top_si = PL_curstackinfo;
> - I32 gimme;
> - const char *stashname;
> - I32 count = 0;
> -
> - if (MAXARG)
> - count = POPi;
>
> for (;;) {
> /* we may be in a higher stacklevel, so dig down deeper */
> @@ -1692,13 +1704,8 @@ PP(pp_caller)
> ccstack = top_si->si_cxstack;
> cxix = dopoptosub_at(ccstack, top_si->si_cxix);
> }
> - if (cxix < 0) {
> - if (GIMME != G_ARRAY) {
> - EXTEND(SP, 1);
> - RETPUSHUNDEF;
> - }
> - RETURN;
> - }
> + if (cxix < 0)
> + return NULL;
> /* caller() should not report the automatic calls to &DB::sub */
> if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
> ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
> @@ -1709,6 +1716,8 @@ PP(pp_caller)
> }
>
> cx = &ccstack[cxix];
> + if (dbcxp) *dbcxp = cx;
> +
> if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
> const I32 dbcxix = dopoptosub_at(ccstack, cxix - 1);
> /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
> @@ -1718,6 +1727,31 @@ PP(pp_caller)
> cx = &ccstack[dbcxix];
> }
>
> + return cx;
> +}
> +
> +PP(pp_caller)
> +{
> + dVAR;
> + dSP;
> + register const PERL_CONTEXT *cx;
> + const PERL_CONTEXT *dbcx;
> + I32 gimme;
> + const char *stashname;
> + I32 count = 0;
> +
> + if (MAXARG)
> + count = POPi;
> +
> + cx = caller_cx(count, &dbcx);
> + if (!cx) {
> + if (GIMME != G_ARRAY) {
> + EXTEND(SP, 1);
> + RETPUSHUNDEF;
> + }
> + RETURN;
> + }
> +
> stashname = CopSTASHPV(cx->blk_oldcop);
> if (GIMME != G_ARRAY) {
> EXTEND(SP, 1);
> @@ -1742,7 +1776,7 @@ PP(pp_caller)
> if (!MAXARG)
> RETURN;
> if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
> - GV * const cvgv = CvGV(ccstack[cxix].blk_sub.cv);
> + GV * const cvgv = CvGV(dbcx->blk_sub.cv);
> /* So is ccstack[dbcxix]. */
> if (isGV(cvgv)) {
> SV * const sv = newSV(0);
> --
> 1.7.1.1
Thread Previous
|
Thread Next