#endif
/* Try to figure out __func__ or __FUNCTION__ equivalent, if any.
- * XXX Should really be a Configure probe. */
+ * XXX Should really be a Configure probe, with HAS__FUNCTION__
+ * and FUNCTION__ as results.
+ * XXX Similarly, a Configure probe for __FILE__ and __LINE__ is needed. */
#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined(__SUNPRO_C)) /* C99 or close enough. */
# define FUNCTION__ __func__
#else
* If PERL_MEM_LOG is defined, all Newx()s, Renew()s, and Safefree()s
* go through functions, which are handy for debugging breakpoints, but
* which more importantly get the immediate calling environment (file and
- * line number) passed in. This can then be used for logging the calls,
- * for which one can get a sample implementation if PERL_MEM_LOG_STDERR
- * is defined.
+ * line number, and C function name if available) passed in. This info can
+ * then be used for logging the calls, for which one gets a sample
+ * implementation if PERL_MEM_LOG_STDERR is defined.
*
* Known problems:
* - all memory allocs do not get logged, only those
If compiled with C<-DPERL_MEM_LOG>, all Newx() and Renew() allocations
and Safefree() in the Perl core go through logging functions, which is
handy for breakpoint setting. If also compiled with C<-DPERL_MEM_LOG_STDERR>,
-the allocations and frees are logged to STDERR in these logging functions,
-with the calling source code file and line number (and C function name,
-if supported by the C compiler).
+the allocations and frees are logged to STDERR (or more precisely, to the
+file descriptor 2) in these logging functions, with the calling source code
+file and line number (and C function name, if supported by the C compiler).
+
+This logging is somewhat similar to C<-Dm> but independent of C<-DDEBUGGING>,
+and at a higher level (the C<-Dm> is directly at the point of C<malloc()>,
+while the C<PERL_MEMLOG> is at the level of C<New()>>.
=head2 Profiling
#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_printf() for obvious reasons. */
- char buf[1024];
+ /* 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));
- write(2, buf, strlen(buf));
+ PerlLIO_write(2, buf, strlen(buf));
#endif
return newalloc;
}
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_printf() for obvious reasons. */
- char buf[1024];
+ /* 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));
- write(2, buf, strlen(buf));
+ PerlLIO_write(2, buf, strlen(buf));
#endif
return newalloc;
}
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_printf() for obvious reasons. */
- char buf[1024];
+ /* 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));
- write(2, buf, strlen(buf));
+ PerlLIO_write(2, buf, strlen(buf));
#endif
return oldalloc;
}