From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on dcvr.yhbt.net X-Spam-Level: X-Spam-ASN: X-Spam-Status: No, score=-1.2 required=3.0 tests=ALL_TRUSTED,BAYES_00, T_SCC_BODY_TEXT_LINE,UNWANTED_LANGUAGE_BODY shortcircuit=no autolearn=ham autolearn_force=no version=3.4.6 Received: from localhost (dcvr.yhbt.net [127.0.0.1]) by dcvr.yhbt.net (Postfix) with ESMTP id 490551F44D for ; Sun, 3 Mar 2024 23:22:03 +0000 (UTC) From: Eric Wong To: spew@80x24.org Subject: [PATCH] trace arena Date: Sun, 3 Mar 2024 23:22:03 +0000 Message-ID: <20240303232203.1002150-1-p5p@yhbt.net> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: --- 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 +#include +#include +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) {