[PATCH] trace arena

[Eric Wong <p5p@yhbt.net>]

---
 sv.c | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

diff --git a/sv.c b/sv.c
index 9c7f3ba..a04e1dc 100644
--- a/sv.c
+++ b/sv.c
@@ -297,6 +297,44 @@ Public API:
 	++PL_sv_count;					\
     } STMT_END
 
+#define TRACE_ARENA 1
+#if TRACE_ARENA
+#include <time.h>
+#include <stdio.h>
+#include <stdlib.h>
+static time_t trace_start = -1;
+static int trace_arena_alloc;
+
+static void __attribute__((constructor)) init_arena_trace(void)
+{
+	const char *t = getenv("TRACE_ARENA");
+	if (t && *t)
+		trace_arena_alloc = 1;
+}
+
+static void trace_arena(const svtype sv_type, size_t req, size_t actual)
+{
+	struct timespec ts;
+
+	if (!trace_arena_alloc)
+		return;
+
+	(void)clock_gettime(CLOCK_MONOTONIC, &ts);
+	if (trace_start < 0) {
+		trace_start = ts.tv_sec + 10;
+	} else if (trace_start > 0) {
+		if (ts.tv_sec > trace_start)
+			trace_start = 0;
+	}
+	if (!trace_start)
+		dprintf(2, "%ld %u %zu -> %zu\n",
+			ts.tv_sec, sv_type, req, actual);
+}
+#else /* !TRACE_ARENA */
+static void trace_arena(const svtype sv_type, size_t req, size_t actual)
+{
+}
+#endif /* TRACE_ARENA */
 
 /* make some more SVs by adding another arena */
 
@@ -306,6 +344,7 @@ S_more_sv(pTHX)
     SV* sv;
     char *chunk;                /* must use New here to match call to */
     Newx(chunk,PERL_ARENA_SIZE,char);  /* Safefree() in sv_free_arenas() */
+    trace_arena(SVt_NULL, 0, PERL_ARENA_SIZE);
     sv_add_arena(chunk, PERL_ARENA_SIZE, 0);
     uproot_SV(sv);
     return sv;
@@ -1091,6 +1130,8 @@ Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
 #if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT)
     static bool done_sanity_check;
 
+    trace_arena(sv_type, arena_size, good_arena_size);
+
     /* PERL_GLOBAL_STRUCT cannot coexist with global
      * variables like done_sanity_check. */
     if (!done_sanity_check) {