[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
[PATCH] Refactor Perl_mem_log_ functions
In the current implementation, the Perl_mem_log_ functions share
quite a lot of almost identical code. "almost" because the code that
ought to be identical isn't. For example, mem_log_alloc() uses
"getenv" while the other two use "PerlEnv_getenv". Or mem_log_alloc()
checks for HAS_GETTIMEOFDAY, while the others don't.
The attached patch mainly pulls the common code into a new static
function S_mem_log_common() and calls it from the other functions.
In addition, it does the following:
- Checks for HAS_GETTIMEOFDAY and provides actual fallback code to
use time() instead.
- Documents PERL_MEM_LOG_TIMESTAMP and checks for an environment
variable with the same name to disable timestamps when set to
zero. (So the old behaviour is retained.)
- Casts the return value of Perl_mem_log_(re)?alloc() to the correct
type in the MEM_LOG_ macros to avoid compiler warnings.
This patch is a prerequisite for my "SV allocation tracing" patch.
It requires a "make regen".
Marcus
--
Any given program will expand to fill available memory.
diff -ruN perl-current-orig/embed.fnc perl-current-1-mem-log/embed.fnc
--- perl-current-orig/embed.fnc 2008-09-19 23:04:04.000000000 +0200
+++ perl-current-1-mem-log/embed.fnc 2008-10-21 23:51:03.000000000 +0200
@@ -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)
diff -ruN perl-current-orig/handy.h perl-current-1-mem-log/handy.h
--- perl-current-orig/handy.h 2008-10-03 18:23:14.000000000 +0200
+++ perl-current-1-mem-log/handy.h 2008-10-21 23:53:13.000000000 +0200
@@ -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
diff -ruN perl-current-orig/util.c perl-current-1-mem-log/util.c
--- perl-current-orig/util.c 2008-09-19 23:04:21.000000000 +0200
+++ perl-current-1-mem-log/util.c 2008-10-22 00:04:50.000000000 +0200
@@ -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;
}
signature.asc
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]