From: Nicholas Clark Date: Sat, 14 Nov 2009 19:36:21 +0000 (+0000) Subject: Refactor common code paths from Perl_pad_add_name() into S_pad_add_name_sv(). X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3291825f3fd927adacdb9c44790978a741046199;p=p5sagit%2Fp5-mst-13.2.git Refactor common code paths from Perl_pad_add_name() into S_pad_add_name_sv(). The only user of the pad_add_FAKE flag was S_pad_findlex(), so move the relevant code there from Perl_pad_add_name(), and have S_pad_findlex() call S_pad_add_name_sv() directly. This eliminates the pad_add_FAKE flag completely. --- diff --git a/embed.fnc b/embed.fnc index 1a15d5a..1fca12f 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1964,6 +1964,8 @@ pR |HV* |pad_compname_type|const PADOFFSET po sd |PADOFFSET|pad_findlex |NN const char *name|NN const CV* cv|U32 seq|int warn \ |NULLOK SV** out_capture|NN SV** out_name_sv \ |NN int *out_flags +s |PADOFFSET|pad_add_name_sv|NN SV *namesv|const U32 flags \ + |NULLOK HV *typestash|NULLOK HV *ourstash # if defined(DEBUGGING) sd |void |cv_dump |NN const CV *cv|NN const char *title # endif diff --git a/embed.h b/embed.h index 3e9e702..f71e797 100644 --- a/embed.h +++ b/embed.h @@ -1734,6 +1734,7 @@ #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE #define pad_findlex S_pad_findlex +#define pad_add_name_sv S_pad_add_name_sv #endif # if defined(DEBUGGING) #ifdef PERL_CORE @@ -4111,6 +4112,7 @@ #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) +#define pad_add_name_sv(a,b,c,d) S_pad_add_name_sv(aTHX_ a,b,c,d) #endif # if defined(DEBUGGING) #ifdef PERL_CORE diff --git a/pad.c b/pad.c index d80679a..4280c9f 100644 --- a/pad.c +++ b/pad.c @@ -339,6 +339,35 @@ Perl_pad_undef(pTHX_ CV* cv) +static PADOFFSET +S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash, + HV *ourstash) +{ + dVAR; + const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); + + PERL_ARGS_ASSERT_PAD_ADD_NAME_SV; + + ASSERT_CURPAD_ACTIVE("pad_add_name"); + + if (typestash) { + assert(SvTYPE(namesv) == SVt_PVMG); + SvPAD_TYPED_on(namesv); + SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash)))); + } + if (ourstash) { + SvPAD_OUR_on(namesv); + SvOURSTASH_set(namesv, ourstash); + SvREFCNT_inc_simple_void_NN(ourstash); + } + else if (flags & pad_add_STATE) { + SvPAD_STATE_on(namesv); + } + + av_store(PL_comppad_name, offset, namesv); + return offset; +} + /* =for apidoc pad_add_name @@ -359,14 +388,12 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags, HV *typestash, HV *ourstash) { dVAR; - const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); + PADOFFSET offset; SV *namesv; PERL_ARGS_ASSERT_PAD_ADD_NAME; - ASSERT_CURPAD_ACTIVE("pad_add_name"); - - if (flags & ~(pad_add_STATE|pad_add_FAKE)) + if (flags & ~(pad_add_STATE)) Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf, (UV)flags); @@ -379,46 +406,26 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags, sv_setpv(namesv, name); - if (typestash) { - assert(SvTYPE(namesv) == SVt_PVMG); - SvPAD_TYPED_on(namesv); - SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash)))); - } - if (ourstash) { - SvPAD_OUR_on(namesv); - SvOURSTASH_set(namesv, ourstash); - SvREFCNT_inc_simple_void_NN(ourstash); - } - else if (flags & pad_add_STATE) { - SvPAD_STATE_on(namesv); - } - - av_store(PL_comppad_name, offset, namesv); - if (flags & pad_add_FAKE) { - SvFAKE_on(namesv); - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name)); - } - else { - /* not yet introduced */ - COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */ - COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */ - - if (!PL_min_intro_pending) - PL_min_intro_pending = offset; - PL_max_intro_pending = offset; - /* if it's not a simple scalar, replace with an AV or HV */ - /* XXX DAPM since slot has been allocated, replace - * av_store with PL_curpad[offset] ? */ - if (*name == '@') - av_store(PL_comppad, offset, MUTABLE_SV(newAV())); - else if (*name == '%') - av_store(PL_comppad, offset, MUTABLE_SV(newHV())); - SvPADMY_on(PL_curpad[offset]); - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n", - (long)offset, name, PTR2UV(PL_curpad[offset]))); - } + offset = pad_add_name_sv(namesv, flags, typestash, ourstash); + + /* not yet introduced */ + COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */ + COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */ + + if (!PL_min_intro_pending) + PL_min_intro_pending = offset; + PL_max_intro_pending = offset; + /* if it's not a simple scalar, replace with an AV or HV */ + /* XXX DAPM since slot has been allocated, replace + * av_store with PL_curpad[offset] ? */ + if (*name == '@') + av_store(PL_comppad, offset, MUTABLE_SV(newAV())); + else if (*name == '%') + av_store(PL_comppad, offset, MUTABLE_SV(newHV())); + SvPADMY_on(PL_curpad[offset]); + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n", + (long)offset, name, PTR2UV(PL_curpad[offset]))); return offset; } @@ -904,24 +911,30 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, return 0; /* this dummy (and invalid) value isnt used by the caller */ { - SV *new_namesv; + /* This relies on sv_setsv_flags() upgrading the destination to the same + type as the source, independant of the flags set, and on it being + "good" and only copying flag bits and pointers that it understands. + */ + SV *new_namesv = newSVsv(*out_name_sv); AV * const ocomppad_name = PL_comppad_name; PAD * const ocomppad = PL_comppad; PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]); PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]); PL_curpad = AvARRAY(PL_comppad); - new_offset = pad_add_name( - SvPVX_const(*out_name_sv), - SvCUR(*out_name_sv), - /* state variable ? */ - pad_add_FAKE | (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0), - SvPAD_TYPED(*out_name_sv) - ? SvSTASH(*out_name_sv) : NULL, - SvOURSTASH(*out_name_sv) - ); - - new_namesv = AvARRAY(PL_comppad_name)[new_offset]; + new_offset + = pad_add_name_sv(new_namesv, + (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0), + SvPAD_TYPED(*out_name_sv) + ? SvSTASH(*out_name_sv) : NULL, + SvOURSTASH(*out_name_sv) + ); + + SvFAKE_on(new_namesv); + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad addname: %ld \"%.*s\" FAKE\n", + (long)new_offset, + (int) SvCUR(new_namesv), SvPVX(new_namesv))); PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags); PARENT_PAD_INDEX_set(new_namesv, 0); diff --git a/pad.h b/pad.h index 074d52e..e6cee11 100644 --- a/pad.h +++ b/pad.h @@ -119,7 +119,6 @@ typedef enum { # define pad_add_OUR 0x01 /* our declaration. */ # define pad_add_STATE 0x02 /* state declaration. */ -# define pad_add_FAKE 0x04 #endif diff --git a/proto.h b/proto.h index 5d326b5..243495b 100644 --- a/proto.h +++ b/proto.h @@ -6162,6 +6162,11 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, in #define PERL_ARGS_ASSERT_PAD_FINDLEX \ assert(name); assert(cv); assert(out_name_sv); assert(out_flags) +STATIC PADOFFSET S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash, HV *ourstash) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_PAD_ADD_NAME_SV \ + assert(namesv) + # if defined(DEBUGGING) STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title) __attribute__nonnull__(pTHX_1)