Change 34567 by [EMAIL PROTECTED] on 2008/10/24 16:32:50
Subject: [PATCH] Refactor Perl_mem_log_ functions
From: Marcus Holland-Moritz <[EMAIL PROTECTED]>
Date: Wed, 22 Oct 2008 01:37:21 +0200
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#620 edit
... //depot/perl/handy.h#144 edit
... //depot/perl/util.c#656 edit
Differences ...
==== //depot/perl/embed.fnc#620 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#619~34358~ 2008-09-13 01:44:30.000000000 -0700
+++ perl/embed.fnc 2008-10-24 09:32:50.000000000 -0700
@@ -1678,6 +1678,13 @@
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)
==== //depot/perl/handy.h#144 (text) ====
Index: perl/handy.h
--- perl/handy.h#143~34456~ 2008-10-03 09:19:55.000000000 -0700
+++ perl/handy.h 2008-10-24 09:32:50.000000000 -0700
@@ -768,11 +768,21 @@
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
==== //depot/perl/util.c#656 (text) ====
Index: perl/util.c
--- perl/util.c#655~34142~ 2008-07-15 01:59:13.000000000 -0700
+++ perl/util.c 2008-10-24 09:32:50.000000000 -0700
@@ -5522,6 +5522,11 @@
* 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 @@
# 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 @@
* 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 @@
* timeval. */
# endif
{
- const STRLEN len =
- my_snprintf(buf,
- sizeof(buf),
-# ifdef PERL_MEM_LOG_TIMESTAMP
- "%10d.%06d: "
-# endif
- "alloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"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(newalloc));
+ int fd = PERL_MEM_LOG_FD;
+ STRLEN len;
+
# 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
+ if ((s = PerlEnv_getenv("PERL_MEM_LOG_FD"))) {
+ fd = atoi(s);
+ }
+# endif
+# 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
+ 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 @@
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 @@
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;
}
End of Patch.
