Refactor Perl_mem_log_ functions

Message-ID: <20081022013721.374a490c@r2d2>

p4raw-id: //depot/perl@34567

diff --git a/embed.fnc b/embed.fnc
index 8242c00..031a8e6 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1678,6 +1678,13 @@ s        |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \
 s      |bool   |vdie_common    |NULLOK const char *message|STRLEN msglen\
                                |I32 utf8|bool warn
 sr     |char * |write_no_mem
+#if defined(PERL_MEM_LOG) && defined(PERL_MEM_LOG_STDERR)
+sn     |void   |mem_log_common |enum mem_log_type mlt|const UV n|const UV typesize \
+                               |NN const char *typename \
+                               |Malloc_t oldalloc|Malloc_t newalloc \
+                               |NN const char *filename|const int linenumber \
+                               |NN const char *funcname
+#endif
 #endif
 
 #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)

diff --git a/handy.h b/handy.h
index 5303dbc..c07350d 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -768,11 +768,21 @@ Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const char *typenam
 
 Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname);
 
+# ifdef PERL_CORE
+#  ifdef PERL_MEM_LOG_STDERR
+enum mem_log_type {
+  MLT_ALLOC,
+  MLT_REALLOC,
+  MLT_FREE
+};
+#  endif
+# endif
+
 #endif
 
 #ifdef PERL_MEM_LOG
-#define MEM_LOG_ALLOC(n,t,a)     Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__,FUNCTION__)
-#define MEM_LOG_REALLOC(n,t,v,a) Perl_mem_log_realloc(n,sizeof(t),STRINGIFY(t),v,a,__FILE__,__LINE__,FUNCTION__)
+#define MEM_LOG_ALLOC(n,t,a)     (t*)Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__,FUNCTION__)
+#define MEM_LOG_REALLOC(n,t,v,a) (t*)Perl_mem_log_realloc(n,sizeof(t),STRINGIFY(t),v,a,__FILE__,__LINE__,FUNCTION__)
 #define MEM_LOG_FREE(a)          Perl_mem_log_free(a,__FILE__,__LINE__,FUNCTION__)
 #endif
 

diff --git a/util.c b/util.c
index 18d3ed3..baebeb1 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5522,6 +5522,11 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
  * 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_TIMESTAMP: if defined, a timestamp will be logged
+ * before every memory logging entry. This can be turned off at run
+ * time by setting the environment variable PERL_MEM_LOG_TIMESTAMP
+ * to zero.
  */
 
 /*
@@ -5540,15 +5545,15 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
 #  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
+static void
+S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname)
+{
 # if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD)
-    char *s;
+    const char *s;
 # endif
 # ifdef PERL_MEM_LOG_ENV
-    s = getenv("PERL_MEM_LOG");
+    s = PerlEnv_getenv("PERL_MEM_LOG");
     if (s ? atoi(s) : 0)
 # endif
     {
@@ -5556,9 +5561,16 @@ Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t
         * so we'll use stdio and low-level IO instead. */
        char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
 # ifdef PERL_MEM_LOG_TIMESTAMP
-       struct timeval tv;
 #   ifdef HAS_GETTIMEOFDAY
+#     define MEM_LOG_TIME_FMT  "%10d.%06d: "
+#     define MEM_LOG_TIME_ARG  (int)tv.tv_sec, (int)tv.tv_usec
+       struct timeval tv;
        gettimeofday(&tv, 0);
+#   else
+#     define MEM_LOG_TIME_FMT  "%10d: "
+#     define MEM_LOG_TIME_ARG  (int)when
+        Time_t when;
+        (void)time(&when);
 #   endif
        /* If there are other OS specific ways of hires time than
         * gettimeofday() (see ext/Time/HiRes), the easiest way is
@@ -5566,27 +5578,56 @@ Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t
         * timeval. */
 # endif
        {
-           const STRLEN len =
-               my_snprintf(buf,
-                           sizeof(buf),
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                           "%10d.%06d: "
+           int fd = PERL_MEM_LOG_FD;
+           STRLEN len;
+
+# ifdef PERL_MEM_LOG_ENV_FD
+           if ((s = PerlEnv_getenv("PERL_MEM_LOG_FD"))) {
+               fd = atoi(s);
+           }
 # endif
-                           "alloc: %s:%d:%s: %"IVdf" %"UVuf
-                           " %s = %"IVdf": %"UVxf"\n",
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                           (int)tv.tv_sec, (int)tv.tv_usec,
+# ifdef PERL_MEM_LOG_TIMESTAMP
+           s = PerlEnv_getenv("PERL_MEM_LOG_TIMESTAMP");
+           if (!s || atoi(s)) {
+               len = my_snprintf(buf, sizeof(buf),
+                               MEM_LOG_TIME_FMT, MEM_LOG_TIME_ARG);
+               PerlLIO_write(fd, buf, len);
+           }
 # endif
-                           filename, linenumber, funcname, n, typesize,
-                           typename, n * typesize, PTR2UV(newalloc));
-# 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
+           switch (mlt) {
+           case MLT_ALLOC:
+               len = my_snprintf(buf, sizeof(buf),
+                       "alloc: %s:%d:%s: %"IVdf" %"UVuf
+                       " %s = %"IVdf": %"UVxf"\n",
+                       filename, linenumber, funcname, n, typesize,
+                       typename, n * typesize, PTR2UV(newalloc));
+               break;
+           case MLT_REALLOC:
+               len = my_snprintf(buf, sizeof(buf),
+                       "realloc: %s:%d:%s: %"IVdf" %"UVuf
+                       " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+                       filename, linenumber, funcname, n, typesize,
+                       typename, n * typesize, PTR2UV(oldalloc),
+                       PTR2UV(newalloc));
+               break;
+           case MLT_FREE:
+               len = my_snprintf(buf, sizeof(buf),
+                       "free: %s:%d:%s: %"UVxf"\n",
+                       filename, linenumber, funcname,
+                       PTR2UV(oldalloc));
+               break;
+           }
+           PerlLIO_write(fd, buf, len);
        }
     }
+}
+#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
+    mem_log_common(MLT_ALLOC, n, typesize, typename, NULL, newalloc, filename, linenumber, funcname);
 #endif
     return newalloc;
 }
@@ -5595,44 +5636,7 @@ 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
-# 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];
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-       struct timeval tv;
-       gettimeofday(&tv, 0);
-# endif
-       {
-           const STRLEN len =
-               my_snprintf(buf,
-                           sizeof(buf),
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                           "%10d.%06d: "
-# endif
-                           "realloc: %s:%d:%s: %"IVdf" %"UVuf
-                           " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                           (int)tv.tv_sec, (int)tv.tv_usec,
-# endif
-                           filename, linenumber, funcname, n, typesize,
-                           typename, n * typesize, PTR2UV(oldalloc),
-                           PTR2UV(newalloc));
-# 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
-       }
-    }
+    mem_log_common(MLT_REALLOC, n, typesize, typename, oldalloc, newalloc, filename, linenumber, funcname);
 #endif
     return newalloc;
 }
@@ -5641,42 +5645,7 @@ Malloc_t
 Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname)
 {
 #ifdef PERL_MEM_LOG_STDERR
-# 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];
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-       struct timeval tv;
-       gettimeofday(&tv, 0);
-# endif
-       {
-           const STRLEN len =
-               my_snprintf(buf,
-                           sizeof(buf),
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                           "%10d.%06d: "
-# endif
-                           "free: %s:%d:%s: %"UVxf"\n",
-#  ifdef PERL_MEM_LOG_TIMESTAMP
-                           (int)tv.tv_sec, (int)tv.tv_usec,
-# endif
-                           filename, linenumber, funcname,
-                           PTR2UV(oldalloc));
-# 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
-       }
-    }
+    mem_log_common(MLT_FREE, 0, 0, "", oldalloc, NULL, filename, linenumber, funcname);
 #endif
     return oldalloc;
 }