From 7a28defe93b9bb8f3944648692c5d01ac486aed1 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 23 Nov 2023 14:22:03 +1100
Subject: [PATCH] grow the tmps (mortal) stack exponentially rather than
 linearly

As with the value stack and the save stack, this gives us constant
amortized growth per element.

After this patch the profiler shows the "SvPV_shrink_to_cur(sv)"
and "sv = sv_2mortal(newSV(80))" calls in do_readline as the
hotspots for the io unheated test case, using 55% of the measured
time in total.

Fixes #21654
---
 scope.c       | 8 ++++++--
 t/perf/tmps.t | 1 -
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/scope.c b/scope.c
index 9e7bef5bff39..8c8a0d065471 100644
--- a/scope.c
+++ b/scope.c
@@ -246,8 +246,12 @@ Perl_tmps_grow_p(pTHX_ SSize_t ix)
 {
     SSize_t extend_to = ix;
 #ifndef STRESS_REALLOC
-    if (ix - PL_tmps_max < 128)
-        extend_to += (PL_tmps_max < 512) ? 128 : 512;
+    SSize_t grow_size = PL_tmps_max < 512 ? 128 : PL_tmps_max / 5;
+    if (extend_to >= SSize_t_MAX - grow_size)
+        /* trigger memwrap message or fail allocation */
+        extend_to = SSize_t_MAX-1;
+    else
+        extend_to += grow_size;
 #endif
     Renew(PL_tmps_stack, extend_to + 1, SV*);
     PL_tmps_max = extend_to + 1;
diff --git a/t/perf/tmps.t b/t/perf/tmps.t
index 956643b0f3d1..ad0a6be74e60 100644
--- a/t/perf/tmps.t
+++ b/t/perf/tmps.t
@@ -48,7 +48,6 @@ my $min_small = min($basetimes{$small_size}->@*);
 my $min_large = min($basetimes{$large_size}->@*);
 my $ratio = $large_size / $small_size;
 
-our $TODO = "tmps stack grows in O(n**2) time";
 my $worst = $min_small * $ratio * 2;
 note "worst allowed $worst";
 cmp_ok($min_large, '<', $worst,