diff --git a/dist/Devel-PPPort/Changes b/dist/Devel-PPPort/Changes index bac8e31924a1..47d47fbaa042 100644 --- a/dist/Devel-PPPort/Changes +++ b/dist/Devel-PPPort/Changes @@ -1,5 +1,11 @@ Revision history for Devel-PPPort +3.74 - ? + * rework MY_CXT_INIT and MY_CXT_CLONE to not speculativly over allocate + memory for all XS module's "struct my_cxt_t" as if they are strings. + The lost memory amount, was PTRSIZE-1 bytes on the small end, and + worst case 4 x PTRSIZE, depending on logic in sv.c and defaults in Configure. + 3.68 - 2022-03-18 * fix newSVsv_flags: rename variable to fix C++ compilation issue diff --git a/dist/Devel-PPPort/PPPort_pm.PL b/dist/Devel-PPPort/PPPort_pm.PL index cf1a53d9cea0..81e419504103 100644 --- a/dist/Devel-PPPort/PPPort_pm.PL +++ b/dist/Devel-PPPort/PPPort_pm.PL @@ -756,7 +756,7 @@ package Devel::PPPort; use strict; use vars qw($VERSION $data); -$VERSION = '3.73'; +$VERSION = '3.74'; sub _init_data { diff --git a/dist/Devel-PPPort/parts/inc/MY_CXT b/dist/Devel-PPPort/parts/inc/MY_CXT index efd8ca1430ce..7b203b07b89f 100644 --- a/dist/Devel-PPPort/parts/inc/MY_CXT +++ b/dist/Devel-PPPort/parts/inc/MY_CXT @@ -65,21 +65,41 @@ _aMY_CXT sizeof(MY_CXT_KEY)-1, TRUE) #endif /* < perl5.004_68 */ +#ifdef HAS_MEMSET +__UNDEFINED__ ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) +#else +__UNDEFINED__ ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) +#endif + /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ dMY_CXT_SV; \ - my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) + my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvPVX(my_cxt_sv)) /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ - dMY_CXT_SV; \ - /* newSV() allocates one more than needed */ \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Zero(my_cxtp, 1, my_cxt_t); \ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + dMY_CXT_SV; \ + my_cxt_t *my_cxtp; \ + SvUPGRADE(my_cxt_sv, SVt_PVIV); \ + if(SvLEN(my_cxt_sv) != sizeof(my_cxt_t) { \ + if( SvTHINKFIRST(my_cxt_sv) \ + || (SvLEN(my_cxt_sv)) { \ + my_cxtp = INT2PTR(my_cxt_t*,sv_grow(my_cxt_sv,1)); \ + Safefree(my_cxtp); \ + SvCUR_set(my_cxt_sv, 0); \ + } \ + SvLEN_set(my_cxt_sv, sizeof(my_cxt_t)); \ + New(0, my_cxtp, 1, my_cxt_t); \ + SvPV_set(my_cxt_sv, (char*)my_cxtp); \ + } \ + else { \ + my_cxtp = INT2PTR(my_cxt_t*,SvPVX(my_cxt_sv)); \ + } \ + SvUV_set(my_cxt_sv, INT2PTR(UV, my_cxtp)); \ + my_cxtp = ZeroD(my_cxtp, 1, my_cxt_t); /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ @@ -98,11 +118,27 @@ _aMY_CXT #ifndef MY_CXT_CLONE /* Clones the per-interpreter data. */ -#define MY_CXT_CLONE \ - dMY_CXT_SV; \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +# define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp; \ + my_cxt_t *old_my_cxtp; \ + SvUPGRADE(my_cxt_sv, SVt_PVIV); \ + if(SvLEN(my_cxt_sv) != sizeof(my_cxt_t) { \ + if( SvTHINKFIRST(my_cxt_sv) \ + || (SvLEN(my_cxt_sv)) { \ + my_cxtp = INT2PTR(my_cxt_t*,sv_grow(my_cxt_sv,1)); \ + Safefree(my_cxtp); \ + } \ + SvLEN_set(my_cxt_sv, sizeof(my_cxt_t)); \ + New(0, my_cxtp, 1, my_cxt_t); \ + SvPV_set(my_cxt_sv, (char*)my_cxtp); \ + } \ + else { \ + my_cxtp = INT2PTR(my_cxt_t*,SvPVX(my_cxt_sv)); \ + } \ + old_my_cxtp = INT2PTR(my_cxt_t*, SvUVX(my_cxt_sv)); \ + SvUV_set(my_cxt_sv, INT2PTR(UV, my_cxtp)); \ + my_cxtp = CopyD(old_my_cxtp, my_cxtp, 1, my_cxt_t); #endif #else /* single interpreter */ diff --git a/perl.h b/perl.h index a55ea2b458c3..1f97dabd4143 100644 --- a/perl.h +++ b/perl.h @@ -8151,12 +8151,18 @@ C. /* Clones the per-interpreter data. */ # define MY_CXT_CLONE \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - void * old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \ - PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \ - Copy(old_my_cxtp, my_cxtp, 1, my_cxt_t); - - + SV *my_cxtsv_ = newSV_type(SVt_PV); \ + my_cxt_t *my_cxtp; \ + void *old_my_cxtp; \ + Newx(my_cxtp, 1, my_cxt_t); \ + SvPV_set(my_cxtsv_, (char*)my_cxtp); \ + old_my_cxtp = PL_my_cxt_list[MY_CXT_INDEX]; \ + SvLEN_set(my_cxtsv_, sizeof(my_cxt_t)); \ + PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp; \ + my_cxtp = CopyD(old_my_cxtp, my_cxtp, 1, my_cxt_t); + +/* Put CopyD() last. If its an intrinsic, and right after many overlapped + assignments, encourage the CC to drop out the CopyD() instructions. */ /* This macro must be used to access members of the my_cxt_t structure. * e.g. MY_CXT.some_data */ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 2d4881a6b6aa..428650834b11 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -87,9 +87,21 @@ There may well be none in a stable release. =over 4 -=item * - -XXX +=item minor over-allocating leak fixed in XS MY_CXT_INIT() & MY_CXT_CLONE() + +In the MY_CXT_INIT()/MY_CXT_CLONE() APIs. The final length passed to libc, +of each XS module's C, was being wastefully bumped up a +small amount through various code paths that did multiple rounds of +I buffer optimizations intended for scalar strings, onto all the +fixed-length C (static) types. Optimizations like +1 byte, +align to a natural machine type, round up speculativly for future string +concats. The over-allocations and number of bytes recovered was on small end, +1 PTRSIZE (4/8 bytes), and likely worst case was 4 PTRSIZE units (16/32 bytes). + +Macros L and L in the +interpreter and backported analogs in L were fixed to not use +char string buffer length semantics on fixed-length C types, and use C +fixed-length C types, code patterns. =back @@ -348,6 +360,9 @@ well. =item * +XXX +=item * + XXX =back diff --git a/util.c b/util.c index fa946b4153c2..ec62fb6c0ff3 100644 --- a/util.c +++ b/util.c @@ -5453,6 +5453,30 @@ off, by allocating or extending the interpreter's C array =cut */ +/* Bug history, newSV() was removed here b/c it and similar _pvX()s, add + 1, 2 or more bytes to the request size. After that, they will round up + again (1*PTRSIZE~4*PTRSIZE???). The rounding up code, is very platform/build + specific and fluid. Don't fight the rounding here by artificially + decreasing the size before passing it. Just use Newx() directly with the + fixed (in the caller) C struct size, then attach PV to the SV. + String semantics COW, UTF, OOK, and extra backup +1s for null, + dont apply to MY_CXT API. + + Since the start of the current implementation, in commit + "add Series 90 support" jhi 1/1/2007 or commit f16dd614 davem 12/29/2005 + "re-implement MY_CXT API more efficiently, and add explicit". + The SV* and PV* are leaked until per-interp global destruction or proc exit. + + It is assumed, until perl adds formal support for runtime unloading XS + modules (.so/.dll) from virtual memory, this leak is harmless. A PV in an + arena SV, guarentees the PV is freed at my_perl destroy time, on all OSes. + No dependency on "malloc()" having "pools" like Win32 Perl. + + There is no formal API, between the interp and XS mods, to free resources + obtained from my_cxt_init() before proc exit. Multiple workarounds have + been invented on CPAN but none are formal, or problems exist in edge cases. +*/ + void * Perl_my_cxt_init(pTHX_ int *indexp, size_t size) { @@ -5491,10 +5515,16 @@ Perl_my_cxt_init(pTHX_ int *indexp, size_t size) Newx(PL_my_cxt_list, PL_my_cxt_size, void *); } } - /* newSV() allocates one more than needed */ - p = (void*)SvPVX(newSV(size-1)); + + + { /* Implementation detail. Where MY_CXT gets it's memory + blocks from, is opaque/undefined. */ + SV *sv = newSV_type(SVt_PV); + Newxz(p, size, char); + SvPV_set(sv, (char*)p); + SvLEN_set(sv, size); + } PL_my_cxt_list[index] = p; - Zero(p, size, char); return p; }