In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5b306eef3a433a3b83e47635168aa11235246bae?hp=80b93e4782743bc28e58fce0763e61451830a1a7>
- Log ----------------------------------------------------------------- commit 5b306eef3a433a3b83e47635168aa11235246bae Author: Daniel Dragan <[email protected]> Date: Sun Sep 28 11:46:13 2014 -0400 for storage of NVs, use "IV in sv_u in head no-body trick" where possible This completes the goal of commit 7b2c381cf3 from 5.9.2/2005. 8 bytes are saved on arena and 8 byte double is NV builds, and usually 32 bytes on PURIFY/malloced bodies builds. (2 void *s/16 bytes for header+16 bytes minimum malloc size on typical malloc schemes). long doubles can't use this optimization. Also a hypothetical NV is 32 bit float on 32 bit pointer OS Perl build would use this optimization. 64 bit IVs on 32 bit pointer OS use this optimization. Also fixed was a bad solution from ML post "[PATCH] Free old_body in sv_upgrade, also with -DPURIFY" commit bc78644842 which made the old body freeing code in sv_upgrade not obey the body_details table. By checking allocation size instead whether there is an arena better determins if there there is a body to free, PURIFY or not. Note the upper SV types that are malloced/no arena are not upgradable so this code wont be reached due to earlier croak, so there is no danger of an arena ptr getting a free() done on it. This author doesnt have access to PURIFY. Also remove padding from body_details struct. On Win64, this struct was 16 bytes, in format of U8 U8 U8 PAD1BYTE U32 U64. On Win32 it was 12 bytes long, in format of U8 U8 U8 PAD1BYTE U32 U32. Now on compilers (such as VC) that allow 1 byte C bitfields (non-standard extension to C), the struct is always 8 bytes long. I can't imagine an arena being >4GB on 64 bit perl. M pod/perldelta.pod M sv.c M sv.h commit 0c5dc4b2b868f6c30693b10ccbcfe3b757314c06 Author: Father Chrysostomos <[email protected]> Date: Sun Sep 28 10:20:36 2014 -0700 sv.c: Remove redundant assignments After âgoto floating_pointâ c immediately gets clobbered. M sv.c ----------------------------------------------------------------------- Summary of changes: pod/perldelta.pod | 13 +++++++++++++ sv.c | 46 +++++++++++++++++++++++++++++++--------------- sv.h | 7 +++++++ 3 files changed, 51 insertions(+), 15 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 74a365b..a420c09 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -107,6 +107,12 @@ There may well be none in a stable release. C<length> is up to 20% faster for non-magical/non-tied scalars containing a string if it is a non-utf8 string or if C<use bytes;> is in scope. +=item * + +Non-magical/non-tied scalars that contain only a floating point value and are +on most Perl builds with 64 bit integers now use 8-32 less bytes of memory +depending on OS. + =back =head1 Modules and Pragmata @@ -385,6 +391,13 @@ XXX XXX Add anything here that we forgot to add, or were mistaken about, in the perldelta of a previous release. +=item * + +SVs of type SVt_NV are now bodyless when a build configure and platform allow +it, specifically C<sizeof(NV) <= sizeof(IV)>. The bodyless trick is the same one +as for IVs since 5.9.2, but for NVs, unlike IVs, is not guarenteed on all +platforms and build configurations. + =back =head1 Obituary diff --git a/sv.c b/sv.c index 67a2b6f..bb9704f 100644 --- a/sv.c +++ b/sv.c @@ -838,8 +838,8 @@ because it "knows" that two adjacent 32 bit members will be 8-byte aligned.) This is the same trick as was used for NV and IV bodies. Ironically it doesn't need to be used for NV bodies any more, because NV is now at -the start of the structure. IV bodies don't need it either, because -they are no longer allocated. +the start of the structure. IV bodies, and also in some builds NV bodies, +don't need it either, because they are no longer allocated. In turn, the new_body_* allocators call S_new_body(), which invokes new_body_inline macro, which takes a lock, and takes a body off the @@ -883,12 +883,12 @@ available in hv.c. struct body_details { U8 body_size; /* Size to allocate */ U8 copy; /* Size of structure to copy (may be shorter) */ - U8 offset; - unsigned int type : 4; /* We have space for a sanity check. */ - unsigned int cant_upgrade : 1; /* Cannot upgrade this type */ - unsigned int zero_nv : 1; /* zero the NV when upgrading from this */ - unsigned int arena : 1; /* Allocated from an arena */ - size_t arena_size; /* Size of arena to allocate */ + U8 offset; /* Size of unalloced ghost fields to first alloced field*/ + PERL_BITFIELD8 type : 4; /* We have space for a sanity check. */ + PERL_BITFIELD8 cant_upgrade : 1;/* Cannot upgrade this type */ + PERL_BITFIELD8 zero_nv : 1; /* zero the NV when upgrading from this */ + PERL_BITFIELD8 arena : 1; /* Allocated from an arena */ + U32 arena_size; /* Size of arena to allocate */ }; #define HADNV FALSE @@ -942,9 +942,15 @@ static const struct body_details bodies_by_type[] = { NOARENA /* IVS don't need an arena */, 0 }, +#if NVSIZE <= IVSIZE + { 0, sizeof(NV), + STRUCT_OFFSET(XPVNV, xnv_u), + SVt_NV, FALSE, HADNV, NOARENA, 0 }, +#else { sizeof(NV), sizeof(NV), STRUCT_OFFSET(XPVNV, xnv_u), SVt_NV, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(NV)) }, +#endif { sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur), copy_length(XPV, xpv_len) - STRUCT_OFFSET(XPV, xpv_cur), @@ -1031,8 +1037,9 @@ static const struct body_details bodies_by_type[] = { } STMT_END #ifdef PURIFY - -#define new_XNV() safemalloc(sizeof(XPVNV)) +#if !(NVSIZE <= IVSIZE) +# define new_XNV() safemalloc(sizeof(XPVNV)) +#endif #define new_XPVNV() safemalloc(sizeof(XPVNV)) #define new_XPVMG() safemalloc(sizeof(XPVMG)) @@ -1040,7 +1047,9 @@ static const struct body_details bodies_by_type[] = { #else /* !PURIFY */ -#define new_XNV() new_body_allocated(SVt_NV) +#if !(NVSIZE <= IVSIZE) +# define new_XNV() new_body_allocated(SVt_NV) +#endif #define new_XPVNV() new_body_allocated(SVt_PVNV) #define new_XPVMG() new_body_allocated(SVt_PVMG) @@ -1326,7 +1335,11 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) return; case SVt_NV: assert(old_type == SVt_NULL); +#if NVSIZE <= IVSIZE + SvANY(sv) = (XPVNV*)((char*)&(sv->sv_u.svu_nv) - STRUCT_OFFSET(XPVNV, xnv_u.xnv_nv)); +#else SvANY(sv) = new_XNV(); +#endif SvNV_set(sv, 0); return; case SVt_PVHV: @@ -1469,7 +1482,9 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) (unsigned long)new_type); } - if (old_type > SVt_IV) { + /* if this is zero, this is a body-less SVt_NULL, SVt_IV/SVt_RV, + and sometimes SVt_NV */ + if (old_type_details->body_size) { #ifdef PURIFY safefree(old_body); #else @@ -11592,7 +11607,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p case 'p': if (infnan) { - c = 'g'; goto floating_point; } if (alt || vectorize) @@ -11611,7 +11625,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p case 'd': case 'i': if (infnan) { - c = 'g'; goto floating_point; } if (vectorize) { @@ -11716,7 +11729,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p uns_integer: if (infnan) { - c = 'g'; goto floating_point; } if (vectorize) { @@ -13234,7 +13246,11 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param) } break; case SVt_NV: +#if NVSIZE <= IVSIZE + SvANY(dstr) = (XPVNV*)((char*)&(dstr->sv_u.svu_nv) - STRUCT_OFFSET(XPVNV, xnv_u.xnv_nv)); +#else SvANY(dstr) = new_XNV(); +#endif SvNV_set(dstr, SvNVX(sstr)); break; default: diff --git a/sv.h b/sv.h index 53f28e5..5e01390 100644 --- a/sv.h +++ b/sv.h @@ -191,11 +191,18 @@ typedef struct hek HEK; U32 sv_refcnt; /* how many references to us */ \ U32 sv_flags /* what we are */ +#if NVSIZE <= IVSIZE +# define _NV_BODYLESS_UNION NV svu_nv; +#else +# define _NV_BODYLESS_UNION +#endif + #define _SV_HEAD_UNION \ union { \ char* svu_pv; /* pointer to malloced string */ \ IV svu_iv; \ UV svu_uv; \ + _NV_BODYLESS_UNION \ SV* svu_rv; /* pointer to another SV */ \ struct regexp* svu_rx; \ SV** svu_array; \ -- Perl5 Master Repository
