refactor gv_add_by_type
authorDaniel Dragan <bulk88@hotmail.com>
Sun, 4 Jan 2015 22:49:09 +0000 (17:49 -0500)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 6 Jan 2015 14:39:33 +0000 (06:39 -0800)
gv_add_by_type was added in commit d5713896ec in 5.11.0 . Improve
gv_add_by_type by making it return the newly created SV*, instead of the
the GV *, which the caller must deref both the GV head to get svu and
then deref a slice into the GP, even though it already derefed svu and GP
right before, to figure out whether to call gv_add_by_type in the first
place. The original version of this patch had gv_add_by_type returning a
SV ** to ensure lvalue-ness but it was discovered it wasn't needed and not
smart.

-rename gv_add_by_type since it was removed from public api and its proto
 changed
-remove null check since it is impossible to pass null through GvAVn(),
 and unlikely with gv_AVadd, null segvs reliably crash in the rare case of
 a problem
-instead of S_gv_init_svtype and gv_add_by_type using a tree of logic/
 conditional jumps in asm, use a lookup table, GPe (e=enum or entry)
 enums are identical to offsets into the GP struct, all of then fit under
 0xFF, if the CC and CPU arch wants, CC can load the const once into a
 register, then use the number for the 2nd deref, then use the number again
 as an arg to gv_add_by_type, the low (&~0xf) or high (<<2) 2 bits in a
 GPe can be used for something else in the future since GPe is pointer
 aligned
-SVt_LAST triggers "panic: sv_upgrade to unknown type", so use that value
 for entries of a GP which are not SV head *s and are invalid to pass as
 an arg
-remove the tree of logic in S_gv_init_svtype, replace with a table
-S_gv_init_svtype is now tail call friendly and very small
-change the GV**n to be rvalues only, assigning to GV**n is probably a
 memory leak
-fix 1 core GV**n as lvalue use
-GvSVn's unusual former definition is from commit 547f15c3f9 in 2005
 and DEFSV as lvalue is gone in core as of commit 414bf5ae08 from 2008
 since all the GV**n macros are now rvalues, this goes too
-PTRPTR2IDX and PTRSIZELOG2 could use better names
-in pp_rv2av dont declare strings like that VC linker won't dedup that, and
 other parts of core also have "an ARRAY", perl521.dll previously had 2
 "an ARRAY" and "a HASH" strings in it due to this

before VC 2003 32 perl521.dll .text 0xc8813 in machine code bytes after
.text 0xc8623

embed.fnc
embed.h
gv.c
gv.h
perl.h
pod/perldelta.pod
pp_hot.c
proto.h
scope.c

index a5b955a..f9aa593 100644 (file)
--- 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
-Ap     |GV*    |gv_add_by_type |NULLOK GV *gv|svtype type
+Xp     |SV*    |gv_add_by_type_p|NN GV *gv|gv_add_type 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 7895e61..ed50cec 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
 #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 6801816..5a05afa 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -41,53 +41,56 @@ Perl stores its global variables.
 static const char S_autoload[] = "AUTOLOAD";
 static const STRLEN S_autolen = sizeof(S_autoload)-1;
 
-GV *
-Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
+SV *
+Perl_gv_add_by_type_p(pTHX_ GV *gv, gv_add_type type)
 {
     SV **where;
+    SV * sv;
+    PERL_ARGS_ASSERT_GV_ADD_BY_TYPE_P;
 
-    if (
-        !gv
-     || (
-            SvTYPE((const SV *)gv) != SVt_PVGV
+    if ( SvTYPE((const SV *)gv) != SVt_PVGV
          && SvTYPE((const SV *)gv) != SVt_PVLV
-        )
     ) {
        const char *what;
-       if (type == SVt_PVIO) {
+       if (type == GPe_IO) {
            /*
             * 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 == SVt_PVHV) {
+       } else if (type == GPe_HV) {
            what = "hash";
        } else {
-           what = type == SVt_PVAV ? "array" : "scalar";
+           what = type == GPe_AV ? "array" : "scalar";
        }
        /* diag_listed_as: Bad symbol for filehandle */
        Perl_croak(aTHX_ "Bad symbol for %s", what);
     }
 
-    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);
-    }
+    where = (SV **)((Size_t)GvGP(gv)+ (Size_t)type);
 
-    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);
+    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)];
+
+       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);
     }
-    return gv;
+    return sv;
 }
 
 GV *
@@ -459,32 +462,60 @@ 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)
 {
-    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;
+    Size_t addtype;
+#define SGVINIT_SKIP 0xFF
 #ifdef PERL_DONT_CREATE_GVSV
-    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 */
-       }
+#  define SGVINIT_SV GPe_SV
+#else
+#  define SGVINIT_SV SGVINIT_SKIP
 #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 1d59154..7792017 100644 (file)
--- 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) : \
-                        &(GvGP(gv_SVadd(gv))->gp_sv)))
+#define GvSVn(gv)      (GvGP(gv)->gp_sv ? \
+                        GvGP(gv)->gp_sv : \
+                        Perl_gv_add_by_type_p(aTHX_ (gv), GPe_SV))
 #else
 #define GvSVn(gv)      GvSV(gv)
 #endif
@@ -121,19 +121,22 @@ Return the CV from the GV.
    : NULL                                         \
  )
 #define GvIOp(gv)      (GvGP(gv)->gp_io)
-#define GvIOn(gv)      (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
+#define GvIOn(gv) \
+       (GvIO(gv) \
+               ? GvIOp(gv) \
+               : (struct io *)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_IO))
 
 #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 : \
-                        GvGP(gv_AVadd(gv))->gp_av)
+                        (AV*)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_AV))
 #define GvHV(gv)       ((GvGP(gv))->gp_hv)
 
 #define GvHVn(gv)      (GvGP(gv)->gp_hv ? \
                         GvGP(gv)->gp_hv : \
-                        GvGP(gv_HVadd(gv))->gp_hv)
+                        (HV*)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_HV))
 
 #define GvCV(gv)       (0+GvGP(gv)->gp_cv)
 #define GvCV_set(gv,cv)        (GvGP(gv)->gp_cv = (cv))
@@ -283,10 +286,18 @@ Return the CV from the GV.
            : mro_method_changed_in(GvSTASH(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)
+/* 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)
 
 /*
  * Local variables:
diff --git a/perl.h b/perl.h
index 2deb1d4..2d3e1f7 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1754,6 +1754,19 @@ 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,
index 7f3619e..7ee0ec4 100644 (file)
@@ -388,6 +388,19 @@ is the only weakref to this item.
 
 =item *
 
+C<gv_add_by_type> 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<GvSVn> C<GvIOn> C<GvAVn> and C<GvHVn> for adding elements to a GV.
+
+=item *
+
+C<GvSVn> C<GvIOn> C<GvAVn> and C<GvHVn> have been made rvalues, previously they
+were lvalues. If you are assigning a SV to C<GvSVn> C<GvIOn> C<GvAVn> and
+C<GvHVn> you are leaking memory. If you want an lvalue, use C<GvSV> C<GvIO>
+C<GvAV> and C<GvHV>.
+
+=item *
+
 XXX
 
 =back
index 4072ab1..5557356 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -891,8 +891,6 @@ 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;
@@ -905,7 +903,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);
@@ -914,7 +912,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 ccd768f..ce3c600 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1391,7 +1391,11 @@ 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 GV*      Perl_gv_add_by_type(pTHX_ GV *gv, svtype type);
+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*   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 89b4e6e..e1d26fb 100644 (file)
--- 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 sptr = &GvSVn(gv);
+    SV * const sv = GvSVn(gv);
 
     PERL_ARGS_ASSERT_SAVE_SCALAR;
 
-    if (UNLIKELY(SvGMAGICAL(*sptr))) {
+    if (UNLIKELY(SvGMAGICAL(sv))) {
         PL_localizing = 1;
-        (void)mg_get(*sptr);
+        (void)mg_get(sv);
         PL_localizing = 0;
     }
-    save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(*sptr), SAVEt_SV);
-    return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
+    save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(sv), SAVEt_SV);
+    return save_scalar_at(&GvSV(gv), SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 }
 
 /* Like save_sptr(), but also SvREFCNT_dec()s the new value.  Can be used to