Change 29982 by [EMAIL PROTECTED] on 2007/01/25 22:04:51
Integrate:
[ 28132]
Subject: [PATCH] PERL_MEM_LOG enhancements
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sat, 06 May 2006 11:21:02 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/util.c#129 integrate
Differences ...
==== //depot/maint-5.8/perl/util.c#129 (text) ====
Index: perl/util.c
--- perl/util.c#128~29976~ 2007-01-25 09:25:09.000000000 -0800
+++ perl/util.c 2007-01-25 14:04:51.000000000 -0800
@@ -4748,6 +4748,243 @@
}
#endif
+#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
+# 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;
+}
+
+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];
+# 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;
+}
+
+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];
+# 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;
+}
+
+#endif /* PERL_MEM_LOG */
+
+/*
+=for apidoc my_sprintf
+
+The C library C<sprintf>, wrapped if necessary, to ensure that it will return
+the length of the string written to the buffer. Only rare pre-ANSI systems
+need the wrapper function - usually this is a direct call to C<sprintf>.
+
+=cut
+*/
+#ifndef SPRINTF_RETURNS_STRLEN
+int
+Perl_my_sprintf(char *buffer, const char* pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ vsprintf(buffer, pat, args);
+ va_end(args);
+ return strlen(buffer);
+}
+#endif
+
void
Perl_my_clearenv(pTHX)
{
@@ -4802,76 +5039,6 @@
}
/*
-=for apidoc my_sprintf
-
-The C library C<sprintf>, wrapped if necessary, to ensure that it will return
-the length of the string written to the buffer. Only rare pre-ANSI systems
-need the wrapper function - usually this is a direct call to C<sprintf>.
-
-=cut
-*/
-#ifndef SPRINTF_RETURNS_STRLEN
-int
-Perl_my_sprintf(char *buffer, const char* pat, ...)
-{
- va_list args;
- va_start(args, pat);
- vsprintf(buffer, pat, args);
- va_end(args);
- return strlen(buffer);
-}
-#endif
-
-#ifdef PERL_MEM_LOG
-
-#define PERL_MEM_LOG_SPRINTF_BUF_SIZE 128
-
-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];
- 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, 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, const char *funcname)
-{
-#ifdef PERL_MEM_LOG_STDERR
- /* We can't use PerlIO for obvious reasons. */
- char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
- 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, strlen(buf));
-#endif
- return newalloc;
-}
-
-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];
- sprintf(buf, "free: %s:%d:%s: %"UVxf"\n",
- filename, linenumber, funcname, PTR2UV(oldalloc));
- PerlLIO_write(2, buf, strlen(buf));
-#endif
- return oldalloc;
-}
-
-#endif /* PERL_MEM_LOG */
-
-/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
End of Patch.
