From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sat, 6 May 2006 11:21:02 +0000 (+0300)
Subject: PERL_MEM_LOG enhancements
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=65ceff029b261068bab583ae655bb00669409fa9;p=p5sagit%2Fp5-mst-13.2.git

PERL_MEM_LOG enhancements
Message-ID: <445C5C6E.6070201@gmail.com>

p4raw-id: //depot/perl@28132
---

diff --git a/util.c b/util.c
index 873d3cb..ba531b4 100644
--- a/util.c
+++ b/util.c
@@ -5170,20 +5170,92 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
 
 #ifdef PERL_MEM_LOG
 
+/*
+ * PERL_MEM_LOG: the Perl_mem_log_..() will be compiled.
+ *
+ * PERL_MEM_LOG_ENV: if defined, during run time the environment
+ * variable PERL_MEM_LOG will be consulted, and if the integer value
+ * of that is true, the logging will happen.  (The default is to
+ * always log if the PERL_MEM_LOG define was in effect.)
+ */
+
+/*
+ * PERL_MEM_LOG_SPRINTF_BUF_SIZE: size of a (stack-allocated) buffer
+ * the Perl_mem_log_...() will use (either via sprintf or snprintf).
+ */
 #define PERL_MEM_LOG_SPRINTF_BUF_SIZE 128
 
+/*
+ * PERL_MEM_LOG_FD: the file descriptor the Perl_mem_log_...() will
+ * log to.  You can also define in compile time PERL_MEM_LOG_ENV_FD,
+ * in which case the environment variable PERL_MEM_LOG_FD will be
+ * consulted for the file descriptor number to use.
+ */
+#ifndef PERL_MEM_LOG_FD
+#  define PERL_MEM_LOG_FD 2 /* If STDERR is too boring for you. */
+#endif
+
 Malloc_t
 Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname)
 {
 #ifdef PERL_MEM_LOG_STDERR
-    /* We can't use PerlIO for obvious reasons. */
-    char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
-    const STRLEN len = my_sprintf(buf,
-				  "alloc: %s:%d:%s: %"IVdf" %"UVuf
-				  " %s = %"IVdf": %"UVxf"\n",
-				  filename, linenumber, funcname, n, typesize,
-				  typename, n * typesize, PTR2UV(newalloc));
-    PerlLIO_write(2,  buf, len);
+# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD)
+    char *s;
+# endif
+# ifdef PERL_MEM_LOG_ENV
+    s = getenv("PERL_MEM_LOG");
+    if (s ? atoi(s) : 0)
+# endif
+    {
+	/* We can't use SVs or PerlIO for obvious reasons,
+	 * so we'll use stdio and low-level IO instead. */
+	char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
+# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+	struct timeval tv;
+	gettimeofday(&tv, 0);
+	{
+	    const STRLEN len =
+#  ifdef USE_SNPRINTF
+		snprintf(buf,
+			 PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+			 "%10d.%06d: alloc: %s:%d:%s: %"IVdf" %"UVuf
+			 " %s = %"IVdf": %"UVxf"\n",
+			 (int)tv.tv_sec, (int)tv.tv_usec,
+			 filename, linenumber, funcname, n, typesize,
+			 typename, n * typesize, PTR2UV(newalloc));
+#  else
+		my_sprintf(buf,
+			   "%10d.%06d: alloc: %s:%d:%s: %"IVdf" %"UVuf
+			   " %s = %"IVdf": %"UVxf"\n",
+			   (int)tv.tv_sec, (int)tv.tv_usec,
+			   filename, linenumber, funcname, n, typesize,
+			   typename, n * typesize, PTR2UV(newalloc));
+#  endif
+# else
+	    const STRLEN len =
+#  ifdef USE_SNPRINTF
+		snprintf(buf,
+			 PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+			 "alloc: %s:%d:%s: %"IVdf" %"UVuf
+			 " %s = %"IVdf": %"UVxf"\n",
+			 filename, linenumber, funcname, n, typesize,
+			 typename, n * typesize, PTR2UV(newalloc));
+#  else
+		my_sprintf(buf,
+			   "alloc: %s:%d:%s: %"IVdf" %"UVuf
+			   " %s = %"IVdf": %"UVxf"\n",
+			   filename, linenumber, funcname, n, typesize,
+			   typename, n * typesize, PTR2UV(newalloc));
+#  endif
+# endif
+# ifdef PERL_MEM_LOG_ENV_FD
+	    s = PerlEnv_getenv("PERL_MEM_LOG_FD");
+	    PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
+# else
+	    PerlLIO_write(PERL_MEM_LOG_FD, buf, len);
+#endif
+	}
+    }
 #endif
     return newalloc;
 }
@@ -5192,14 +5264,67 @@ 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, const char *funcname)
 {
 #ifdef PERL_MEM_LOG_STDERR
-    /* We can't use PerlIO for obvious reasons. */
-    char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
-    const STRLEN len = my_sprintf(buf, "realloc: %s:%d:%s: %"IVdf" %"UVuf
-				  " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
-				  filename, linenumber, funcname, n, typesize,
-				  typename, n * typesize, PTR2UV(oldalloc),
-				  PTR2UV(newalloc));
-    PerlLIO_write(2,  buf, len);
+# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD)
+    char *s;
+# endif
+# ifdef PERL_MEM_LOG_ENV
+    s = PerlEnv_getenv("PERL_MEM_LOG");
+    if (s ? atoi(s) : 0)
+# endif
+    {
+	/* We can't use SVs or PerlIO for obvious reasons,
+	 * so we'll use stdio and low-level IO instead. */
+	char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
+# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+	struct timeval tv;
+	gettimeofday(&tv, 0);
+	{
+	    const STRLEN len =
+#  ifdef USE_SNPRINTF
+		snprintf(buf,
+			 PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+			 "%10d.%06d: realloc: %s:%d:%s: %"IVdf" %"UVuf
+			 " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+			 (int)tv.tv_sec, (int)tv.tv_usec,
+			 filename, linenumber, funcname, n, typesize,
+			 typename, n * typesize, PTR2UV(oldalloc),
+			 PTR2UV(newalloc));
+#  else
+		my_sprintf(buf,
+			   "%10d.%06d: realloc: %s:%d:%s: %"IVdf" %"UVuf
+			   " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+			   (int)tv.tv_sec, (int)tv.tv_usec,
+			   filename, linenumber, funcname, n, typesize,
+			   typename, n * typesize, PTR2UV(oldalloc),
+			   PTR2UV(newalloc));
+#  endif
+# else
+	    const STRLEN len =
+#  ifdef USE_SNPRINTF
+		snprintf(buf,
+			 PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+			 "realloc: %s:%d:%s: %"IVdf" %"UVuf
+			 " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+			 filename, linenumber, funcname, n, typesize,
+			 typename, n * typesize, PTR2UV(oldalloc),
+			 PTR2UV(newalloc));
+#  else
+		my_sprintf(buf,
+			   "realloc: %s:%d:%s: %"IVdf" %"UVuf
+			   " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+			   filename, linenumber, funcname, n, typesize,
+			   typename, n * typesize, PTR2UV(oldalloc),
+			   PTR2UV(newalloc));
+#  endif
+# endif
+# ifdef PERL_MEM_LOG_ENV_FD
+	    s = PerlEnv_getenv("PERL_MEM_LOG_FD");
+	    PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
+# else
+	    PerlLIO_write(PERL_MEM_LOG_FD, buf, len);
+# endif
+	}
+    }
 #endif
     return newalloc;
 }
@@ -5208,12 +5333,51 @@ Malloc_t
 Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname)
 {
 #ifdef PERL_MEM_LOG_STDERR
-    /* We can't use PerlIO for obvious reasons. */
-    char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
-    const STRLEN len = my_sprintf(buf, "free: %s:%d:%s: %"UVxf"\n",
-				  filename, linenumber, funcname,
-				  PTR2UV(oldalloc));
-    PerlLIO_write(2,  buf, len);
+# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD)
+    char *s;
+# endif
+# ifdef PERL_MEM_LOG_ENV
+    s = PerlEnv_getenv("PERL_MEM_LOG");
+    if (s ? atoi(s) : 0)
+# endif
+    {
+	/* We can't use SVs or PerlIO for obvious reasons,
+	 * so we'll use stdio and low-level IO instead. */
+	char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
+# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+	struct timeval tv;
+	gettimeofday(&tv, 0);
+	{
+	    const STRLEN len =
+#  ifdef USE_SNPRINTF
+		snprintf(buf,
+			 PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+			 "%10d.%06d: free: %s:%d:%s: %"UVxf"\n",
+			 (int)tv.tv_sec, (int)tv.tv_usec,
+			 filename, linenumber, funcname,
+			 PTR2UV(oldalloc));
+#  else
+		my_sprintf(buf,
+			   "%10d.%06d: free: %s:%d:%s: %"UVxf"\n",
+			   (int)tv.tv_sec, (int)tv.tv_usec,
+			   filename, linenumber, funcname,
+			   PTR2UV(oldalloc));
+#  endif
+# else
+	    const STRLEN len =
+		my_sprintf(buf,
+			   "free: %s:%d:%s: %"UVxf"\n",
+			   filename, linenumber, funcname,
+			   PTR2UV(oldalloc));
+# endif
+# ifdef PERL_MEM_LOG_ENV_FD
+	    s = PerlEnv_getenv("PERL_MEM_LOG_FD");
+	    PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
+# else
+	    PerlLIO_write(PERL_MEM_LOG_FD, buf, len);
+# endif
+	}
+    }
 #endif
     return oldalloc;
 }