util.c: Perl_my_cxt_init() dont round up/over allocate callers' structs

-an old bug fixed long ago, its copied here, has come back.

/* newSV() allocates one more than needed */
 p = (void*)SvPVX(newSV(size-1));

I saw an XS module passed size 0x10 to my_cxt_init(), my_cxt_init()
lowered it to 0xF, and passed it to newSV(). Eventually value 0xF
reaches sv_grow_fresh(), inside sv_grow_fresh() this code,

#ifdef PERL_COPY_ON_WRITE
/* COW ... uses SvPVX(sv)[SvLEN(sv)-1] to store the COW count. ....
 allocate one more byte than asked for */

if (newlen != MEM_SIZE_MAX) newlen++;

bumped 0x10 to 0x11. The final value, that was passed to malloc() inside
MS CRT/Libc, was 0x11. On 64b, and value "0x11" (bytes long) in
arg size. 7/15/23/31 bytes have just been wasted. MY_CXT API exclusively
only gets aligned const literal ~"powers of 2" from XS modules. Risks of
off by 1 or 2, string overflow bad writes, or finding buggy XS causing
CUR==MAX unterminated buffer SVPVs, will never happen with MY_CXT.

sv_usepvn_flags() was not used in this commit, since that fnc is very
large and "heavy" (src comparison, not benchmark), compared to
newSV_type(). sv_usepvn_flags() has no newSVusepvn() analog.

Add some comments about this source code. Internally document what happens
to the new SV. Newxz() vs Zero(), Newxz() has a tiny chance being faster,
if malloc() skips a user mode memset() because its a new VM OS page, and
its gurenteed nulled by an OS kernel.

The "size -1" constant was a bug before. Its a bug now. Changing the
constant to -2, will inevitably be broken again, either with OS/CPU
specific code, or perl getting general PV/String performance tweaks.
Calling Newx() directly, fixes this permanently.

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

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
 {

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 */

perl.h

@@ -8151,12 +8151,18 @@ C<strtoul>.
 
 /* 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 */

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<struct my_cxt_t>, was being wastefully bumped up a
+small amount through various code paths that did multiple rounds of
+I<string> buffer optimizations intended for scalar strings, onto all the
+fixed-length C<struct my_cxt_t> (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<perlapi/"MY_CXT_INIT"> and L<perlapi/"MY_CXT_CLONE"> in the
+interpreter and backported analogs in L<Devel::PPPort> 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

util.c

@@ -5453,6 +5453,30 @@ off, by allocating or extending the interpreter's C<PL_my_cxt_list> 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;
 }