[PATCH] refactor gv_add_by_type

[p5pRT]

Migrated from rt.perl.org#123522 (status was 'resolved')

Searchable as RT123522$

[p5pRT]

From @bulk88

Created by @bulk88

See attached patch.

The original patch message was

before VC 2003 32 -01 .text 0xc8813 .rdata 0x482fa in bytes after .text 0xc8623 .rdata 0x4857c

but the theoretical .rdata of the 2 arrays I added was 0x18 bytes\, but some of it was atoned for by the string removal\, as in the pics\, so it probably should be been ~0x10\< delta\, not 0x18. while the delta seen was is 0x282\, but it seems the build process switch from 3 "local patches" to 16 "local patches" and that made .rdata much bigger with those string extra SHA1s.

This will cause some minor breakage with DEFSV http​://grep.cpan.me/?q=-file%3Appport\.h+DEFSV \, but all the code that currently assigns to DEFSV is leaking anyway since perl.h currently has

#ifdef PERL_CORE # define DEFSV (0 + GvSVn(PL_defgv)) # define DEFSV_set(sv) \   (SvREFCNT_dec(GvSV(PL_defgv))\, GvSV(PL_defgv) = SvREFCNT_inc(sv)) # define SAVE_DEFSV \   ( \   save_gp(PL_defgv\, 0)\, \   GvINTRO_off(PL_defgv)\, \   SAVEGENERICSV(GvSV(PL_defgv))\, \   GvSV(PL_defgv) = NULL \   ) #else # define DEFSV GvSVn(PL_defgv) # define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif

assigning to GvSVn will leak.

There doesn't seem to be anything on CPAN that will break as of Gv\w\wn becoming rvalue only.

http​://grep.cpan.me/?q=-file%3Appport\.h%20Gv\w\wn\%28&page=1

Perl Info

``` Flags: category=core severity=low Site configuration information for perl 5.21.7: Configured by Owner at Sat Nov 22 21:54:54 2014. Summary of my perl5 (revision 5 version 21 subversion 7) configuration: Local Commit: 1bce52df028aabe28c20b2d97949e35c17ea811e Ancestor: 7072da8afeba4c87ae623cd913e274396ffcf1cd Platform: osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread uname='' config_args='undef' hint=recommended, useposix=true, d_sigaction=undef useithreads=define, usemultiplicity=define use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -G7 -GL -DWIN32 -D_CONSOLE -DNO_STRICT -DPERL_TEXTMODE_SCRIPTS -DPERL_HASH_FUNC_ONE_AT_A_TIME -DNO_MATHOMS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -D_USE_32BIT_TIME_T', optimize='-O1 -MD -Zi -DNDEBUG -G7 -GL', cppflags='-DWIN32' ccversion='13.10.6030', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234, doublekind=3 d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8, longdblkind=0 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"c:\perl521\lib\CORE" -machine:x86' libpth="C:\Program Files\Microsoft Visual Studio .NET 2003\VC7\lib" libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl521.lib gnulibc_version='' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"c:\perl521\lib\CORE" -machine:x86' Locally applied patches: ce7a4d57d0acca9f39a84d36d708c4505dfe45ca ca0b263f4b167ddf97416f657d79ab5bd3344357 08919bf863666074243240abbd19cd1a74cc7b74 b8a043377dbf39548709b107a11e5cc2714c0e9a efa855eb5cffb7739616c295dd968d1510efeeb0 1d47d0b810e26d9a2f9101fb813bd5b3dd332cc9 3faca062ddb056db54f73fa55b0a9d473675dd33 0b3e905bda3e75ad948a1213f620656b60807393 1b1efc719fde05d215e5a13fb38c03e12a3aab08 1bce52df028aabe28c20b2d97949e35c17ea811e @INC for perl 5.21.7: ..\lib C:/perl521/srcnewb4opt/lib . Environment for perl 5.21.7: HOME (unset) LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=C:\WINDOWS\system32;C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\bin;C:\Program Files\Microsoft Visual Studio .NET 2003\Common7\IDE;C:\WINDOWS;C:\Program Files\Git\cmd;C:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Tools\bin;C:\perl\bin PERL_BADLANG (unset) PERL_JSON_BACKEND=Cpanel::JSON::XS PERL_YAML_BACKEND=YAML SHELL (unset) ```

[p5pRT]

From @bulk88

0001-refactor-gv_add_by_type.patch

```diff From 6c852af434f736f238be38edb67ac84458db3363 Mon Sep 17 00:00:00 2001 From: Daniel Dragan 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 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. + +=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 ```

[p5pRT]

From @bulk88

[before strings.PNG](https://rt-archive.perl.org/perl5/Ticket/Attachment/1324508/706227/before strings.PNG)

[p5pRT]

From @bulk88

[after strings.PNG](https://rt-archive.perl.org/perl5/Ticket/Attachment/1324508/706228/after strings.PNG)

[p5pRT]

From @cpansprout

On Tue Dec 30 06​:33​:30 2014\, bulk88 wrote​:

This is a bug report for perl from bulk88@​hotmail.com\, generated with the help of perlbug 1.40 running under perl 5.21.7.

----------------------------------------------------------------- [Please describe your issue here]

See attached patch.

I don’t feel comfortable about patches that make the code harder to read and make things more efficient only for one compiler. With clang I see an increase in the binary size after your patch is applied.

$ clang -v Apple LLVM version 4.2 (clang-425.0.27) (based on LLVM 3.2svn) Target​: x86_64-apple-darwin12.5.0 Thread model​: posix $ ls -l {old\,}perl -rwxr-xr-x 1 sprout staff 1761380 Jan 3 16​:10 oldperl -rwxr-xr-x 1 sprout staff 1761444 Jan 3 16​:10 perl $ ls -l {old\,}miniperl -rwxr-xr-x 1 sprout staff 1752684 Jan 3 16​:22 miniperl -rwxr-xr-x 1 sprout staff 1756708 Jan 3 16​:21 oldminiperl

If I look at the sizes of the object files that changed size\, I see that most of them went down in size\, but some went up\, but only a tiny amount. I don’t know what to make of this.

Before​:

-rw-r--r-- 1 sprout staff 40608 Jan 3 16​:27 doio.o -rw-r--r-- 1 sprout staff 67788 Jan 3 16​:27 dump.o -rw-r--r-- 1 sprout staff 56604 Jan 3 16​:27 gv.o -rw-r--r-- 1 sprout staff 37880 Jan 3 16​:27 mathoms.o -rw-r--r-- 1 sprout staff 192904 Jan 3 16​:27 opmini.o -rw-r--r-- 1 sprout staff 28900 Jan 3 16​:27 pad.o -rw-r--r-- 1 sprout staff 139020 Jan 3 16​:27 perlmini.o -rw-r--r-- 1 sprout staff 107472 Jan 3 16​:27 pp.o -rw-r--r-- 1 sprout staff 95204 Jan 3 16​:27 pp_ctl.o -rw-r--r-- 1 sprout staff 57416 Jan 3 16​:27 pp_hot.o -rw-r--r-- 1 sprout staff 96656 Jan 3 16​:27 pp_sys.o -rw-r--r-- 1 sprout staff 95164 Jan 3 16​:27 regexec.o -rw-r--r-- 1 sprout staff 26304 Jan 3 16​:27 scope.o -rw-r--r-- 1 sprout staff 3884 Jan 3 16​:27 taint.o -rw-r--r-- 1 sprout staff 208208 Jan 3 16​:27 toke.o -rw-r--r-- 1 sprout staff 91280 Jan 3 16​:27 util.o

After​:

-rw-r--r-- 1 sprout staff 40596 Jan 3 16​:36 doio.o -rw-r--r-- 1 sprout staff 67788 Jan 3 16​:35 dump.o -rw-r--r-- 1 sprout staff 56072 Jan 3 16​:35 gv.o -rw-r--r-- 1 sprout staff 37788 Jan 3 16​:36 mathoms.o -rw-r--r-- 1 sprout staff 192908 Jan 3 16​:35 opmini.o -rw-r--r-- 1 sprout staff 28904 Jan 3 16​:35 pad.o -rw-r--r-- 1 sprout staff 139116 Jan 3 16​:35 perlmini.o -rw-r--r-- 1 sprout staff 107460 Jan 3 16​:35 pp.o -rw-r--r-- 1 sprout staff 95064 Jan 3 16​:35 pp_ctl.o -rw-r--r-- 1 sprout staff 57348 Jan 3 16​:35 pp_hot.o -rw-r--r-- 1 sprout staff 96516 Jan 3 16​:36 pp_sys.o -rw-r--r-- 1 sprout staff 95148 Jan 3 16​:36 regexec.o -rw-r--r-- 1 sprout staff 26292 Jan 3 16​:35 scope.o -rw-r--r-- 1 sprout staff 3872 Jan 3 16​:36 taint.o -rw-r--r-- 1 sprout staff 208212 Jan 3 16​:35 toke.o -rw-r--r-- 1 sprout staff 91268 Jan 3 16​:35 util.o

--

Father Chrysostomos

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @bulk88

On Sat Jan 03 16​:38​:30 2015\, sprout wrote​:

On Tue Dec 30 06​:33​:30 2014\, bulk88 wrote​:

This is a bug report for perl from bulk88@​hotmail.com\, generated with the help of perlbug 1.40 running under perl 5.21.7.

----------------------------------------------------------------- [Please describe your issue here]

See attached patch.

I dont feel comfortable about patches that make the code harder to read and make things more efficient only for one compiler. With clang I see an increase in the binary size after your patch is applied.

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 clang version 3.5.0 (217039) Target​: i686-pc-windows-gnu Thread model​: posix

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​: Idx Name Size VMA LMA File off Algn   0 .text 0011b244 00401000 00401000 00000400 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE\, DATA   1 .data 00000e04 0051d000 0051d000 0011b800 2**4   CONTENTS\, ALLOC\, LOAD\, DATA   2 .rdata 0002aabc 0051e000 0051e000 0011c800 2**5   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   3 .bss 00001ac0 00549000 00549000 00000000 2**5   ALLOC   4 .edata 00002e86 0054b000 0054b000 00147400 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   5 .idata 00001cb0 0054e000 0054e000 0014a400 2**2   CONTENTS\, ALLOC\, LOAD\, DATA   6 .CRT 00000034 00550000 00550000 0014c200 2**2   CONTENTS\, ALLOC\, LOAD\, DATA   7 .tls 00000020 00551000 00551000 0014c400 2**2   CONTENTS\, ALLOC\, LOAD\, DATA   8 .reloc 0000d6c0 00552000 00552000 0014c600 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA

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​: Idx Name Size VMA LMA File off Algn   0 .interp 0000001c 0000000000400238 0000000000400238 00000238 2**0   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   1 .note.ABI-tag 00000020 0000000000400254 0000000000400254 00000254 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   2 .note.gnu.build-id 00000024 0000000000400274 0000000000400274 00000274 2 **2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   3 .gnu.hash 00000040 0000000000400298 0000000000400298 00000298 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   4 .dynsym 00001620 00000000004002d8 00000000004002d8 000002d8 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   5 .dynstr 0000082c 00000000004018f8 00000000004018f8 000018f8 2**0   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   6 .gnu.version 000001d8 0000000000402124 0000000000402124 00002124 2**1   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   7 .gnu.version_r 000000b0 0000000000402300 0000000000402300 00002300 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   8 .rela.dyn 00000078 00000000004023b0 00000000004023b0 000023b0 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   9 .rela.plt 00001518 0000000000402428 0000000000402428 00002428 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 10 .init 0000001a 0000000000403940 0000000000403940 00003940 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 11 .plt 00000e20 0000000000403960 0000000000403960 00003960 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 12 .text 001101c4 0000000000404780 0000000000404780 00004780 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 13 .fini 00000009 0000000000514944 0000000000514944 00114944 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 14 .rodata 0003e55f 0000000000514960 0000000000514960 00114960 2**5   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 15 .eh_frame_hdr 00003cb4 0000000000552ec0 0000000000552ec0 00152ec0 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 16 .eh_frame 0001865c 0000000000556b78 0000000000556b78 00156b78 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 17 .init_array 00000008 000000000076fdc0 000000000076fdc0 0016fdc0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 18 .fini_array 00000008 000000000076fdc8 000000000076fdc8 0016fdc8 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 19 .jcr 00000008 000000000076fdd0 000000000076fdd0 0016fdd0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 20 .dynamic 00000220 000000000076fdd8 000000000076fdd8 0016fdd8 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 21 .got 00000008 000000000076fff8 000000000076fff8 0016fff8 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 22 .got.plt 00000720 0000000000770000 0000000000770000 00170000 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 23 .data 000028c0 0000000000770720 0000000000770720 00170720 2**5   CONTENTS\, ALLOC\, LOAD\, DATA 24 .bss 00000e78 0000000000772fe0 0000000000772fe0 00172fe0 2**5   ALLOC 25 .comment 0000002c 0000000000000000 0000000000000000 00172fe0 2**0   CONTENTS\, READONLY

C​:\Documents and Settings\Administrator\Desktop\linperl>

---

HPUX 32 PARISC with HP C compiler also shows a drop in machine code size. Headers attached.

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

0001-refactor-gv_add_by_type.patch

```diff From 55c20a49106075ff7f74aaf05b8d7417260a3f16 Mon Sep 17 00:00:00 2001 From: Daniel Dragan 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 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. + +=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 ```

[p5pRT]

From @bulk88

perl​: file format som

Sections​: Idx Name Size VMA LMA File off Algn   0 $TEXT$ 001f0a40 00001000 00000000 0004f000 2**3  
  1 $SHLIB_INFO$ 00028a80 00001000 00000000 0004f000 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   2 $MILLICODE$ 000013c8 00029a80 00000000 00077a80 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   3 $CODE$ 0001ff64 0002ae4c 00000000 00078e4c 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   4 $CODE$ 0001ffac 0004adb0 00000000 00098db0 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   5 $CODE$ 0001e94c 0006ad5c 00000000 000b8d5c 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   6 $CODE$ 0001a814 000896a8 00000000 000d76a8 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   7 $CODE$ 0001fec4 000a3ebc 00000000 000f1ebc 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   8 $CODE$ 0001fbc8 000c3d80 00000000 00111d80 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   9 $CODE$ 0001fea8 000e3948 00000000 00131948 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 10 $CODE$ 0001ffcc 001037f0 00000000 001517f0 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 11 $CODE$ 0001fccc 001237bc 00000000 001717bc 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 12 $CODE$ 0001fec0 00143488 00000000 00191488 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 13 $CODE$ 0001fc8c 00163348 00000000 001b1348 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 14 $CODE$ 00011994 00182fd4 00000000 001d0fd4 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 15 $LIT$ 00014954 00194968 00000000 001e2968 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 16 $LIT$ 00018514 001a92c0 00000000 001f72c0 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 17 $LIT$ 00019704 001c17d8 00000000 0020f7d8 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 18 $UNWIND_START$ 00015e10 001daee0 00000000 00228ee0 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 19 $UNWIND_END$ 00000d50 001f0cf0 00000000 0023ecf0 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 20 $RECOVER_START$ 00000000 001f1a40 00000000 0023fa40 2**2   ALLOC\, LOAD\, READONLY\, CODE 21 $RECOVER_END$ 00000004 001f1a40 00000000 0023fa40 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 22 $PRIVATE$ 00006ef0 40001000 00000000 00240000 2**3  
23 $DATA_START$ 00000000 40001000 00000000 00240000 2**3   ALLOC\, LOAD\, DATA 24 $PFA_COUNTER$ 00000008 40001000 00000000 00240000 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 25 $PFA_COUNTER_END$ 00000000 40001008 00000000 00240008 2**2   ALLOC\, LOAD\, DATA 26 $DATA$ 00005418 40001008 00000000 00240008 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 27 $SHORTDATA$ 00000164 40006420 00000000 00245420 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 28 $PLT$ 00001928 40006588 00000000 00245588 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 29 $DLT$ 0000002c 40007eb0 00000000 00246eb0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 30 $GLOBAL$ 00000010 40007ee0 00000000 00246ee0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 31 $SHORTBSS$ 00000004 40007ef0 00000000 00000000 2**3   ALLOC 32 $BSS$ 00000820 40007ef8 00000000 00000000 2**3   ALLOC

[p5pRT]

From @bulk88

perl​: file format som

Sections​: Idx Name Size VMA LMA File off Algn   0 $TEXT$ 001f0cf0 00001000 00000000 0004f000 2**3  
  1 $SHLIB_INFO$ 00028a7e 00001000 00000000 0004f000 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   2 $MILLICODE$ 000013c8 00029a80 00000000 00077a80 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   3 $CODE$ 0001ff8c 0002ae4c 00000000 00078e4c 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   4 $CODE$ 0001fd68 0004add8 00000000 00098dd8 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   5 $CODE$ 0001ec2c 0006ab40 00000000 000b8b40 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   6 $CODE$ 0001a828 00089770 00000000 000d7770 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   7 $CODE$ 0001fee0 000a3f98 00000000 000f1f98 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   8 $CODE$ 0001fbcc 000c3e78 00000000 00111e78 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE   9 $CODE$ 0001feb0 000e3a44 00000000 00131a44 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 10 $CODE$ 0001ffc8 001038f4 00000000 001518f4 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 11 $CODE$ 0001fe6c 001238bc 00000000 001718bc 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 12 $CODE$ 0001ff34 00143728 00000000 00191728 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 13 $CODE$ 0001fc6c 0016365c 00000000 001b165c 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 14 $CODE$ 0001192c 001832c8 00000000 001d12c8 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 15 $LIT$ 0001493c 00194bf8 00000000 001e2bf8 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 16 $LIT$ 00018514 001a9538 00000000 001f7538 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 17 $LIT$ 0001971c 001c1a50 00000000 0020fa50 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 18 $UNWIND_START$ 00015e30 001db170 00000000 00229170 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 19 $UNWIND_END$ 00000d50 001f0fa0 00000000 0023efa0 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 20 $RECOVER_START$ 00000000 001f1cf0 00000000 0023fcf0 2**2   ALLOC\, LOAD\, READONLY\, CODE 21 $RECOVER_END$ 00000004 001f1cf0 00000000 0023fcf0 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 22 $PRIVATE$ 00006ec0 40001000 00000000 00240000 2**3  
23 $DATA_START$ 00000000 40001000 00000000 00240000 2**3   ALLOC\, LOAD\, DATA 24 $PFA_COUNTER$ 00000008 40001000 00000000 00240000 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 25 $PFA_COUNTER_END$ 00000000 40001008 00000000 00240008 2**2   ALLOC\, LOAD\, DATA 26 $DATA$ 000053e8 40001008 00000000 00240008 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 27 $SHORTDATA$ 00000164 400063f0 00000000 002453f0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 28 $PLT$ 00001928 40006558 00000000 00245558 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 29 $DLT$ 0000002c 40007e80 00000000 00246e80 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 30 $GLOBAL$ 00000010 40007eb0 00000000 00246eb0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 31 $SHORTBSS$ 00000004 40007ec0 00000000 00000000 2**3   ALLOC 32 $BSS$ 00000820 40007ec8 00000000 00000000 2**3   ALLOC

[p5pRT]

From @bulk88

Microsoft (R) COFF/PE Dumper Version 7.10.6030 Copyright (C) Microsoft Corporation. All rights reserved.

Dump of file miniperl.exe

PE signature found

File Type​: EXECUTABLE IMAGE

FILE HEADER VALUES   14C machine (x86)   9 number of sections   54A8EF48 time date stamp Sun Jan 04 02​:44​:08 2015   0 file pointer to symbol table   0 number of symbols   E0 size of optional header   30E characteristics   Executable   Line numbers stripped   Symbols stripped   32 bit word machine   Debug information stripped

OPTIONAL HEADER VALUES   10B magic # (PE32)   2.22 linker version   11B400 size of code   159A00 size of initialized data   1C00 size of uninitialized data   14E0 entry point (004014E0)   1000 base of code   11D000 base of data   400000 image base (00400000 to 0055FFFF)   1000 section alignment   200 file alignment   4.00 operating system version   1.00 image version   4.00 subsystem version   0 Win32 version   160000 size of image   400 size of headers   168944 checksum   3 subsystem (Windows CUI)   0 DLL characteristics   200000 size of stack reserve   1000 size of stack commit   100000 size of heap reserve   1000 size of heap commit   0 loader flags   10 number of directories   14B000 [ 2E86] RVA [size] of Export Directory   14E000 [ 1CB0] RVA [size] of Import Directory   0 [ 0] RVA [size] of Resource Directory   0 [ 0] RVA [size] of Exception Directory   0 [ 0] RVA [size] of Certificates Directory   152000 [ D6C0] RVA [size] of Base Relocation Directory   0 [ 0] RVA [size] of Debug Directory   0 [ 0] RVA [size] of Architecture Directory   0 [ 0] RVA [size] of Global Pointer Directory   151000 [ 18] RVA [size] of Thread Storage Directory   0 [ 0] RVA [size] of Load Configuration Directory   0 [ 0] RVA [size] of Bound Import Directory   14E4FC [ 45C] RVA [size] of Import Address Table Directory   0 [ 0] RVA [size] of Delay Import Directory   0 [ 0] RVA [size] of COM Descriptor Directory   0 [ 0] RVA [size] of Reserved Directory

SECTION HEADER #1   .text name   11B244 virtual size   1000 virtual address (00401000 to 0051C243)   11B400 size of raw data   400 file pointer to raw data (00000400 to 0011B7FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 60500060 flags   Code   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Execute Read

SECTION HEADER #2   .data name   E04 virtual size   11D000 virtual address (0051D000 to 0051DE03)   1000 size of raw data   11B800 file pointer to raw data (0011B800 to 0011C7FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0500040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #3   .rdata name   2AABC virtual size   11E000 virtual address (0051E000 to 00548ABB)   2AC00 size of raw data   11C800 file pointer to raw data (0011C800 to 001473FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 40600040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Only

SECTION HEADER #4   .bss name   1AC0 virtual size   149000 virtual address (00549000 to 0054AABF)   0 size of raw data   0 file pointer to raw data   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0600080 flags   Uninitialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #5   .edata name   2E86 virtual size   14B000 virtual address (0054B000 to 0054DE85)   3000 size of raw data   147400 file pointer to raw data (00147400 to 0014A3FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 40300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Only

SECTION HEADER #6   .idata name   1CB0 virtual size   14E000 virtual address (0054E000 to 0054FCAF)   1E00 size of raw data   14A400 file pointer to raw data (0014A400 to 0014C1FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #7   .CRT name   34 virtual size   150000 virtual address (00550000 to 00550033)   200 size of raw data   14C200 file pointer to raw data (0014C200 to 0014C3FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #8   .tls name   20 virtual size   151000 virtual address (00551000 to 0055101F)   200 size of raw data   14C400 file pointer to raw data (0014C400 to 0014C5FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #9   .reloc name   D6C0 virtual size   152000 virtual address (00552000 to 0055F6BF)   D800 size of raw data   14C600 file pointer to raw data (0014C600 to 00159DFF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 42300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Discardable   Read Only

  Summary

  1000 .CRT   2000 .bss   1000 .data   3000 .edata   2000 .idata   2B000 .rdata   E000 .reloc   11C000 .text   1000 .tls

[p5pRT]

From @bulk88

Microsoft (R) COFF/PE Dumper Version 7.10.6030 Copyright (C) Microsoft Corporation. All rights reserved.

Dump of file miniperl.exe

PE signature found

File Type​: EXECUTABLE IMAGE

FILE HEADER VALUES   14C machine (x86)   9 number of sections   54A8D545 time date stamp Sun Jan 04 00​:53​:09 2015   0 file pointer to symbol table   0 number of symbols   E0 size of optional header   30E characteristics   Executable   Line numbers stripped   Symbols stripped   32 bit word machine   Debug information stripped

OPTIONAL HEADER VALUES   10B magic # (PE32)   2.22 linker version   11B600 size of code   159C00 size of initialized data   1C00 size of uninitialized data   14E0 entry point (004014E0)   1000 base of code   11D000 base of data   400000 image base (00400000 to 0055FFFF)   1000 section alignment   200 file alignment   4.00 operating system version   1.00 image version   4.00 subsystem version   0 Win32 version   160000 size of image   400 size of headers   162262 checksum   3 subsystem (Windows CUI)   0 DLL characteristics   200000 size of stack reserve   1000 size of stack commit   100000 size of heap reserve   1000 size of heap commit   0 loader flags   10 number of directories   14B000 [ 2E86] RVA [size] of Export Directory   14E000 [ 1CB0] RVA [size] of Import Directory   0 [ 0] RVA [size] of Resource Directory   0 [ 0] RVA [size] of Exception Directory   0 [ 0] RVA [size] of Certificates Directory   152000 [ D6AC] RVA [size] of Base Relocation Directory   0 [ 0] RVA [size] of Debug Directory   0 [ 0] RVA [size] of Architecture Directory   0 [ 0] RVA [size] of Global Pointer Directory   151000 [ 18] RVA [size] of Thread Storage Directory   0 [ 0] RVA [size] of Load Configuration Directory   0 [ 0] RVA [size] of Bound Import Directory   14E4FC [ 45C] RVA [size] of Import Address Table Directory   0 [ 0] RVA [size] of Delay Import Directory   0 [ 0] RVA [size] of COM Descriptor Directory   0 [ 0] RVA [size] of Reserved Directory

SECTION HEADER #1   .text name   11B4C4 virtual size   1000 virtual address (00401000 to 0051C4C3)   11B600 size of raw data   400 file pointer to raw data (00000400 to 0011B9FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 60500060 flags   Code   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Execute Read

SECTION HEADER #2   .data name   E04 virtual size   11D000 virtual address (0051D000 to 0051DE03)   1000 size of raw data   11BA00 file pointer to raw data (0011BA00 to 0011C9FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0500040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #3   .rdata name   2AADC virtual size   11E000 virtual address (0051E000 to 00548ADB)   2AC00 size of raw data   11CA00 file pointer to raw data (0011CA00 to 001475FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 40600040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Only

SECTION HEADER #4   .bss name   1AC0 virtual size   149000 virtual address (00549000 to 0054AABF)   0 size of raw data   0 file pointer to raw data   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0600080 flags   Uninitialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #5   .edata name   2E86 virtual size   14B000 virtual address (0054B000 to 0054DE85)   3000 size of raw data   147600 file pointer to raw data (00147600 to 0014A5FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 40300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Only

SECTION HEADER #6   .idata name   1CB0 virtual size   14E000 virtual address (0054E000 to 0054FCAF)   1E00 size of raw data   14A600 file pointer to raw data (0014A600 to 0014C3FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #7   .CRT name   34 virtual size   150000 virtual address (00550000 to 00550033)   200 size of raw data   14C400 file pointer to raw data (0014C400 to 0014C5FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #8   .tls name   20 virtual size   151000 virtual address (00551000 to 0055101F)   200 size of raw data   14C600 file pointer to raw data (0014C600 to 0014C7FF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers C0300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Read Write

SECTION HEADER #9   .reloc name   D6AC virtual size   152000 virtual address (00552000 to 0055F6AB)   D800 size of raw data   14C800 file pointer to raw data (0014C800 to 00159FFF)   0 file pointer to relocation table   0 file pointer to line numbers   0 number of relocations   0 number of line numbers 42300040 flags   Initialized Data   RESERVED - UNKNOWN   RESERVED - UNKNOWN   Discardable   Read Only

  Summary

  1000 .CRT   2000 .bss   1000 .data   3000 .edata   2000 .idata   2B000 .rdata   E000 .reloc   11C000 .text   1000 .tls

[p5pRT]

From [Unknown Contact. See original ticket]

On Sat Jan 03 16​:38​:30 2015\, sprout wrote​:

On Tue Dec 30 06​:33​:30 2014\, bulk88 wrote​:

This is a bug report for perl from bulk88@​hotmail.com\, generated with the help of perlbug 1.40 running under perl 5.21.7.

----------------------------------------------------------------- [Please describe your issue here]

See attached patch.

I dont feel comfortable about patches that make the code harder to read and make things more efficient only for one compiler. With clang I see an increase in the binary size after your patch is applied.

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 clang version 3.5.0 (217039) Target​: i686-pc-windows-gnu Thread model​: posix

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​: Idx Name Size VMA LMA File off Algn   0 .text 0011b244 00401000 00401000 00000400 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE\, DATA   1 .data 00000e04 0051d000 0051d000 0011b800 2**4   CONTENTS\, ALLOC\, LOAD\, DATA   2 .rdata 0002aabc 0051e000 0051e000 0011c800 2**5   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   3 .bss 00001ac0 00549000 00549000 00000000 2**5   ALLOC   4 .edata 00002e86 0054b000 0054b000 00147400 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   5 .idata 00001cb0 0054e000 0054e000 0014a400 2**2   CONTENTS\, ALLOC\, LOAD\, DATA   6 .CRT 00000034 00550000 00550000 0014c200 2**2   CONTENTS\, ALLOC\, LOAD\, DATA   7 .tls 00000020 00551000 00551000 0014c400 2**2   CONTENTS\, ALLOC\, LOAD\, DATA   8 .reloc 0000d6c0 00552000 00552000 0014c600 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA

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​: Idx Name Size VMA LMA File off Algn   0 .interp 0000001c 0000000000400238 0000000000400238 00000238 2**0   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   1 .note.ABI-tag 00000020 0000000000400254 0000000000400254 00000254 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   2 .note.gnu.build-id 00000024 0000000000400274 0000000000400274 00000274 2 **2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   3 .gnu.hash 00000040 0000000000400298 0000000000400298 00000298 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   4 .dynsym 00001620 00000000004002d8 00000000004002d8 000002d8 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   5 .dynstr 0000082c 00000000004018f8 00000000004018f8 000018f8 2**0   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   6 .gnu.version 000001d8 0000000000402124 0000000000402124 00002124 2**1   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   7 .gnu.version_r 000000b0 0000000000402300 0000000000402300 00002300 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   8 .rela.dyn 00000078 00000000004023b0 00000000004023b0 000023b0 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA   9 .rela.plt 00001518 0000000000402428 0000000000402428 00002428 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 10 .init 0000001a 0000000000403940 0000000000403940 00003940 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 11 .plt 00000e20 0000000000403960 0000000000403960 00003960 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 12 .text 001101c4 0000000000404780 0000000000404780 00004780 2**4   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 13 .fini 00000009 0000000000514944 0000000000514944 00114944 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, CODE 14 .rodata 0003e55f 0000000000514960 0000000000514960 00114960 2**5   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 15 .eh_frame_hdr 00003cb4 0000000000552ec0 0000000000552ec0 00152ec0 2**2   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 16 .eh_frame 0001865c 0000000000556b78 0000000000556b78 00156b78 2**3   CONTENTS\, ALLOC\, LOAD\, READONLY\, DATA 17 .init_array 00000008 000000000076fdc0 000000000076fdc0 0016fdc0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 18 .fini_array 00000008 000000000076fdc8 000000000076fdc8 0016fdc8 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 19 .jcr 00000008 000000000076fdd0 000000000076fdd0 0016fdd0 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 20 .dynamic 00000220 000000000076fdd8 000000000076fdd8 0016fdd8 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 21 .got 00000008 000000000076fff8 000000000076fff8 0016fff8 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 22 .got.plt 00000720 0000000000770000 0000000000770000 00170000 2**3   CONTENTS\, ALLOC\, LOAD\, DATA 23 .data 000028c0 0000000000770720 0000000000770720 00170720 2**5   CONTENTS\, ALLOC\, LOAD\, DATA 24 .bss 00000e78 0000000000772fe0 0000000000772fe0 00172fe0 2**5   ALLOC 25 .comment 0000002c 0000000000000000 0000000000000000 00172fe0 2**0   CONTENTS\, READONLY

C​:\Documents and Settings\Administrator\Desktop\linperl>

---

HPUX 32 PARISC with HP C compiler also shows a drop in machine code size. Headers attached.

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @cpansprout

On Sun Jan 04 17​:14​:16 2015\, bulk88 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.

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 -rwxr-xr-x 1 sprout staff 1756708 Jan 4 23​:25 oldminiperl

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

[p5pRT]

From @cpansprout

On Sun Jan 04 23​:31​:10 2015\, sprout wrote​:

On Sun Jan 04 17​:14​:16 2015\, bulk88 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.

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 -rwxr-xr-x 1 sprout staff 1756708 Jan 4 23​:25 oldminiperl

I am seeing two test failures with this patch​:

# Failed test 'disttest' # at t/basic.t line 238. # got​: '512' # expected​: '0' # rm -rf Big-Dummy-0.01 # "/Users/sprout/Perl/perl.git-copy/perl" -Iinc "-I../../../../../lib" "-I../../../../../lib" "-MExtUtils​::Manifest=manicopy\,maniread" \ # -e "manicopy(maniread()\,'Big-Dummy-0.01'\, 'best');" # mkdir Big-Dummy-0.01 # mkdir Big-Dummy-0.01/lib # mkdir Big-Dummy-0.01/lib/Big # mkdir Big-Dummy-0.01/Liar # mkdir Big-Dummy-0.01/Liar/lib # mkdir Big-Dummy-0.01/Liar/lib/Big # mkdir Big-Dummy-0.01/Liar/t # mkdir Big-Dummy-0.01/t # mkdir Big-Dummy-0.01/bin # Generating META.yml # Generating META.json # cd Big-Dummy-0.01 && "/Users/sprout/Perl/perl.git-copy/perl" -Iinc "-I../../../../../lib" "-I../../../../../lib" Makefile.PL "PREFIX=../dummy-install" # Current package is​: main # Generating a Unix-style Makefile # Writing Makefile for Big​::Liar # Writing MYMETA.yml and MYMETA.json # Big​::Liar's vars # INST_LIB = ../blib/lib # INST_ARCHLIB = ../blib/arch # Generating a Unix-style Makefile # Writing Makefile for Big​::Dummy # Writing MYMETA.yml and MYMETA.json # cd Big-Dummy-0.01 && make LIBPERL_A="libperl.a" LINKTYPE="dynamic" PREFIX="../dummy-install" # cp lib/Big/Dummy.pm blib/lib/Big/Dummy.pm # cp lib/Big/Liar.pm ../blib/lib/Big/Liar.pm # cp bin/program blib/script/program # "/Users/sprout/Perl/perl.git-copy/perl" "-I../../../../../../lib" "-I../../../../../../lib" -MExtUtils​::MY -e 'MY->fixin(shift)' -- blib/script/program # Manifying 1 pod document # Manifying 1 pod document # cd Big-Dummy-0.01 && make test LIBPERL_A="libperl.a" LINKTYPE="dynamic" PREFIX="../dummy-install" # PERL_DL_NONLAZY=1 "/Users/sprout/Perl/perl.git-copy/perl" "-I../../../../../../lib" "-I../../../../../../lib" "-MExtUtils​::Command​::MM" "-MTest​::Harness" "-e" "undef *Test​::Harness​::Switches; test_harness(0\, 'blib/lib'\, 'blib/arch')" t/*.t # Can't load TAP​::Formatter​::File​: Attempt to reload POSIX.pm aborted. # Compilation failed in require at ../../../../../../lib/TAP/Formatter/File.pm line 6. # BEGIN failed--compilation aborted at ../../../../../../lib/TAP/Formatter/File.pm line 6. # Compilation failed in require at (eval 9) line 2. # at ../../../../../../lib/Test/Harness.pm line 250. # make[2]​: *** [test_dynamic] Error 255 # make[1]​: *** [disttest] Error 2 ../cpan/ExtUtils-MakeMaker/t/basic.t ............................... Dubious\, test returned 6 (wstat 1536\, 0x600) Failed 6/171 subtests

# Failed test ' make test exited normally' # at t/xs.t line 51. # got​: '512' # expected​: '0' # Running Mkbootstrap for XS​::Test () # chmod 644 "Test.bs" # PERL_DL_NONLAZY=1 "/Users/sprout/Perl/perl.git-copy/perl" -w "-I../../../../lib" "-I../../../../lib" "-MExtUtils​::Command​::MM" "-MTest​::Harness" "-e" "undef *Test​::Harness​::Switches; test_harness(0\, 'blib/lib'\, 'blib/arch')" t/*.t # Can't load TAP​::Formatter​::File​: Attempt to reload POSIX.pm aborted. # Compilation failed in require at ../../../../lib/TAP/Formatter/File.pm line 6. # BEGIN failed--compilation aborted at ../../../../lib/TAP/Formatter/File.pm line 6. # Compilation failed in require at (eval 9) line 2. # at ../../../../lib/Test/Harness.pm line 250. # make[1]​: *** [test_dynamic] Error 255 # Looks like you failed 1 test of 5. ../cpan/ExtUtils-MakeMaker/t/xs.t .................................. Dubious\, test returned 1 (wstat 256\, 0x100) Failed 1/5 subtests

--

Father Chrysostomos

[p5pRT]

From @bulk88

On Sun Jan 04 23​:31​:10 2015\, sprout wrote​:

On Sun Jan 04 17​:14​:16 2015\, bulk88 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.

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 -rwxr-xr-x 1 sprout staff 1756708 Jan 4 23​:25 oldminiperl

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.

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_get_hv(pTHX_ const char *name\, I32 flags) {   GV* const gv = gv_fetchpv(name\, flags\, SVt_PVHV);

  PERL_ARGS_ASSERT_GET_HV;

  if (gv)   return GvHV(gv);   else   return (HV*)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.   if (ok)   PUSHi( (I32)PL_forkprocess );   else if (PL_forkprocess == 0) /* we are a new child */   PUSHi(0);   else   RETPUSHUNDEF;   RETURN; } as much as it did before (some instructions that PUSHi() branches and RETPUSHUNDEF shared\, got separated into duplicates\, on a RETPUSHUNDEF branch\, and the other on the PUSHi branch.

I will respond to the test failures in another post.

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

No attachments made it even though they were listed as uploaded on my reply page. Trying again.

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

fcminiperls.diff

[p5pRT]

From @bulk88

get_hv_after.PNG

[p5pRT]

From @bulk88

get_hv_before.PNG

[p5pRT]

From @bulk88

On Mon Jan 05 06​:05​:10 2015\, sprout wrote​:

I am seeing two test failures with this patch​:

# Failed test 'disttest' # at t/basic.t line 238. # got​: '512' # expected​: '0' # rm -rf Big-Dummy-0.01 # "/Users/sprout/Perl/perl.git-copy/perl" -Iinc "-I../../../../../lib" "-I../../../../../lib" "-MExtUtils​::Manifest=manicopy\,maniread" \ # -e "manicopy(maniread()\,'Big-Dummy-0.01'\, 'best');" # mkdir Big-Dummy-0.01 # mkdir Big-Dummy-0.01/lib # mkdir Big-Dummy-0.01/lib/Big # mkdir Big-Dummy-0.01/Liar # mkdir Big-Dummy-0.01/Liar/lib # mkdir Big-Dummy-0.01/Liar/lib/Big # mkdir Big-Dummy-0.01/Liar/t # mkdir Big-Dummy-0.01/t # mkdir Big-Dummy-0.01/bin # Generating META.yml # Generating META.json # cd Big-Dummy-0.01 && "/Users/sprout/Perl/perl.git-copy/perl" -Iinc "-I../../../../../lib" "-I../../../../../lib" Makefile.PL "PREFIX=../dummy-install" # Current package is​: main # Generating a Unix-style Makefile # Writing Makefile for Big​::Liar # Writing MYMETA.yml and MYMETA.json # Big​::Liar's vars # INST_LIB = ../blib/lib # INST_ARCHLIB = ../blib/arch # Generating a Unix-style Makefile # Writing Makefile for Big​::Dummy # Writing MYMETA.yml and MYMETA.json # cd Big-Dummy-0.01 && make LIBPERL_A="libperl.a" LINKTYPE="dynamic" PREFIX="../dummy-install" # cp lib/Big/Dummy.pm blib/lib/Big/Dummy.pm # cp lib/Big/Liar.pm ../blib/lib/Big/Liar.pm # cp bin/program blib/script/program # "/Users/sprout/Perl/perl.git-copy/perl" "-I../../../../../../lib" "- I../../../../../../lib" -MExtUtils​::MY -e 'MY->fixin(shift)' -- blib/script/program # Manifying 1 pod document # Manifying 1 pod document # cd Big-Dummy-0.01 && make test LIBPERL_A="libperl.a" LINKTYPE="dynamic" PREFIX="../dummy-install" # PERL_DL_NONLAZY=1 "/Users/sprout/Perl/perl.git-copy/perl" "- I../../../../../../lib" "-I../../../../../../lib" "- MExtUtils​::Command​::MM" "-MTest​::Harness" "-e" "undef *Test​::Harness​::Switches; test_harness(0\, 'blib/lib'\, 'blib/arch')" t/*.t # Can't load TAP​::Formatter​::File​: Attempt to reload POSIX.pm aborted. # Compilation failed in require at ../../../../../../lib/TAP/Formatter/File.pm line 6. # BEGIN failed--compilation aborted at ../../../../../../lib/TAP/Formatter/File.pm line 6. # Compilation failed in require at (eval 9) line 2. # at ../../../../../../lib/Test/Harness.pm line 250. # make[2]​: *** [test_dynamic] Error 255 # make[1]​: *** [disttest] Error 2 ../cpan/ExtUtils-MakeMaker/t/basic.t ............................... Dubious\, test returned 6 (wstat 1536\, 0x600) Failed 6/171 subtests

# Failed test ' make test exited normally' # at t/xs.t line 51. # got​: '512' # expected​: '0' # Running Mkbootstrap for XS​::Test () # chmod 644 "Test.bs" # PERL_DL_NONLAZY=1 "/Users/sprout/Perl/perl.git-copy/perl" -w "- I../../../../lib" "-I../../../../lib" "-MExtUtils​::Command​::MM" "- MTest​::Harness" "-e" "undef *Test​::Harness​::Switches; test_harness(0\, 'blib/lib'\, 'blib/arch')" t/*.t # Can't load TAP​::Formatter​::File​: Attempt to reload POSIX.pm aborted. # Compilation failed in require at ../../../../lib/TAP/Formatter/File.pm line 6. # BEGIN failed--compilation aborted at ../../../../lib/TAP/Formatter/File.pm line 6. # Compilation failed in require at (eval 9) line 2. # at ../../../../lib/Test/Harness.pm line 250. # make[1]​: *** [test_dynamic] Error 255 # Looks like you failed 1 test of 5. ../cpan/ExtUtils-MakeMaker/t/xs.t .................................. Dubious\, test returned 1 (wstat 256\, 0x100) Failed 1/5 subtests

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_save_scalar(pTHX_ GV *gv) {   SV ** const sptr = &GvSVn(gv);

  PERL_ARGS_ASSERT_SAVE_SCALAR;

  if (UNLIKELY(SvGMAGICAL(*sptr))) { \<\<\<\<\<\<\<\<\<\<\< CRASH   PL_localizing = 1;   (void)mg_get(*sptr);   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 */ }

  perl521.dll!Perl_save_scalar(interpreter * my_perl=0x00366014\, gv * gv=0x00368cb4) Line 223 + 0xf C   perl521.dll!Perl_pp_gvsv(interpreter * my_perl=0x00366014) Line 63 + 0x18 C   perl521.dll!Perl_runops_standard(interpreter * my_perl=0x00366014) Line 41 + 0x4 C   perl521.dll!Perl_call_sv(interpreter * my_perl=0x00366014\, sv * sv=0x00a5453c\, volatile long flags=2) Line 2717 + 0x20 C   perl521.dll!Perl__core_swash_init(interpreter * my_perl=0x003660b8\, const char * pkg=0x280fa754\, const char * name=0x00a386b4\, sv * listsv=0x003660b8\, long minbits=1\, long none=0\, sv * invlist=0x00000000\, unsigned char * const flags_p=0x0012ef6f) Line 2465 + 0x2a C   perl521.dll!S_regclass(interpreter * my_perl=0x00000000\, RExC_state_t * pRExC_state=0x00000000\, long * flagp=0x00000018\, unsigned long depth=1240736\, const char stop_at_1='€'\, char allow_multi_folds=''\, const char silence_non_portable='\<'\, sv * * ret_invlist=0x00000002) Line 14081 + 0x1f C   perl521.dll!S_regatom(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x0012f4cc\, long * flagp=0x0012f0c8\, unsigned long depth=8) Line 11896 + 0x1a C   perl521.dll!S_regpiece(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x00a7fd94\, long * flagp=0x0012f100\, unsigned long depth=7) Line 10798 + 0x1a C   perl521.dll!S_regbranch(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x00000612\, long * flagp=0x00a7fd94\, long first=1\, unsigned long depth=6) Line 10724 + 0x13 C   perl521.dll!S_reg(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x00000001\, long paren=2\, long * flagp=0x0012f21c\, unsigned long depth=5) Line 10474 + 0x14 C   perl521.dll!S_regatom(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x0012f4cc\, long * flagp=0x0012f288\, unsigned long depth=4) Line 11678 + 0x14 C   perl521.dll!S_regpiece(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x00a7fd94\, long * flagp=0x0012f2c0\, unsigned long depth=3) Line 10798 + 0x1a C   perl521.dll!S_regbranch(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x00000612\, long * flagp=0x00a7fd94\, long first=1\, unsigned long depth=2) Line 10724 + 0x13 C   perl521.dll!S_reg(interpreter * my_perl=0x00366014\, RExC_state_t * pRExC_state=0x00000000\, long paren=0\, long * flagp=0x0012f5b4\, unsigned long depth=1) Line 10474 + 0x14 C   perl521.dll!Perl_re_op_compile(interpreter * my_perl=0x00000000\, sv * * const patternp=0x00000000\, int pat_count=0\, op * expr=0x00000018\, const regexp_engine * eng=0x0012eea0\, p5rx * old_re=0x280b5680\, char * is_bare_re=0x00366014\, unsigned long orig_rx_flags=10831164\, unsigned long pm_flags=2) Line 6869 + 0x17 C   perl521.dll!Perl_pmruntime(interpreter * my_perl=0x00000612\, op * o=0x00a380bc\, op * expr=0x00a7fd94\, char isreg='
'\, long floor=0) Line 5637 + 0x1d C   perl521.dll!Perl_yyparse(interpreter * my_perl=0x00366014\, int gramtype=10715324) Line 1001 C   perl521.dll!S_doeval(interpreter * my_perl=0x00000612\, int gimme=2\, cv * outside=0x00a7fd94\, unsigned long seq=3604348\, hv * hh=0x00000000) Line 3483 C   perl521.dll!Perl_pp_require(interpreter * my_perl=0x00906fdc) Line 4143 + 0x15 C   perl521.dll!Perl_runops_standard(interpreter * my_perl=0x00366014) Line 41 + 0x4 C   perl521.dll!Perl_call_sv(interpreter * my_perl=0x00366014\, sv * sv=0x00a5453c\, volatile long flags=2) Line 2732 + 0xc C   perl521.dll!Perl_call_list(interpreter * my_perl=0x00366014\, long oldscope=9\, av * paramList=0x0090436c) Line 4839 C   perl521.dll!S_process_special_blocks(interpreter * my_perl=0x00070023\, long floor=154\, const char * const fullname=0x00906540\, gv * const gv=0x009d019c\, cv * const cv=0x009d029c) Line 8943 C   perl521.dll!Perl_newATTRSUB_x(interpreter * my_perl=0x00366014\, long floor=154\, op * o=0x0090a08c\, op * proto=0x00000000\, void * attrs=0x2802dc95\, op * block=0x0090a06c\, char o_is_gv=0) Line 8871 + 0x11 C   perl521.dll!Perl_utilize(interpreter * my_perl=0x00a7fd94\, int aver=1\, long floor=154\, op * version=0x00000000\, op * idop=0x00909ed0\, op * arg=0x00909aec) Line 6101 + 0x7b C   perl521.dll!Perl_yyparse(interpreter * my_perl=0x00366014\, int gramtype=1) Line 313 C   perl521.dll!S_doeval(interpreter * my_perl=0x00000612\, int gimme=2\, cv * outside=0x00a7fd94\, unsigned long seq=3604348\, hv * hh=0x00000000) Line 3483 C   perl521.dll!Perl_pp_require(interpreter * my_perl=0x00903f94) Line 4143 + 0x15 C   perl521.dll!Perl_runops_standard(interpreter * my_perl=0x00366014) Line 41 + 0x4 C   perl521.dll!Perl_call_sv(interpreter * my_perl=0x00366014\, sv * sv=0x00a5453c\, volatile long flags=2) Line 2732 + 0xc C   perl521.dll!Perl_call_list(interpreter * my_perl=0x00366014\, long oldscope=2\, av * paramList=0x009042bc) Line 4839 C   perl521.dll!S_process_special_blocks(interpreter * my_perl=0x00070023\, long floor=39\, const char * const fullname=0x00906540\, gv * const gv=0x009042cc\, cv * const cv=0x009048ac) Line 8943 C   perl521.dll!Perl_newATTRSUB_x(interpreter * my_perl=0x00366014\, long floor=39\, op * o=0x00909778\, op * proto=0x00000000\, void * attrs=0x2802dc95\, op * block=0x00909758\, char o_is_gv=0) Line 8871 + 0x11 C   perl521.dll!Perl_utilize(interpreter * my_perl=0x00a7fd94\, int aver=1\, long floor=39\, op * version=0x00000000\, op * idop=0x00906028\, op * arg=0x009061c8) Line 6101 + 0x7b C   perl521.dll!Perl_yyparse(interpreter * my_perl=0x00366014\, int gramtype=1) Line 313 C   perl521.dll!S_parse_body(interpreter * my_perl=0x00a7fd94\, char * * env=0x00365218\, void (interpreter *)* xsinit=0x280bbccd) Line 2273 + 0xd C   perl521.dll!perl_parse(interpreter * my_perl=0x00366014\, void (interpreter *)* xsinit=0x280bbccd\, int argc=4\, char * * argv=0x00362c70\, char * * env=0x00365218) Line 1608 C   perl521.dll!RunPerl(int argc=4\, char * * argv=0x01362c70\, char * * env=0x00363108) Line 251 + 0x10 C   perl.exe!mainCRTStartup() Line 398 + 0xe C   kernel32.dll!7c817077()

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.

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @cpansprout

On Mon Jan 05 18​:48​:58 2015\, bulk88 wrote​:

Are these related to -DPERL_CREATE_GVSV (AKA no PERL_DONT_CREATE_GVSV ) on your build setup?

No.

$ uname -a Darwin Pint.local 12.5.0 Darwin Kernel Version 12.5.0​: Sun Sep 29 13​:33​:47 PDT 2013; root​:xnu-2050.48.12~1/RELEASE_X86_64 x86_64 $ cc -v Apple LLVM version 4.2 (clang-425.0.27) (based on LLVM 3.2svn) Target​: x86_64-apple-darwin12.5.0 Thread model​: posix $ ./perl -Ilib -V​:config_args config_args='-de -Duseithreads -Dusedevel -Accflags=-DPERL_BOOL_AS_CHAR -Accflags=-DPERL_GLOBAL_STRUCT';

If I revert this gv optimization patch\, -DPERL_CREATE_GVSV still SEGVs on me in re/fold_grind.t

Is it perhaps time to retire that build option?

--

Father Chrysostomos

[p5pRT]

From @cpansprout

On Mon Jan 05 21​:38​:57 2015\, sprout wrote​:

On Mon Jan 05 18​:48​:58 2015\, bulk88 wrote​:

Are these related to -DPERL_CREATE_GVSV (AKA no PERL_DONT_CREATE_GVSV ) on your build setup?

No.

$ uname -a Darwin Pint.local 12.5.0 Darwin Kernel Version 12.5.0​: Sun Sep 29 13​:33​:47 PDT 2013; root​:xnu-2050.48.12~1/RELEASE_X86_64 x86_64 $ cc -v Apple LLVM version 4.2 (clang-425.0.27) (based on LLVM 3.2svn) Target​: x86_64-apple-darwin12.5.0 Thread model​: posix $ ./perl -Ilib -V​:config_args config_args='-de -Duseithreads -Dusedevel -Accflags=- DPERL_BOOL_AS_CHAR -Accflags=-DPERL_GLOBAL_STRUCT';

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

[p5pRT]

From @cpansprout

On Mon Jan 05 21​:56​:06 2015\, sprout wrote​:

I’m not seeing the test failures any more.

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.

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

[p5pRT]

From @cpansprout

Inline Patch

```diff diff --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)) ```

[p5pRT]

From @cpansprout

On Mon Jan 05 22​:11​:14 2015\, sprout wrote​:

On Mon Jan 05 21​:56​:06 2015\, sprout wrote​:

I’m not seeing the test failures any more.

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.

I have done so now\, in commit 819b139. Thank you.

--

Father Chrysostomos

[p5pRT]

@cpansprout - Status changed from 'open' to 'resolved'

[p5pRT]

From @haarg

On Tue\, Jan 6\, 2015 at 9​:41 AM\, Father Chrysostomos via RT \perlbug\-followup@&#8203;perl\.org wrote​:

On Mon Jan 05 22​:11​:14 2015\, sprout wrote​:

On Mon Jan 05 21​:56​:06 2015\, sprout wrote​:

I’m not seeing the test failures any more.

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.

I have done so now\, in commit 819b139. Thank you.

This commit has broken Variable​::Magic

[p5pRT]

From @bulk88

Graham Knop via RT wrote​:

On Tue\, Jan 6\, 2015 at 9​:41 AM\, Father Chrysostomos via RT \perlbug\-followup@&#8203;perl\.org wrote​:

On Mon Jan 05 22​:11​:14 2015\, sprout wrote​:

On Mon Jan 05 21​:56​:06 2015\, sprout wrote​:

I’m not seeing the test failures any more. 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. I have done so now\, in commit 819b139. Thank you.

This commit has broken Variable​::Magic

Lets see how many UAs I break with this post (the html). Variable​::Magic had problems and was leaking before this commit. Probably ever since PERL_DONT_CREATE_GVSV was created. It also has very bad multi-eval problems. This doesn't leak\, but is close to it.

} else {   if (old_err) {   SvREFCNT_dec(ERRSV); /* free the SV * and leave freed SV * in GP */   ERRSV = old_err; /* assign old err SV * to GP slot\, only reason this doesn't allocate a new leaked SV * is because of the free SV * testing as non-NULL */   } }

This leaks.

STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv\, MAGIC *mg) { if (mg->mg_obj) {   ERRSV = mg->mg_obj; /* leak */   mg->mg_obj = NULL;   mg->mg_flags &= ~MGf_REFCOUNTED; }

return 0; }

  1
  2
  3 #line 278 "Magic.xs"   4
  5 static I32   6 vmg_call_sv(PerlInterpreter * my_perl\, SV * sv\, I32 flags\,   7 int (*cleanup) (PerlInterpreter * my_perl\, void *)\, void *ud)

  8 {   9
  10 I32 ret\,   11 cxix;   12 PERL_CONTEXT saved_cx;   13 SV *old_err = 0;   14
  15 if (((((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +   16 ((my_perl->Ierrgv))->sv_u.svu_gp)->  
  17 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV))) ? (char) 1 : (   char) 0))   18 &&   19 ((((((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  20 ((my_perl->Ierrgv))->sv_u.svu_gp   )->   21 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  22 GPe_SV)))->   23 sv_flags & 0x00200000)) ? (char) 1 : (char) 0)) ? Perl_sv_2bool_flags(my_perl\,

  24 ((0 +

  25 ((my_perl->   Ierrgv))->   26 sv_u.svu_gp   )->   27 gp_sv ? (0 +  
  28 ((m   y_perl->   29 I   errgv))->   30 sv_   u.svu_gp)->   31 gp_sv :

  32 Perl_gv_add_   by_type_p   33 (my_perl\,

  34 ((my_perl->   Ierrgv))\,   35 GPe_SV))\,

  36 2)

  37 : (!   38 ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  39 ((my_perl->Ierrgv))->sv_u.svu_gp   )->   40 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  41 GPe_SV)))->   42 sv_flags & (0x00000100 | 0x00000200 | 0x00000400 | 0x00000800 | 0x00001000 | 0x0000   2000 |   43 0x00004000 | 0x00008000)   44 ||   45 (((svtype)   46 ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  47 ((my_perl->Ierrgv))->sv_u.svu   _gp)->   48 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  49 GPe_SV)))->sv_flags & 0xff)) == SVt_REGEXP

  50 ||   51 ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  52 ((my_perl->Ierrgv))->sv_u.svu_   gp)->   53 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  54 GPe_SV)))->   55 sv_flags & (0xff | 0x00004000 | 0x00008000 | 0x01000000)) ==

  56 (SVt_PVLV | 0x01000000))) ? 0 : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->

  57 gp_sv ? (0 +   58 ((my_perl->Ierrgv))->sv_u.svu_gp)->

  59 gp_sv : Perl_gv_add_by_type_p(my_perl\,

  60 ((my_perl->Ierrgv   ))\,   61 GPe_SV)))->

  62 sv_flags & 0x00000400)

  63 ? (((XPV   64 *) ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  65 ((my_perl->Ierrgv))->sv_   u.svu_gp)->   66 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV))))->s   v_any)   67 &&   68 (((XPV   69 *) ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  70 ((my_perl->Ierrgv))->sv   _u.   71 svu_gp)->

  72 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  73 GPe_SV))))->sv_any)->xpv_cur > 1

  74 ||   75 (((XPV   76 *) ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  77 ((my_perl->Ierrgv))->s   v_u.   78 svu_gp)->

  79 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  80 GPe_SV))))->sv_any)->xpv_cur

  81 &&   82 *(((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  83 ((my_perl->Ierrgv))->sv_u.s   vu_gp)->   84 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  85 GPe_SV)))->sv_u.svu_pv !=

  86 '0'))) : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  87 ((my_perl->Ierrgv)   )->sv_u.   88 svu_gp)->

  89 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  90 GPe_SV)))->

  91 sv_flags & (0x00000100 | 0x00000200))   92 ? ((((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  93 ((my_perl->Ierrgv))->sv_u.sv   u_gp)->   94 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

  95 GPe_SV)))->sv_flags & 0x00000100)

  96 &&   97 ((XPVIV   98 *) (((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

  99 ((my_perl->Ierrgv))->sv_   u.svu_gp)-> 100 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

101 GPe_SV)))->sv_any)->xiv_u.xivu_iv != 0)

102 || 103 (((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

104 ((my_perl->Ierrgv))->sv_u.sv   u_gp)-> 105 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

106 GPe_SV)))->sv_flags & 0x00000200)

107 && 108 ((XPVNV 109 *) (((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

110 ((my_perl->Ierrgv))->sv_   u.svu_gp)-> 111 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

112 GPe_SV)))->sv_any)->xnv_u.xnv_nv !=

113 0.0)) : (Perl_sv_2bool_flags(my_perl\, 114 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0   + 115 (   (my_perl-> 116
  Ierrgv))-> 117 s   v_u. 118 s   vu_gp)-> 119 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->   Ierrgv))\, 120 GPe_SV))\, 0)))))) {

 
121 old_err = 122 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 123 ((my_perl->Ierrgv))->sv_u.svu_gp)->  
124 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV));

125 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 126 ((my_perl->Ierrgv))->sv_u.svu_gp)->

127 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV)) = Perl_newSV(my_per   l\, 0); 128 } 129
130 cxix = 131 (((my_perl->Icurstackinfo)->si_cxix) \< 132 ((my_perl->Icurstackinfo)->si_cxmax)) ? (((my_perl->Icurstackinfo)->si_cxix) +

133 1) : Perl_cxinc(my_perl);

134
135 saved_cx = ((my_perl->Icurstackinfo)->si_cxstack)[cxix]; 136
137 ret = Perl_call_sv(my_perl\, sv\, flags | 8); 138
139 ((my_perl->Icurstackinfo)->si_cxstack)[cxix] = saved_cx; 140
141 if (((((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 142 ((my_perl->Ierrgv))->sv_u.svu_gp)->  
143 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV))) ? (char) 1 : (   char) 0)) 144 && 145 ((((((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

146 ((my_perl->Ierrgv))->sv_u.svu_gp   )-> 147 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

148 GPe_SV)))-> 149 sv_flags & 0x00200000)) ? (char) 1 : (char) 0)) ? Perl_sv_2bool_flags(my_perl\,

150 ((0 +

151 ((my_perl->   Ierrgv))-> 152 sv_u.svu_gp   )-> 153 gp_sv ? (0 +  
154 ((m   y_perl-> 155 I   errgv))-> 156 sv_   u.svu_gp)-> 157 gp_sv :

158 Perl_gv_add_   by_type_p 159 (my_perl\,

160 ((my_perl->   Ierrgv))\, 161 GPe_SV))\,

162 2)

163 : (! 164 ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

165 ((my_perl->Ierrgv))->sv_u.svu_gp   )-> 166 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

167 GPe_SV)))-> 168 sv_flags & (0x00000100 | 0x00000200 | 0x00000400 | 0x00000800 | 0x00001000 | 0x0000   2000 | 169 0x00004000 | 0x00008000) 170 || 171 (((svtype) 172 ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

173 ((my_perl->Ierrgv))->sv_u.svu   _gp)-> 174 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

175 GPe_SV)))->sv_flags & 0xff)) == SVt_REGEXP

176 || 177 ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

178 ((my_perl->Ierrgv))->sv_u.svu_   gp)-> 179 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

180 GPe_SV)))-> 181 sv_flags & (0xff | 0x00004000 | 0x00008000 | 0x01000000)) ==

182 (SVt_PVLV | 0x01000000))) ? 0 : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->

183 gp_sv ? (0 + 184 ((my_perl->Ierrgv))->sv_u.svu_gp)->

185 gp_sv : Perl_gv_add_by_type_p(my_perl\,

186 ((my_perl->Ierrgv   ))\, 187 GPe_SV)))->

188 sv_flags & 0x00000400)

189 ? (((XPV 190 *) ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

191 ((my_perl->Ierrgv))->sv_   u.svu_gp)-> 192 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV))))->s   v_any) 193 && 194 (((XPV 195 *) ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

196 ((my_perl->Ierrgv))->sv   _u. 197 svu_gp)->

198 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

199 GPe_SV))))->sv_any)->xpv_cur > 1

200 || 201 (((XPV 202 *) ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

203 ((my_perl->Ierrgv))->s   v_u. 204 svu_gp)->

205 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

206 GPe_SV))))->sv_any)->xpv_cur

207 && 208 *(((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

209 ((my_perl->Ierrgv))->sv_u.s   vu_gp)-> 210 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

211 GPe_SV)))->sv_u.svu_pv !=

212 '0'))) : ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

213 ((my_perl->Ierrgv)   )->sv_u. 214 svu_gp)->

215 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

216 GPe_SV)))->

217 sv_flags & (0x00000100 | 0x00000200)) 218 ? ((((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

219 ((my_perl->Ierrgv))->sv_u.sv   u_gp)-> 220 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

221 GPe_SV)))->sv_flags & 0x00000100)

222 && 223 ((XPVIV 224 *) (((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

225 ((my_perl->Ierrgv))->sv_   u.svu_gp)-> 226 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

227 GPe_SV)))->sv_any)->xiv_u.xivu_iv != 0)

228 || 229 (((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

230 ((my_perl->Ierrgv))->sv_u.sv   u_gp)-> 231 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

232 GPe_SV)))->sv_flags & 0x00000200)

233 && 234 ((XPVNV 235 *) (((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

236 ((my_perl->Ierrgv))->sv_   u.svu_gp)-> 237 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

238 GPe_SV)))->sv_any)->xnv_u.xnv_nv !=

239 0.0)) : (Perl_sv_2bool_flags(my_perl\, 240 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0   + 241 (   (my_perl-> 242
  Ierrgv))-> 243 s   v_u. 244 s   vu_gp)-> 245 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->   Ierrgv))\, 246 GPe_SV))\, 0)))))) {

 
247 if (old_err) { 248 Perl_sv_setsv_flags(my_perl\, old_err\, 249 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

250 ((my_perl->Ierr   gv))->sv_u. 251 svu_gp)->

252 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_   SV))\, 253 2 | 0); 254 S_SvREFCNT_dec(my_perl\, 255 ((SV 256 *) ((void 257 *) (((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

258 ((my_perl   -> 259 Ierrgv)   )->sv_u. 260 svu_gp)->  
261 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))   \, 262 GPe_SV))))));

263 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 264 ((my_perl->Ierrgv))->sv_u.svu_gp)->  
265 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV)) = old_err;

266 } 267 if (((my_perl->Icurcop) == &(my_perl->Icompiling))) { 268 if (!(my_perl->Iin_eval)) { 269 if ((my_perl->Ierrors)) 270 Perl_sv_catsv_flags(my_perl\, (my_perl->Ierrors)\,

271 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

272 ((my_pe   rl-> 273 Ierrg   v))->sv_u. 274 svu_gp)   -> 275 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv   ))\, 276 GPe_SV))\, 2);

277 else 278 Perl_warn(my_perl\, "%s"\, 279 ((((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

280 ((my_perl->Ie   rrgv))-> 281 sv_u.svu_gp)-   > 282 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

283 GPe_SV)))->

284 sv_flags & (0x00000400 | 0x00200000)) ==

285 0x00000400) 286 ? ((((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

287 ((my_perl->I   errgv))-> 288 sv_u.svu_gp)   -> 289 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\,

290 GPe_SV)))->sv_u.

291 svu_pv) : S_sv_2pv_flags(my_perl\, 292 ((0 + 293 ((my_perl->Ierrgv))->sv_u.svu_gp)->g   p_sv ? (0 + 294
  ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierr   gv))\, GPe_SV))\, 0\, 2))); 295 do { 296 ((void) 0); 297 ((void) 0); 298 ((void) 0); 299 (((XPV 300 *) (((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

301 ((my_perl->Ierrgv))-   >sv_u. 302 svu_gp)->

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); 306 } 307
308 if ((my_perl->Iparser)) 309 ++(my_perl->Iparser)->error_count; 310
311 #line 323 "Magic.xs" 312 } else { 313 if (!cleanup || cleanup(my_perl\, ud)) 314 Perl_croak_nocontext(0); 315 } 316 } else { 317 if (old_err) { 318 S_SvREFCNT_dec(my_perl\, 319 ((SV 320 *) ((void 321 *) (((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 +

322 ((my_perl   -> 323 Ierrgv)   )->sv_u. 324 svu_gp)->  
325 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))   \, 326 GPe_SV))))));

327 ((0 + ((my_perl->Ierrgv))->sv_u.svu_gp)->gp_sv ? (0 + 328 ((my_perl->Ierrgv))->sv_u.svu_gp)->  
329 gp_sv : Perl_gv_add_by_type_p(my_perl\, ((my_perl->Ierrgv))\, GPe_SV)) = old_err;

330 } 331 } 332
333 return ret; 334 }

[p5pRT]

From @bulk88

Body was too large for import. Click here for the attachment in RT

[p5pRT]

From @bulk88

On Tue Jan 06 07​:52​:29 2015\, haarg wrote​:

On Tue\, Jan 6\, 2015 at 9​:41 AM\, Father Chrysostomos via RT \perlbug\-followup@&#8203;perl\.org wrote​:

On Mon Jan 05 22​:11​:14 2015\, sprout wrote​:

On Mon Jan 05 21​:56​:06 2015\, sprout wrote​:

I’m not seeing the test failures any more.

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.

I have done so now\, in commit 819b139. Thank you.

This commit has broken Variable​::Magic

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   Magic.dll!S_SvREFCNT_dec(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04) Line 166 + 0x12 C   Magic.dll!vmg_propagate_errsv_free(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04\, magic * mg=0x00d53084) Line 1400 + 0xf C   perl521.dll!S_mg_free_struct(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04\, magic * mg=0x00368a04) Line 541 + 0xb C   perl521.dll!Perl_mg_free(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04) Line 571 + 0xa C   perl521.dll!Perl_sv_clear(interpreter * my_perl=0x00365d54\, sv * const orig_sv=0x00368a04) Line 6615 + 0x7 C   perl521.dll!Perl_sv_free2(interpreter * my_perl=0x00365d54\, sv * const sv=0x00368a04\, const unsigned long rc=1) Line 7076 C   Magic.dll!S_SvREFCNT_dec(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04) Line 166 + 0x12 C   Magic.dll!vmg_propagate_errsv_free(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04\, magic * mg=0x00d53084) Line 1400 + 0xf C   perl521.dll!S_mg_free_struct(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04\, magic * mg=0x00368a04) Line 541 + 0xb C   perl521.dll!Perl_mg_free(interpreter * my_perl=0x00365d54\, sv * sv=0x00368a04) Line 571 + 0xa C   perl521.dll!Perl_pp_leavetry(interpreter * my_perl=0x003625b8) Line 4415 + 0x64 C   perl521.dll!Perl_runops_standard(interpreter * my_perl=0x00365d54) Line 41 + 0x4 C   perl521.dll!S_run_body(interpreter * my_perl=0x00368a04\, long oldscope=1) Line 2423 + 0xa C   perl521.dll!perl_run(interpreter * my_perl=0x00365d54) Line 2346 + 0x8 C   perl521.dll!RunPerl(int argc=4\, char * * argv=0x01362478\, char * * env=0x00362de0) Line 258 + 0x6 C   perl.exe!mainCRTStartup() Line 398 + 0xe C   kernel32.dll!_BaseProcessStart@​4() + 0x23

The code is

STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv\, MAGIC *mg) { if (mg->mg_obj) {   SV ** svp = &GvSV(PL_errgv);   //SvREFCNT_dec(*svp);   *svp = mg->mg_obj;   mg->mg_obj = NULL;   mg->mg_flags &= ~MGf_REFCOUNTED; }

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) { if (mg->mg_obj) {   SV ** svp = &GvSV(PL_errgv);   SV * old_sv = *svp;   *svp = mg->mg_obj;   mg->mg_obj = NULL;   mg->mg_flags &= ~MGf_REFCOUNTED;   SvREFCNT_dec(old_sv); }

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   perl521.dll!Perl_sv_clear(interpreter * my_perl=0x00364014\, sv * const orig_sv=0x00368b24) Line 6615 + 0x7 C   perl521.dll!Perl_sv_free2(interpreter * my_perl=0x00364014\, sv * const sv=0x00368b24\, const unsigned long rc=1) Line 7076 C   Magic.dll!S_SvREFCNT_dec(interpreter * my_perl=0x00364014\, sv * sv=0x00368b24) Line 166 + 0x12 C   Magic.dll!vmg_propagate_errsv_free(interpreter * my_perl=0x00364014\, sv * sv=0x00368b24\, magic * mg=0x00c3c8e4) Line 1405 + 0xd C   perl521.dll!S_mg_free_struct(interpreter * my_perl=0x00364014\, sv * sv=0x00368b24\, magic * mg=0x00000007) Line 541 + 0xb C   perl521.dll!Perl_mg_free(interpreter * my_perl=0x00364014\, sv * sv=0x00368b24) Line 571 + 0xa C   perl521.dll!Perl_pp_leavetry(interpreter * my_perl=0x00364b28) Line 4415 + 0x64 C   perl521.dll!Perl_runops_standard(interpreter * my_perl=0x00364014) Line 41 + 0x4 C   perl521.dll!S_run_body(interpreter * my_perl=0x00000007\, long oldscope=1) Line 2423 + 0xa C   perl521.dll!perl_run(interpreter * my_perl=0x00364014) Line 2346 + 0x8 C   perl521.dll!RunPerl(int argc=5\, char * * argv=0x01362cc8\, char * * env=0x00363130) Line 258 + 0x6 C   perl.exe!mainCRTStartup() Line 398 + 0xe C   kernel32.dll!_BaseProcessStart@​4() + 0x23

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

In 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 1293 # define DEFSV (0 + GvSVn(PL_defgv)) 1294 # define DEFSV_set(sv) \ 1295 (SvREFCNT_dec(GvSV(PL_defgv))\, GvSV(PL_defgv) = SvREFCNT_inc(sv)) 1296 # define SAVE_DEFSV \ 1297 ( \ 1298 save_gp(PL_defgv\, 0)\, \ 1299 GvINTRO_off(PL_defgv)\, \ 1300 SAVEGENERICSV(GvSV(PL_defgv))\, \ 1301 GvSV(PL_defgv) = NULL \ 1302 ) 1303 #else 1304 # define DEFSV GvSVn(PL_defgv) 1305 # define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) 1306 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 1307 #endif

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.

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @cpansprout

On Wed Jan 07 13​:44​:09 2015\, bulk88 wrote​:

In 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 1293 # define DEFSV (0 + GvSVn(PL_defgv)) 1294 # define DEFSV_set(sv) \ 1295 (SvREFCNT_dec(GvSV(PL_defgv))\, GvSV(PL_defgv) = SvREFCNT_inc(sv)) 1296 # define SAVE_DEFSV \ 1297 ( \ 1298 save_gp(PL_defgv\, 0)\, \ 1299 GvINTRO_off(PL_defgv)\, \ 1300 SAVEGENERICSV(GvSV(PL_defgv))\, \ 1301 GvSV(PL_defgv) = NULL \ 1302 ) 1303 #else 1304 # define DEFSV GvSVn(PL_defgv) 1305 # define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) 1306 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 1307 #endif

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.

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

[p5pRT]

From @ilmari

"bulk88 via RT" \perlbug\-followup@&#8203;perl\.org writes​:

In addition to ERRSV not being an lvalue anymore\, there is a report DEFSV as lvalue is causing breakage too. […] 1304 # define DEFSV GvSVn(PL_defgv) […] CPAN gets the lvalue version\, core uses only rvalue. CPAN gets the leaking version of "DEFSV_set"\, core gets non-leaking "DEFSV_set".

Except it's not an lvalue even outside core\, since perl.h has

/* We no longer default to creating a new SV for GvSV.   Do this before embed. */ #ifndef PERL_CREATE_GVSV # ifndef PERL_DONT_CREATE_GVSV # define PERL_DONT_CREATE_GVSV # endif #endif

and gv.h has

#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)) #else #define GvSVn(gv) GvSV(gv) #endif

Which is what broke e.g. DBI​:

DBI.xs​: In function ‘dbi_profile’​: DBI.xs​:2903​:23​: error​: lvalue required as left operand of assignment DBI.xs​: In function ‘XS_DBI_dispatch’​: DBI.xs​:3557​:15​: error​: lvalue required as left operand of assignment DBI.xs​:3574​:15​: error​: lvalue required as left operand of assignment

-- "The surreality of the universe tends towards a maximum" -- Skud's Law "Never formulate a law or axiom that you're not prepared to live with the consequences of." -- Skud's Meta-Law

[p5pRT]

From @andk

Also affected​:

PMQS/BerkeleyDB-0.54.tar.gz XAOC/Glib-1.307.tar.gz

Interestingly\, TIMB/DBI-1.632.tar.gz is affected but the dev version (TIMB/DBI-1.632_90.tar.gz) passes all tests. -- andreas

[p5pRT]

From @ilmari

Andreas Koenig \andreas\.koenig\.7os6VVqR@&#8203;franz\.ak\.mind\.de writes​:

Interestingly\, TIMB/DBI-1.632.tar.gz is affected but the dev version (TIMB/DBI-1.632_90.tar.gz) passes all tests.

Yes\, I fixed it​: https://github.com/perl5-dbi/dbi/pull/16 (but thinkoed the change message\, please mentaly s/GVSV/DEFSV/).

-- "I use RMS as a guide in the same way that a boat captain would use a lighthouse. It's good to know where it is\, but you generally don't want to find yourself in the same spot." - Tollef Fog Heen

[p5pRT]

From @bulk88

Since 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 n \<1> entersub[t6] sKS/TARG o \<1> rv2gv sKR/1 p \<$> const[PV "SCALAR"] s/BARE q \<2> gelem sK/2 r \<1> rv2sv sK/1 f \<1> leavesub[1 ref] K/REFC\,1

after 1e \<1> entersub[t6] KS/TARG 16 \<1> leavesub[1 ref] K/REFC\,1

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

gv_refactor.pl