From 13c59d41da4d2fed8800d99aa2823bcd0b64b38d Mon Sep 17 00:00:00 2001 From: Matthew Horsfall Date: Sat, 17 Jan 2015 11:50:31 -0500 Subject: [PATCH] Revert "refactor gv_add_by_type" This reverts commit 819b139db33e2022424694e381422766903d4f65. This could be repapplied for 5.23.1, with modifications or additional patches to solve the breakage discussed in RT 123580. --- embed.fnc | 2 +- embed.h | 2 +- gv.c | 131 +++++++++++++++++++++--------------------------------- gv.h | 31 +++++-------- perl.h | 13 ------ pod/perldelta.pod | 13 ------ pp_hot.c | 6 ++- proto.h | 6 +-- scope.c | 10 ++--- 9 files changed, 72 insertions(+), 142 deletions(-) diff --git a/embed.fnc b/embed.fnc index bf3b35e..faccf49 100644 --- a/embed.fnc +++ b/embed.fnc @@ -482,7 +482,7 @@ p |char* |getenv_len |NN const char *env_elem|NN unsigned long *len pox |void |get_db_sub |NULLOK SV **svp|NN CV *cv Ap |void |gp_free |NULLOK GV* gv Ap |GP* |gp_ref |NULLOK GP* gp -Xp |SV* |gv_add_by_type_p|NN GV *gv|gv_add_type type +Ap |GV* |gv_add_by_type |NULLOK GV *gv|svtype type Apmb |GV* |gv_AVadd |NULLOK GV *gv Apmb |GV* |gv_HVadd |NULLOK GV *gv Apmb |GV* |gv_IOadd |NULLOK GV* gv diff --git a/embed.h b/embed.h index 2342c98..47e45c2 100644 --- a/embed.h +++ b/embed.h @@ -187,6 +187,7 @@ #define grok_number_flags(a,b,c,d) Perl_grok_number_flags(aTHX_ a,b,c,d) #define grok_numeric_radix(a,b) Perl_grok_numeric_radix(aTHX_ a,b) #define grok_oct(a,b,c,d) Perl_grok_oct(aTHX_ a,b,c,d) +#define gv_add_by_type(a,b) Perl_gv_add_by_type(aTHX_ a,b) #define gv_autoload_pv(a,b,c) Perl_gv_autoload_pv(aTHX_ a,b,c) #define gv_autoload_pvn(a,b,c,d) Perl_gv_autoload_pvn(aTHX_ a,b,c,d) #define gv_autoload_sv(a,b,c) Perl_gv_autoload_sv(aTHX_ a,b,c) @@ -1175,7 +1176,6 @@ #define get_hash_seed(a) Perl_get_hash_seed(aTHX_ a) #define get_no_modify() Perl_get_no_modify(aTHX) #define get_opargs() Perl_get_opargs(aTHX) -#define gv_add_by_type_p(a,b) Perl_gv_add_by_type_p(aTHX_ a,b) #define gv_override(a,b) Perl_gv_override(aTHX_ a,b) #define gv_setref(a,b) Perl_gv_setref(aTHX_ a,b) #define gv_try_downgrade(a) Perl_gv_try_downgrade(aTHX_ a) diff --git a/gv.c b/gv.c index 5a05afa..6801816 100644 --- a/gv.c +++ b/gv.c @@ -41,56 +41,53 @@ Perl stores its global variables. static const char S_autoload[] = "AUTOLOAD"; static const STRLEN S_autolen = sizeof(S_autoload)-1; -SV * -Perl_gv_add_by_type_p(pTHX_ GV *gv, gv_add_type type) +GV * +Perl_gv_add_by_type(pTHX_ GV *gv, svtype type) { SV **where; - SV * sv; - PERL_ARGS_ASSERT_GV_ADD_BY_TYPE_P; - if ( SvTYPE((const SV *)gv) != SVt_PVGV + if ( + !gv + || ( + SvTYPE((const SV *)gv) != SVt_PVGV && SvTYPE((const SV *)gv) != SVt_PVLV + ) ) { const char *what; - if (type == GPe_IO) { + if (type == SVt_PVIO) { /* * if it walks like a dirhandle, then let's assume that * this is a dirhandle. */ what = OP_IS_DIRHOP(PL_op->op_type) ? "dirhandle" : "filehandle"; - } else if (type == GPe_HV) { + } else if (type == SVt_PVHV) { what = "hash"; } else { - what = type == GPe_AV ? "array" : "scalar"; + what = type == SVt_PVAV ? "array" : "scalar"; } /* diag_listed_as: Bad symbol for filehandle */ Perl_croak(aTHX_ "Bad symbol for %s", what); } - where = (SV **)((Size_t)GvGP(gv)+ (Size_t)type); - - sv = *where; - if (!sv) { -/* this is table of GP members to their SV types, SVt_LAST triggers a panic */ - static const U8 addtype_to_svtype -#if PTRSIZE == 8 - /*gp_sv , gp_io , gp_cv , cvgn/cnt, gp_hv , gp_av */ - [6] = {SVt_NULL, SVt_PVIO, SVt_LAST, SVt_LAST, SVt_PVHV, SVt_PVAV}; -#elif PTRSIZE == 4 - /*gp_sv , gp_io , gp_cv , gp_cvgen, gp_rfcnt, gp_hv , gp_av */ - [7] = {SVt_NULL, SVt_PVIO, SVt_LAST, SVt_LAST, SVt_LAST, SVt_PVHV, SVt_PVAV}; -#else -# error unknown pointer size -#endif - svtype svtypevar = (svtype)addtype_to_svtype[PTRPTR2IDX(type)]; + if (type == SVt_PVHV) { + where = (SV **)&GvHV(gv); + } else if (type == SVt_PVAV) { + where = (SV **)&GvAV(gv); + } else if (type == SVt_PVIO) { + where = (SV **)&GvIOp(gv); + } else { + where = &GvSV(gv); + } - assert(PTRPTR2IDX(type) < sizeof(addtype_to_svtype)); - sv = *where = newSV_type(svtypevar); - if (type == GPe_AV && memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA")) - sv_magic(sv, (SV *)gv, PERL_MAGIC_isa, NULL, 0); + if (!*where) + { + *where = newSV_type(type); + if (type == SVt_PVAV && GvNAMELEN(gv) == 3 + && strnEQ(GvNAME(gv), "ISA", 3)) + sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0); } - return sv; + return gv; } GV * @@ -462,60 +459,32 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag STATIC void S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type) { - Size_t addtype; -#define SGVINIT_SKIP 0xFF + PERL_ARGS_ASSERT_GV_INIT_SVTYPE; + + switch (sv_type) { + case SVt_PVIO: + (void)GvIOn(gv); + break; + case SVt_PVAV: + (void)GvAVn(gv); + break; + case SVt_PVHV: + (void)GvHVn(gv); + break; #ifdef PERL_DONT_CREATE_GVSV -# define SGVINIT_SV GPe_SV -#else -# define SGVINIT_SV SGVINIT_SKIP + case SVt_NULL: + case SVt_PVCV: + case SVt_PVFM: + case SVt_PVGV: + break; + default: + if(GvSVn(gv)) { + /* Work round what appears to be a bug in Sun C++ 5.8 2005/10/13 + If we just cast GvSVn(gv) to void, it ignores evaluating it for + its side effect */ + } #endif - static const U8 svtype2add [] = { - /*SVt_NULL, 0 */ - SGVINIT_SKIP, - /*SVt_IV, 1 */ - SGVINIT_SV, - /*SVt_NV, 2 */ - SGVINIT_SV, - /*SVt_PV, 3 */ - SGVINIT_SV, - /*SVt_INVLIST, 4 implemented as a PV */ - SGVINIT_SV, - /*SVt_PVIV, 5 */ - SGVINIT_SV, - /*SVt_PVNV, 6 */ - SGVINIT_SV, - /*SVt_PVMG, 7 */ - SGVINIT_SV, - /*SVt_REGEXP, 8 */ - SGVINIT_SV, - /*SVt_PVGV, 9 */ - SGVINIT_SKIP, - /*SVt_PVLV, 10 */ - SGVINIT_SV, - /*SVt_PVAV, 11 */ - GPe_AV, - /*SVt_PVHV, 12 */ - GPe_HV, - /*SVt_PVCV, 13 */ - SGVINIT_SKIP, - /*SVt_PVFM, 14 */ - SGVINIT_SKIP, - /*SVt_PVIO, 15 */ - GPe_IO, - /*SVt_LAST keep last in enum. used to size arrays */ - /* invalid, this is slot 0x10, dont define it so this array is - a nice 16 bytes long */ - }; - PERL_ARGS_ASSERT_GV_INIT_SVTYPE; - addtype = svtype2add[sv_type]; - if(addtype != SGVINIT_SKIP) { - SV ** where = (SV **)((Size_t)GvGP(gv)+ addtype); - if (!*where) - gv_add_by_type_p(gv, (gv_add_type)addtype); - } - return; -#undef SGVINIT_SV -#undef SGVINIT_SKIP + } } static void core_xsub(pTHX_ CV* cv); diff --git a/gv.h b/gv.h index 7792017..1d59154 100644 --- a/gv.h +++ b/gv.h @@ -101,9 +101,9 @@ Return the CV from the GV. #define GvSV(gv) (GvGP(gv)->gp_sv) #ifdef PERL_DONT_CREATE_GVSV -#define GvSVn(gv) (GvGP(gv)->gp_sv ? \ - GvGP(gv)->gp_sv : \ - Perl_gv_add_by_type_p(aTHX_ (gv), GPe_SV)) +#define GvSVn(gv) (*(GvGP(gv)->gp_sv ? \ + &(GvGP(gv)->gp_sv) : \ + &(GvGP(gv_SVadd(gv))->gp_sv))) #else #define GvSVn(gv) GvSV(gv) #endif @@ -121,22 +121,19 @@ Return the CV from the GV. : NULL \ ) #define GvIOp(gv) (GvGP(gv)->gp_io) -#define GvIOn(gv) \ - (GvIO(gv) \ - ? GvIOp(gv) \ - : (struct io *)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_IO)) +#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv))) #define GvFORM(gv) (GvGP(gv)->gp_form) #define GvAV(gv) (GvGP(gv)->gp_av) #define GvAVn(gv) (GvGP(gv)->gp_av ? \ GvGP(gv)->gp_av : \ - (AV*)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_AV)) + GvGP(gv_AVadd(gv))->gp_av) #define GvHV(gv) ((GvGP(gv))->gp_hv) #define GvHVn(gv) (GvGP(gv)->gp_hv ? \ GvGP(gv)->gp_hv : \ - (HV*)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_HV)) + GvGP(gv_HVadd(gv))->gp_hv) #define GvCV(gv) (0+GvGP(gv)->gp_cv) #define GvCV_set(gv,cv) (GvGP(gv)->gp_cv = (cv)) @@ -286,18 +283,10 @@ Return the CV from the GV. : mro_method_changed_in(GvSTASH(gv)) \ ) -/* used by Perl_gv_add_by_type_p for option checking, low bits are free here*/ -typedef enum { - GPe_SV = STRUCT_OFFSET(GP, gp_sv), - GPe_IO = STRUCT_OFFSET(GP, gp_io), - GPe_HV = STRUCT_OFFSET(GP, gp_hv), - GPe_AV = STRUCT_OFFSET(GP, gp_av), -} gv_add_type; - -#define gv_AVadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_AV), gv) -#define gv_HVadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_HV), gv) -#define gv_IOadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_IO), gv) -#define gv_SVadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_SV), gv) +#define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV) +#define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV) +#define gv_IOadd(gv) gv_add_by_type((gv), SVt_PVIO) +#define gv_SVadd(gv) gv_add_by_type((gv), SVt_NULL) /* * Local variables: diff --git a/perl.h b/perl.h index 09a1de2..ebfca35 100644 --- a/perl.h +++ b/perl.h @@ -1754,19 +1754,6 @@ typedef UVTYPE UV; #define PTR2NV(p) NUM2PTR(NV,p) #define PTR2nat(p) (PTRV)(p) /* pointer to integer of PTRSIZE */ - -#if PTRSIZE == 8 -# define PTRSIZELOG2 3 -#elif PTRSIZE == 4 -# define PTRSIZELOG2 2 -# else -# error unknown pointer size -# endif - -/* idx = PTRPTR2IDX(offset) - -turn an offset into array of void *s into an index into the array */ -#define PTRPTR2IDX(offset) ((offset) >> PTRSIZELOG2) - /* According to strict ANSI C89 one cannot freely cast between * data pointers and function (code) pointers. There are at least * two ways around this. One (used below) is to do two casts, diff --git a/pod/perldelta.pod b/pod/perldelta.pod index fb6bdb9..3890ec3 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -406,19 +406,6 @@ Function either returns an SV * of type AV, which contains the set of weakreferences which reference the passed in SV, or a simple RV * which is the only weakref to this item. -=item * - -C which was added to public API in 5.11.0 but undocumented and -shows no CPAN usage has been removed from public API. Please use public API -C C C and C for adding elements to a GV. - -=item * - -C C C and C have been made rvalues, previously they -were lvalues. If you are assigning a SV to C C C and -C you are leaking memory. If you want an lvalue, use C C -C and C. - =back =head1 Selected Bug Fixes diff --git a/pp_hot.c b/pp_hot.c index 5557356..4072ab1 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -891,6 +891,8 @@ PP(pp_rv2av) { dSP; dTOPss; const I32 gimme = GIMME_V; + static const char an_array[] = "an ARRAY"; + static const char a_hash[] = "a HASH"; const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV || PL_op->op_type == OP_LVAVREF; const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV; @@ -903,7 +905,7 @@ PP(pp_rv2av) sv = SvRV(sv); if (UNLIKELY(SvTYPE(sv) != type)) /* diag_listed_as: Not an ARRAY reference */ - DIE(aTHX_ "Not %s reference", is_pp_rv2av ? "an ARRAY" : "a HASH"); + DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash); else if (UNLIKELY(PL_op->op_flags & OPf_MOD && PL_op->op_private & OPpLVAL_INTRO)) Perl_croak(aTHX_ "%s", PL_no_localize_ref); @@ -912,7 +914,7 @@ PP(pp_rv2av) GV *gv; if (!isGV_with_GP(sv)) { - gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? "an ARRAY" : "a HASH", + gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash, type, &sp); if (!gv) RETURN; diff --git a/proto.h b/proto.h index 0728c45..a0c4a40 100644 --- a/proto.h +++ b/proto.h @@ -1392,11 +1392,7 @@ PERL_CALLCONV UV Perl_grok_oct(pTHX_ const char* start, STRLEN* len_p, I32* flag /* PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV *gv); */ /* PERL_CALLCONV GV* Perl_gv_HVadd(pTHX_ GV *gv); */ /* PERL_CALLCONV GV* Perl_gv_IOadd(pTHX_ GV* gv); */ -PERL_CALLCONV SV* Perl_gv_add_by_type_p(pTHX_ GV *gv, gv_add_type type) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_GV_ADD_BY_TYPE_P \ - assert(gv) - +PERL_CALLCONV GV* Perl_gv_add_by_type(pTHX_ GV *gv, svtype type); /* PERL_CALLCONV GV* gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_2); */ diff --git a/scope.c b/scope.c index e1d26fb..89b4e6e 100644 --- a/scope.c +++ b/scope.c @@ -216,17 +216,17 @@ Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type) SV * Perl_save_scalar(pTHX_ GV *gv) { - SV * const sv = GvSVn(gv); + SV ** const sptr = &GvSVn(gv); PERL_ARGS_ASSERT_SAVE_SCALAR; - if (UNLIKELY(SvGMAGICAL(sv))) { + if (UNLIKELY(SvGMAGICAL(*sptr))) { PL_localizing = 1; - (void)mg_get(sv); + (void)mg_get(*sptr); PL_localizing = 0; } - save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(sv), SAVEt_SV); - return save_scalar_at(&GvSV(gv), SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */ + save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(*sptr), SAVEt_SV); + return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */ } /* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to -- 1.8.3.1