Use malloc_good_size() to round up the size of requested arenas to the

size that will actually be allocated, to squeeze last few bytes into
use.

p4raw-id: //depot/perl@33390

3 files changed, 27 insertions, 6 deletions

diff --git a/hv.c b/hv.c
index a532b146c2..f85fad315a 100644
--- a/hv.c
+++ b/hv.c
@@ -40,8 +40,11 @@ STATIC void
 S_more_he(pTHX)
 {
     dVAR;
-    HE* he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT);
-    HE * const heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
+    /* We could generate this at compile time via (another) auxiliary C
+       program?  */
+    const size_t arena_size = Perl_malloc_good_size(PERL_ARENA_SIZE);
+    HE* he = (HE*) Perl_get_arena(aTHX_ arena_size, HE_SVSLOT);
+    HE * const heend = &he[arena_size / sizeof(HE) - 1];
 
     PL_body_roots[HE_SVSLOT] = he;
     while (he < heend) {
diff --git a/perl.h b/perl.h
index 736d365c21..65b3a722bc 100644
--- a/perl.h
+++ b/perl.h
@@ -4059,6 +4059,8 @@ struct perl_memory_debug_header {
 	(MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
 	 %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
 
+#else
+#  define sTHX	0
 #endif
 
 #ifdef PERL_TRACK_MEMPOOL
@@ -4078,6 +4080,13 @@ struct perl_memory_debug_header {
 #	define Perl_safesysmalloc_size(where)			\
 	    (malloc_size(((char *)(where)) - sTHX) - sTHX)
 #   endif
+#   ifdef HAS_MALLOC_GOOD_SIZE
+#	define Perl_malloc_good_size(how_much)			\
+	    (malloc_good_size((how_much) + sTHX) - sTHX)
+#   else
+/* Having this as the identity operation makes some code simpler.  */
+#	define Perl_malloc_good_size(how_much)	(how_much)
+#   endif
 #endif
 
 typedef int (CPERLscope(*runops_proc_t)) (pTHX);
diff --git a/sv.c b/sv.c
index 49dc3f5a99..1db4b92759 100644
--- a/sv.c
+++ b/sv.c
@@ -1045,6 +1045,7 @@ S_more_bodies (pTHX_ const svtype sv_type)
     const size_t body_size = bdp->body_size;
     char *start;
     const char *end;
+    const size_t arena_size = Perl_malloc_good_size(bdp->arena_size);
 #if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
     static bool done_sanity_check;
 
@@ -1062,20 +1063,28 @@ S_more_bodies (pTHX_ const svtype sv_type)
 
     assert(bdp->arena_size);
 
-    start = (char*) Perl_get_arena(aTHX_ bdp->arena_size, sv_type);
+    start = (char*) Perl_get_arena(aTHX_ arena_size, sv_type);
 
-    end = start + bdp->arena_size - body_size;
+    end = start + arena_size - 2 * body_size;
 
     /* computed count doesnt reflect the 1st slot reservation */
+#if defined(MYMALLOC) || defined(HAS_MALLOC_GOOD_SIZE)
+    DEBUG_m(PerlIO_printf(Perl_debug_log,
+			  "arena %p end %p arena-size %d (from %d) type %d "
+			  "size %d ct %d\n",
+			  (void*)start, (void*)end, (int)arena_size,
+			  (int)bdp->arena_size, sv_type, (int)body_size,
+			  (int)arena_size / (int)body_size));
+#else
     DEBUG_m(PerlIO_printf(Perl_debug_log,
 			  "arena %p end %p arena-size %d type %d size %d ct %d\n",
 			  (void*)start, (void*)end,
 			  (int)bdp->arena_size, sv_type, (int)body_size,
 			  (int)bdp->arena_size / (int)body_size));
-
+#endif
     *root = (void *)start;
 
-    while (start < end) {
+    while (start <= end) {
 	char * const next = start + body_size;
 	*(void**) start = (void *)next;
 	start = next;