From: Andy Lester Date: Tue, 19 Apr 2005 11:38:44 +0000 (-0500) Subject: pad_compname_type(), takes care of a clunky macro X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b21dc0313d6db8e825aa8b1c17bfe601ada00827;p=p5sagit%2Fp5-mst-13.2.git pad_compname_type(), takes care of a clunky macro Message-Id: <20050419163844.GA19747@petdance.com> p4raw-id: //depot/perl@24256 --- diff --git a/embed.fnc b/embed.fnc index 13cf0ae..66fb8bf 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1367,6 +1367,7 @@ pd |void |do_dump_pad |I32 level|PerlIO *file \ pd |void |pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv pd |void |pad_push |PADLIST *padlist|int depth +p |HV* |pad_compname_type|PADOFFSET po #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) sd |PADOFFSET|pad_findlex |const char *name|const CV* cv|U32 seq|int warn \ diff --git a/embed.h b/embed.h index 57deaf0..3072781 100644 --- a/embed.h +++ b/embed.h @@ -2093,6 +2093,9 @@ #ifdef PERL_CORE #define pad_push Perl_pad_push #endif +#ifdef PERL_CORE +#define pad_compname_type Perl_pad_compname_type +#endif #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE #define pad_findlex S_pad_findlex @@ -4693,6 +4696,9 @@ #ifdef PERL_CORE #define pad_push(a,b) Perl_pad_push(aTHX_ a,b) #endif +#ifdef PERL_CORE +#define pad_compname_type(a) Perl_pad_compname_type(aTHX_ a) +#endif #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE #define pad_findlex(a,b,c,d,e,f,g) S_pad_findlex(aTHX_ a,b,c,d,e,f,g) diff --git a/pad.c b/pad.c index 9a63e3e..14649fc 100644 --- a/pad.c +++ b/pad.c @@ -1599,3 +1599,14 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) AvFILLp(padlist) = depth; } } + + +HV * +Perl_pad_compname_type(pTHX_ const PADOFFSET po) +{ + SV** const av = av_fetch(PL_comppad_name, po, FALSE); + if ( SvFLAGS(*av) & SVpad_TYPED ) { + return SvSTASH(*av); + } + return Nullhv; +} diff --git a/pad.h b/pad.h index 20ab331..b331cea 100644 --- a/pad.h +++ b/pad.h @@ -216,10 +216,7 @@ ling pad (lvalue) to C. Note that C is hijacked for this purpos #define PAD_COMPNAME_FLAGS(po) SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE)) #define PAD_COMPNAME_PV(po) SvPV_nolen(*av_fetch(PL_comppad_name, (po), FALSE)) -/* XXX DAPM yuk - using av_fetch twice. Is there a better way? */ -#define PAD_COMPNAME_TYPE(po) \ - ((SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE)) & SVpad_TYPED) \ - ? (SvSTASH(*av_fetch(PL_comppad_name, (po), FALSE))) : Nullhv) +#define PAD_COMPNAME_TYPE(po) pad_compname_type(po) #define PAD_COMPNAME_OURSTASH(po) \ (GvSTASH(*av_fetch(PL_comppad_name, (po), FALSE))) diff --git a/proto.h b/proto.h index 627b25e..0866d7d 100644 --- a/proto.h +++ b/proto.h @@ -1310,6 +1310,7 @@ PERL_CALLCONV void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padl PERL_CALLCONV void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv); PERL_CALLCONV void Perl_pad_push(pTHX_ PADLIST *padlist, int depth); +PERL_CALLCONV HV* Perl_pad_compname_type(pTHX_ PADOFFSET po); #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags);