[PATCH] refactor gv_add_by_type #14378
Comments
From @bulk88Created by @bulk88See attached patch. The original patch message was before VC 2003 32 -01 .text 0xc8813 .rdata 0x482fa in bytes after but the theoretical .rdata of the 2 arrays I added was 0x18 bytes, but This will cause some minor breakage with DEFSV #ifdef PERL_CORE assigning to GvSVn will leak. There doesn't seem to be anything on CPAN that will break as of Gv\w\wn http://grep.cpan.me/?q=-file%3Appport\.h%20Gv\w\wn\%28&page=1 Perl Info |
From @bulk880001-refactor-gv_add_by_type.patchFrom 6c852af434f736f238be38edb67ac84458db3363 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Tue, 30 Dec 2014 09:15:30 -0500
Subject: [PATCH] refactor gv_add_by_type
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 | 2 +-
embed.h | 2 +-
gv.c | 131 +++++++++++++++++++++++++++++++++--------------------
gv.h | 28 +++++++----
perl.h | 13 +++++
pod/perldelta.pod | 13 +++++
pp_hot.c | 6 +--
proto.h | 6 ++-
scope.c | 10 ++--
9 files changed, 139 insertions(+), 72 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 39eefbf..e21ee27 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
-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 c10c9b2..e900581 100644
--- a/embed.h
+++ b/embed.h
@@ -186,7 +186,6 @@
#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)
@@ -1177,6 +1176,7 @@
#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..8880aee 100644
--- 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 = 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, 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..c0cde6e 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) : \
- &(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,19 @@ 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 *)gv_add_by_type_p((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*)gv_add_by_type_p((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*)gv_add_by_type_p((gv), GPe_HV))
#define GvCV(gv) (0+GvGP(gv)->gp_cv)
#define GvCV_set(gv,cv) (GvGP(gv)->gp_cv = (cv))
@@ -283,10 +283,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 a42df75..55b8011 100644
--- 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,
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 4a9ac5a..2da0101 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -341,6 +341,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
diff --git a/pp_hot.c b/pp_hot.c
index 3ee4818..1ef999c 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -890,8 +890,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;
@@ -904,7 +902,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);
@@ -913,7 +911,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 4718faa..12093b1 100644
--- 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
--- 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
--
1.7.9.msysgit.0
|
From @bulk88[before strings.PNG](https://rt-archive.perl.org/perl5/Ticket/Attachment/1324508/706227/before strings.PNG) |
From @bulk88[after strings.PNG](https://rt-archive.perl.org/perl5/Ticket/Attachment/1324508/706228/after strings.PNG) |
From @cpansproutOn Tue Dec 30 06:33:30 2014, bulk88 wrote:
I don’t feel comfortable about patches that make the code harder to $ clang -v If I look at the sizes of the object files that changed size, I see Before: -rw-r--r-- 1 sprout staff 40608 Jan 3 16:27 doio.o After: -rw-r--r-- 1 sprout staff 40596 Jan 3 16:36 doio.o -- Father Chrysostomos |
|
The RT System itself - Status changed from 'new' to 'open' |
From @bulk88On Sat Jan 03 16:38:30 2015, sprout wrote:
New patch attached, it silenced comment inside a comment warning from clang. Can you send me the complete full or mini perl binaries? I dont trust .o file size since it includes debugging symbols (possibly including the original text src code) and those are a wildcard. Note that for gv_AVadd and friends, it is less efficient in machine code size, but there are alot less gv_**add in the perl source and on CPAN than Gv**n() instances. I could easily remove all uses of gv_**add from core. gv_**add is a dont check if the GP member there, just add it (and Perl_gv_add_by_type/Perl_gv_add_by_type_p will check again if the GP slot is NULL to avoid an leak accident). I tried clang with win32/makefile.mk C:\perl521\srcnew\win32>clang -v C:\perl521\srcnew\win32> Win32 Clang -O2 32 bit Miniperl shows a reduction in machine code size (.text "Virtual Size") after the patch from 0x11B4C4 to 0x11B244. I included the before and after patch "refactor gv_add_by_type" header dumps. objdump for win32 also shows the size of .text C:\perl521\srcnew>objdump -h miniperl.exe miniperl.exe: file format pei-i386 Sections: C:\perl521\srcnew> The .text size also works for ELF Perl (this is an old 5.21 miniperl someone sent me). C:\Documents and Settings\Administrator\Desktop\linperl>objdump -h miniperl miniperl: file format elf64-x86-64 Sections: C:\Documents and Settings\Administrator\Desktop\linperl> HPUX 32 PARISC with HP C compiler also shows a drop in machine code size. Headers attached. -- |
From @bulk880001-refactor-gv_add_by_type.patchFrom 55c20a49106075ff7f74aaf05b8d7417260a3f16 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 4 Jan 2015 17:49:09 -0500
Subject: [PATCH] refactor gv_add_by_type
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 | 2 +-
embed.h | 2 +-
gv.c | 131 +++++++++++++++++++++++++++++++++--------------------
gv.h | 28 +++++++----
perl.h | 13 +++++
pod/perldelta.pod | 13 +++++
pp_hot.c | 6 +--
proto.h | 6 ++-
scope.c | 10 ++--
9 files changed, 139 insertions(+), 72 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index c420c3b..bdf8191 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
-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
--- a/embed.h
+++ b/embed.h
@@ -186,7 +186,6 @@
#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)
@@ -1176,6 +1175,7 @@
#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..f1fcad3 100644
--- 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 = 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, 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..c0cde6e 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) : \
- &(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,19 @@ 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 *)gv_add_by_type_p((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*)gv_add_by_type_p((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*)gv_add_by_type_p((gv), GPe_HV))
#define GvCV(gv) (0+GvGP(gv)->gp_cv)
#define GvCV_set(gv,cv) (GvGP(gv)->gp_cv = (cv))
@@ -283,10 +283,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 c471541..d61048d 100644
--- 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,
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index be051e1..3a70b71 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -380,6 +380,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
diff --git a/pp_hot.c b/pp_hot.c
index 4072ab1..5557356 100644
--- 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 16948f1..b68ba1b 100644
--- 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
--- 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
--
1.7.9.msysgit.0
|
From @bulk88perl: file format som Sections: |
From @bulk88perl: file format som Sections: |
From @bulk88Microsoft (R) COFF/PE Dumper Version 7.10.6030 Dump of file miniperl.exe PE signature found File Type: EXECUTABLE IMAGE FILE HEADER VALUES OPTIONAL HEADER VALUES SECTION HEADER #1 SECTION HEADER #2 SECTION HEADER #3 SECTION HEADER #4 SECTION HEADER #5 SECTION HEADER #6 SECTION HEADER #7 SECTION HEADER #8 SECTION HEADER #9 Summary 1000 .CRT |
From @bulk88Microsoft (R) COFF/PE Dumper Version 7.10.6030 Dump of file miniperl.exe PE signature found File Type: EXECUTABLE IMAGE FILE HEADER VALUES OPTIONAL HEADER VALUES SECTION HEADER #1 SECTION HEADER #2 SECTION HEADER #3 SECTION HEADER #4 SECTION HEADER #5 SECTION HEADER #6 SECTION HEADER #7 SECTION HEADER #8 SECTION HEADER #9 Summary 1000 .CRT |
From [Unknown Contact. See original ticket]On Sat Jan 03 16:38:30 2015, sprout wrote:
New patch attached, it silenced comment inside a comment warning from clang. Can you send me the complete full or mini perl binaries? I dont trust .o file size since it includes debugging symbols (possibly including the original text src code) and those are a wildcard. Note that for gv_AVadd and friends, it is less efficient in machine code size, but there are alot less gv_**add in the perl source and on CPAN than Gv**n() instances. I could easily remove all uses of gv_**add from core. gv_**add is a dont check if the GP member there, just add it (and Perl_gv_add_by_type/Perl_gv_add_by_type_p will check again if the GP slot is NULL to avoid an leak accident). I tried clang with win32/makefile.mk C:\perl521\srcnew\win32>clang -v C:\perl521\srcnew\win32> Win32 Clang -O2 32 bit Miniperl shows a reduction in machine code size (.text "Virtual Size") after the patch from 0x11B4C4 to 0x11B244. I included the before and after patch "refactor gv_add_by_type" header dumps. objdump for win32 also shows the size of .text C:\perl521\srcnew>objdump -h miniperl.exe miniperl.exe: file format pei-i386 Sections: C:\perl521\srcnew> The .text size also works for ELF Perl (this is an old 5.21 miniperl someone sent me). C:\Documents and Settings\Administrator\Desktop\linperl>objdump -h miniperl miniperl: file format elf64-x86-64 Sections: C:\Documents and Settings\Administrator\Desktop\linperl> HPUX 32 PARISC with HP C compiler also shows a drop in machine code size. Headers attached. -- |
From @cpansproutOn Sun Jan 04 17:14:16 2015, bulk88 wrote:
With current blead and your new patch, the size drops significantly instead of going up: -rwxr-xr-x 1 sprout staff 1752684 Jan 4 23:26 miniperl I can’t upload a 1.6 MB zip file to RT (the browser just hangs). So I’ll send it via private e-mail. -- Father Chrysostomos |
From @cpansproutOn Sun Jan 04 23:31:10 2015, sprout wrote:
I am seeing two test failures with this patch: # Failed test 'disttest' # Failed test ' make test exited normally' -- Father Chrysostomos |
From @bulk88On Sun Jan 04 23:31:10 2015, sprout wrote:
Diff attached of the 2 binaries. Perl_get_hv and similar functions grew by 1 x86 instruction (a register to register move) since the CC (clang)'s register allocator doesn't know that RAX/EAX is a special register on x86 (neither does GCC, only VC's register allocator knows this, and I'm not filing a bug report with llvm or gnu, maybe someone else can). The "mov rcx, rax" after Perl_gv_add_by_type_p can be removed if the jump target is after the "mov rax, rcx" instruction. The pics are from FC's miniperls. But all of that is besides the point. Perl_get_** need to be refactored since gv_fetchpv will create the GP struct slot based on flags and svtype with a call to gv_init_svtype() from Perl_gv_fetchpvn_flags. So calling Perl_gv_add_by_type is redundant. Proposed version below HV* PERL_ARGS_ASSERT_GET_HV; if (gv) Perl_init_dbargs, Perl_init_debugger, perl_parse (extensive inlining went on in here, so it is probably perl_parse->S_parse_body->S_init_main_stash, and S_init_main_stash has gv_**add) increases are due to gv_**add(). pp_open's growth is because the CC optimizer didnt dedup the PUSH() code. I will respond to the test failures in another post. -- |
From @bulk88No attachments made it even though they were listed as uploaded on my reply page. Trying again. -- |
From @bulk88 |
From @bulk88 |
From @bulk88 |
From @bulk88On Mon Jan 05 06:05:10 2015, sprout wrote:
Are these related to -DPERL_CREATE_GVSV (AKA no PERL_DONT_CREATE_GVSV ) on your build setup? If I revert this gv optimization patch, -DPERL_CREATE_GVSV still SEGVs on me in re/fold_grind.t Unhandled exception at 0x28089385 (perl521.dll) in perl.exe: 0xC0000005: Access violation reading location 0x0000000a. SV * PERL_ARGS_ASSERT_SAVE_SCALAR; if (UNLIKELY(SvGMAGICAL(*sptr))) { <<<<<<<<<<< CRASH perl521.dll!Perl_save_scalar(interpreter * my_perl=0x00366014, gv * gv=0x00368cb4) Line 223 + 0xf C curcop is at http://perl5.git.perl.org/perl.git/blob/f1b45a3d52fa1aaf1e5c640af90c436a8e1d6174:/lib/utf8_heavy.pl#l538 gp_sv is NULL. re/pat.t re/pat_advanced.t re/pat_advanced_thr.t and most of the tests in /re also SEGVs with a nearly identical call stack. -- |
From @cpansproutOn Mon Jan 05 18:48:58 2015, bulk88 wrote:
No. $ uname -a
Is it perhaps time to retire that build option? -- Father Chrysostomos |
From @cpansproutOn Mon Jan 05 21:38:57 2015, sprout wrote:
I’m not seeing the test failures any more. I have done a clean and rebuild since then, so maybe there was something left over that was also necessary to cause them. I plan to apply your patch soon, but it needs some casts to compile under C++. -- Father Chrysostomos |
From @cpansproutOn Mon Jan 05 21:56:06 2015, sprout wrote:
I spoke too soon. They had something to do with POSIX not loading properly. I don’t know why I didn’t get a build failure before, but I am getting one now. The attached patch applied on top of your second patch seems to get things working. (I am still running tests as I write this.) I plan to squash the two together and apply them in about 8 hours, if I get a chance.
-- Father Chrysostomos |
From @cpansproutInline Patchdiff --git a/gv.c b/gv.c
index f1fcad3..5a05afa 100644
--- a/gv.c
+++ b/gv.c
@@ -83,7 +83,7 @@ Perl_gv_add_by_type_p(pTHX_ GV *gv, gv_add_type type)
#else
# error unknown pointer size
#endif
- svtype svtypevar = addtype_to_svtype[PTRPTR2IDX(type)];
+ svtype svtypevar = (svtype)addtype_to_svtype[PTRPTR2IDX(type)];
assert(PTRPTR2IDX(type) < sizeof(addtype_to_svtype));
sv = *where = newSV_type(svtypevar);
@@ -511,7 +511,7 @@ S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
if(addtype != SGVINIT_SKIP) {
SV ** where = (SV **)((Size_t)GvGP(gv)+ addtype);
if (!*where)
- gv_add_by_type_p(gv, addtype);
+ gv_add_by_type_p(gv, (gv_add_type)addtype);
}
return;
#undef SGVINIT_SV
diff --git a/gv.h b/gv.h
index c0cde6e..7792017 100644
--- a/gv.h
+++ b/gv.h
@@ -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) : (struct io *)gv_add_by_type_p((gv), GPe_IO))
+#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 : \
- (AV*)gv_add_by_type_p((gv), GPe_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 : \
- (HV*)gv_add_by_type_p((gv), GPe_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)) |
From @cpansproutOn Mon Jan 05 22:11:14 2015, sprout wrote:
I have done so now, in commit 819b139. Thank you. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'resolved' |
From @haargOn Tue, Jan 6, 2015 at 9:41 AM, Father Chrysostomos via RT
This commit has broken Variable::Magic |
From @bulk88Graham Knop via RT wrote:
Lets see how many UAs I break with this post (the html). Variable::Magic } else { This leaks. STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) { return 0; 1 8 { 20 ((my_perl->Ierrgv))->sv_u.svu_gp 22 GPe_SV)))-> 24 ((0 + 25 ((my_perl-> 32 Perl_gv_add_ 34 ((my_perl-> 36 2) 37 : (! 39 ((my_perl->Ierrgv))->sv_u.svu_gp 41 GPe_SV)))-> 47 ((my_perl->Ierrgv))->sv_u.svu 49 GPe_SV)))->sv_flags & 0xff)) == SVt_REGEXP 50 || 52 ((my_perl->Ierrgv))->sv_u.svu_ 54 GPe_SV)))-> 56 (SVt_PVLV | 0x01000000))) ? 0 : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)-> 57 gp_sv ? (0 + 59 gp_sv : Perl_gv_add_by_type_p(my_perl, 60 ((my_perl->Ierrgv 62 sv_flags & 0x00000400) 63 ? (((XPV 65 ((my_perl->Ierrgv))->sv_ 70 ((my_perl->Ierrgv))->sv 72 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), 73 GPe_SV))))->sv_any)->xpv_cur > 1 74 || 77 ((my_perl->Ierrgv))->s 79 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), 80 GPe_SV))))->sv_any)->xpv_cur 81 && 83 ((my_perl->Ierrgv))->sv_u.s 85 GPe_SV)))->sv_u.svu_pv != 86 '0'))) : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 87 ((my_perl->Ierrgv) 89 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), 90 GPe_SV)))-> 91 sv_flags & (0x00000100 | 0x00000200)) 93 ((my_perl->Ierrgv))->sv_u.sv 95 GPe_SV)))->sv_flags & 0x00000100) 96 && 99 ((my_perl->Ierrgv))->sv_ 101 GPe_SV)))->sv_any)->xiv_u.xivu_iv != 0) 102 || 104 ((my_perl->Ierrgv))->sv_u.sv 106 GPe_SV)))->sv_flags & 0x00000200) 107 && 110 ((my_perl->Ierrgv))->sv_ 112 GPe_SV)))->sv_any)->xnv_u.xnv_nv != 113 0.0)) : (Perl_sv_2bool_flags(my_perl, 125 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 127 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), GPe_SV)) = Perl_newSV(my_per 133 1) : Perl_cxinc(my_perl); 134 146 ((my_perl->Ierrgv))->sv_u.svu_gp 148 GPe_SV)))-> 150 ((0 + 151 ((my_perl-> 158 Perl_gv_add_ 160 ((my_perl-> 162 2) 163 : (! 165 ((my_perl->Ierrgv))->sv_u.svu_gp 167 GPe_SV)))-> 173 ((my_perl->Ierrgv))->sv_u.svu 175 GPe_SV)))->sv_flags & 0xff)) == SVt_REGEXP 176 || 178 ((my_perl->Ierrgv))->sv_u.svu_ 180 GPe_SV)))-> 182 (SVt_PVLV | 0x01000000))) ? 0 : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)-> 183 gp_sv ? (0 + 185 gp_sv : Perl_gv_add_by_type_p(my_perl, 186 ((my_perl->Ierrgv 188 sv_flags & 0x00000400) 189 ? (((XPV 191 ((my_perl->Ierrgv))->sv_ 196 ((my_perl->Ierrgv))->sv 198 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), 199 GPe_SV))))->sv_any)->xpv_cur > 1 200 || 203 ((my_perl->Ierrgv))->s 205 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), 206 GPe_SV))))->sv_any)->xpv_cur 207 && 209 ((my_perl->Ierrgv))->sv_u.s 211 GPe_SV)))->sv_u.svu_pv != 212 '0'))) : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 213 ((my_perl->Ierrgv) 215 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), 216 GPe_SV)))-> 217 sv_flags & (0x00000100 | 0x00000200)) 219 ((my_perl->Ierrgv))->sv_u.sv 221 GPe_SV)))->sv_flags & 0x00000100) 222 && 225 ((my_perl->Ierrgv))->sv_ 227 GPe_SV)))->sv_any)->xiv_u.xivu_iv != 0) 228 || 230 ((my_perl->Ierrgv))->sv_u.sv 232 GPe_SV)))->sv_flags & 0x00000200) 233 && 236 ((my_perl->Ierrgv))->sv_ 238 GPe_SV)))->sv_any)->xnv_u.xnv_nv != 239 0.0)) : (Perl_sv_2bool_flags(my_perl, 250 ((my_perl->Ierr 252 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), GPe_ 258 ((my_perl 263 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 266 } 271 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 272 ((my_pe 277 else 280 ((my_perl->Ie 283 GPe_SV)))-> 284 sv_flags & (0x00000400 | 0x00200000)) == 285 0x00000400) 287 ((my_perl->I 290 GPe_SV)))->sv_u. 291 svu_pv) : S_sv_2pv_flags(my_perl, 301 ((my_perl->Ierrgv))- 303 gp_sv : Perl_gv_add_by_type_p(my_perl, ((my_perl->Ierrgv)), 304 GPe_SV)))->sv_any)->xpv_cur = (0)); 305 } while (0); 322 ((my_perl 327 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 330 } |
From @bulk88On Tue Jan 06 07:52:29 2015, haarg wrote:
I tried fixing Variable::Magic, but got an interesting callstack with a "Attempt to free unreferenced scalar: " perl521.dll!Perl_sv_free2(interpreter * my_perl=0x00365d54, sv * const sv=0x00368a04, const unsigned long rc=0) Line 7113 C The code is STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) { return 0; I originally thought this code leaked, but actually, it doesn't leak, since Variable::Magic makes a GV, not own the SV * in the GP. The callstack shows a double free going on. So is that safe or sane? Changing the code to STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) { return 0; stops the unreferenced scalar problem, but still leaves a questionable callstack that might be a double free/reenterant problem (look at the mg_free parameters) perl521.dll!Perl_mg_free(interpreter * my_perl=0x00364014, sv * sv=0x00368b24) Line 563 C -- |
From @bulk88In addition to ERRSV not being an lvalue anymore, there is a report DEFSV as lvalue is causing breakage too. But about DEFSV, there is something unusual about its definition. http://perl5.git.perl.org/perl.git/blob/804352e2cf6da2f05a8e83ac4debc4ceb6617b7c:/perl.h#l1292 1292 #ifdef PERL_CORE CPAN gets the lvalue version, core uses only rvalue. CPAN gets the leaking version of "DEFSV_set", core gets non-leaking "DEFSV_set". This strangeness is from FC commit http://perl5.git.perl.org/perl.git/commitdiff/55b5114f4ff694ab871173b736aa2d48bb095684 Which shows that the design flaw of GvSVn as lvalue was seen years ago. IDK if the CPAN side of DEFSV/DEFSV_set/SAVE_DEFSV should be removed and unified with the core side of DEFSV/DEFSV_set/SAVE_DEFSV for 5.22. -- |
From @cpansproutOn Wed Jan 07 13:44:09 2015, bulk88 wrote:
I was unsure at the time of the ramifications of changing the CPAN version of DEFSV_set. I was planning to look at different uses of DEFSV_set on CPAN and decide whether DEFSV_set should do SvREFCNT_dec, but never got to it. (Would you be willing to do the research?) DEFSV as an lvalue was not something I considered. -- Father Chrysostomos |
From @ilmari"bulk88 via RT" <perlbug-followup@perl.org> writes:
Except it's not an lvalue even outside core, since perl.h has /* We no longer default to creating a new SV for GvSV. and gv.h has #ifdef PERL_DONT_CREATE_GVSV Which is what broke e.g. DBI: DBI.xs: In function ‘dbi_profile’: -- |
From @andkAlso affected: PMQS/BerkeleyDB-0.54.tar.gz Interestingly, TIMB/DBI-1.632.tar.gz is affected but the dev version |
From @ilmariAndreas Koenig <andreas.koenig.7os6VVqR@franz.ak.mind.de> writes:
Yes, I fixed it: perl5-dbi/dbi#16 (but thinkoed -- |
From @bulk88Since there are many complaints about this patch, I've rewritten it in Perl 5. sub GvSVnew has 23 perl ops, sub GvSVold has 27 perl ops. Count them yourself. perl ops can't be compared to machine code ops, but both in C/machine code and the pure perl version, the same refactoring saves on ops in both. before after -- |
From @bulk88 |
Migrated from rt.perl.org#123522 (status was 'resolved')
Searchable as RT123522$
The text was updated successfully, but these errors were encountered: