This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
yet another way of debugging memory allocations
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 8b51d21..cc11915 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4958,6 +4958,52 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
 
 #endif /* PERL_GLOBAL_STRUCT */
 
+#ifdef PERL_MEM_LOG
+
+Malloc_t
+Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber)
+{
+#ifdef PERL_MEM_LOG_STDERR
+    /* We can't use PerlIO_printf() for obvious reasons. */
+    char buf[1024];
+    sprintf(buf,
+           "alloc: %s:%d: %"IVdf" %"UVuf" %s = %"IVdf": %p\n",
+           filename, linenumber,
+           n, typesize, typename, n * typesize, newalloc);
+    write(2, buf, strlen(buf));
+#endif
+    return newalloc;
+}
+
+Malloc_t
+Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber)
+{
+#ifdef PERL_MEM_LOG_STDERR
+    /* We can't use PerlIO_printf() for obvious reasons. */
+    char buf[1024];
+    sprintf(buf,
+           "realloc: %s:%d: %"IVdf" %"UVuf" %s = %"IVdf": %p -> %p\n",
+           filename, linenumber,
+           n, typesize, typename, n * typesize, oldalloc, newalloc);
+    write(2, buf, strlen(buf));
+#endif
+    return newalloc;
+}
+
+Malloc_t
+Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber)
+{
+#ifdef PERL_MEM_LOG_STDERR
+    /* We can't use PerlIO_printf() for obvious reasons. */
+    char buf[1024];
+    sprintf(buf, "free: %s:%d: %p\n", filename, linenumber, oldalloc);
+    write(2, buf, strlen(buf));
+#endif
+    return oldalloc;
+}
+
+#endif /* PERL_MEM_LOG */
+
 /*
  * Local variables:
  * c-indentation-style: bsd