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 \
+ |NN const char *typename|NULLOK const SV *sv \
|Malloc_t oldalloc|Malloc_t newalloc \
|NN const char *filename|const int linenumber \
|NN const char *funcname
enum mem_log_type {
MLT_ALLOC,
MLT_REALLOC,
- MLT_FREE
+ MLT_FREE,
+ MLT_NEW_SV,
+ MLT_DEL_SV
};
# endif
+/* those are only used in sv.c */
+void Perl_mem_log_new_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname);
+void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname);
# endif
#endif
/* Can shared object be destroyed */
PERLVARI(Idestroyhook, destroyable_proc_t, MEMBER_TO_FPTR(Perl_sv_destroyable))
+#ifdef DEBUG_LEAKING_SCALARS
+PERLVARI(Isv_serial, U32, 0) /* SV serial number, used in sv.c */
+#endif
+
/* If you are adding a U8 or U16, check to see if there are 'Space' comments
* above on where there are gaps which currently will be structure padding. */
" o Method and overloading resolution",
" c String/numeric conversions",
" P Print profiling info, source file input state",
- " m Memory allocation",
+ " m Memory and SV allocation",
" f Format processing",
" r Regular expression parsing and execution",
" x Syntax tree dump",
converts C<new_SV()> from a macro into a real function, so you can use
your favourite debugger to discover where those pesky SVs were allocated.
+If you see that you're leaking memory at runtime, but neither valgrind
+nor C<-DDEBUG_LEAKING_SCALARS> will find anything, you're probably
+leaking SVs that are still reachable and will be properly cleaned up
+during destruction of the interpreter. In such cases, using the C<-Dm>
+switch can point you to the source of the leak. If the executable was
+built with C<-DDEBUG_LEAKING_SCALARS>, C<-Dm> will output SV allocations
+in addition to memory allocations. Each SV allocation has a distinct
+serial number that will be written on creation and destruction of the SV.
+So if you're executing the leaking code in a loop, you need to look for
+SVs that are created, but never destroyed between each cycle. If such an
+SV is found, set a conditional breakpoint within C<new_SV()> and make it
+break only when C<PL_sv_serial> is equal to the serial number of the
+leaking SV. Then you will catch the interpreter in exactly the state
+where the leaking SV is allocated, which is sufficient in many cases to
+find the source of the leak.
+
+As C<-Dm> is using the PerlIO layer for output, it will by itself
+allocate quite a bunch of SVs, which are hidden to avoid recursion.
+You can bypass the PerlIO layer if you use the SV logging provided
+by C<-DPERL_MEM_LOG> instead.
+
=head2 PERL_MEM_LOG
If compiled with C<-DPERL_MEM_LOG>, all Newx() and Renew() allocations
and at a higher level (the C<-Dm> is directly at the point of C<malloc()>,
while the C<PERL_MEM_LOG> is at the level of C<New()>).
+In addition to memory allocations, SV allocations will be logged, just as
+with C<-Dm>. However, since the logging doesn't use PerlIO, all SV allocations
+are logged and no extra SV allocations are introduced by enabling the logging.
+If compiled with C<-DDEBUG_LEAKING_SCALARS>, the serial number for each SV
+allocation is also logged.
+
+You can control the logging from your environment if you compile with
+C<-DPERL_MEM_LOG_ENV>. Then you need to explicitly set C<PERL_MEM_LOG> and/or
+C<PERL_SV_LOG> to a non-zero value to enable logging of memory and/or SV
+allocations.
+
=head2 Profiling
Depending on your platform there are various of profiling Perl.
16 o Method and overloading resolution
32 c String/numeric conversions
64 P Print profiling info, source file input state
- 128 m Memory allocation
+ 128 m Memory and SV allocation
256 f Format processing
512 r Regular expression parsing and execution
1024 x Syntax tree dump
}
}
+#ifdef PERL_MEM_LOG
+# define MEM_LOG_NEW_SV(sv, file, line, func) \
+ Perl_mem_log_new_sv(sv, file, line, func)
+# define MEM_LOG_DEL_SV(sv, file, line, func) \
+ Perl_mem_log_del_sv(sv, file, line, func)
+#else
+# define MEM_LOG_NEW_SV(sv, file, line, func) NOOP
+# define MEM_LOG_DEL_SV(sv, file, line, func) NOOP
+#endif
+
#ifdef DEBUG_LEAKING_SCALARS
# define FREE_SV_DEBUG_FILE(sv) Safefree((sv)->sv_debug_file)
+# define DEBUG_SV_SERIAL(sv) \
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) del_SV\n", \
+ PTR2UV(sv), (long)(sv)->sv_debug_serial))
#else
# define FREE_SV_DEBUG_FILE(sv)
+# define DEBUG_SV_SERIAL(sv) NOOP
#endif
#ifdef PERL_POISON
#define plant_SV(p) \
STMT_START { \
const U32 old_flags = SvFLAGS(p); \
+ MEM_LOG_DEL_SV(p, __FILE__, __LINE__, FUNCTION__); \
+ DEBUG_SV_SERIAL(p); \
FREE_SV_DEBUG_FILE(p); \
POSION_SV_HEAD(p); \
SvFLAGS(p) = SVTYPEMASK; \
#ifdef DEBUG_LEAKING_SCALARS
/* provide a real function for a debugger to play with */
STATIC SV*
-S_new_SV(pTHX)
+S_new_SV(pTHX_ const char *file, int line, const char *func)
{
SV* sv;
sv->sv_debug_inpad = 0;
sv->sv_debug_cloned = 0;
sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
-
+
+ sv->sv_debug_serial = PL_sv_serial++;
+
+ MEM_LOG_NEW_SV(sv, file, line, func);
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) new_SV (from %s:%d [%s])\n",
+ PTR2UV(sv), (long)sv->sv_debug_serial, file, line, func));
+
return sv;
}
-# define new_SV(p) (p)=S_new_SV(aTHX)
+# define new_SV(p) (p)=S_new_SV(aTHX_ __FILE__, __LINE__, FUNCTION__)
#else
# define new_SV(p) \
SvANY(p) = 0; \
SvREFCNT(p) = 1; \
SvFLAGS(p) = 0; \
+ MEM_LOG_NEW_SV(p, __FILE__, __LINE__, FUNCTION__); \
} STMT_END
#endif
PERL_BITFIELD32 sv_debug_inpad:1; /* was allocated in a pad for an OP */
PERL_BITFIELD32 sv_debug_cloned:1; /* was cloned for an ithread */
PERL_BITFIELD32 sv_debug_line:16; /* the line where we were allocated */
+ U32 sv_debug_serial; /* serial number of sv allocation */
char * sv_debug_file; /* the file where we were allocated */
#endif
};
* 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.)
+ * variables PERL_MEM_LOG and PERL_SV_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
#endif
#ifdef PERL_MEM_LOG_STDERR
+
+# ifdef DEBUG_LEAKING_SCALARS
+# define SV_LOG_SERIAL_FMT " [%lu]"
+# define _SV_LOG_SERIAL_ARG(sv) , (unsigned long) (sv)->sv_debug_serial
+# else
+# define SV_LOG_SERIAL_FMT
+# define _SV_LOG_SERIAL_ARG(sv)
+# endif
+
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)
+S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const char *typename, const SV *sv, 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)
const char *s;
# endif
# ifdef PERL_MEM_LOG_ENV
- s = PerlEnv_getenv("PERL_MEM_LOG");
+ s = PerlEnv_getenv(mlt < MLT_NEW_SV ? "PERL_MEM_LOG" : "PERL_SV_LOG");
if (s ? atoi(s) : 0)
# endif
{
filename, linenumber, funcname,
PTR2UV(oldalloc));
break;
+ case MLT_NEW_SV:
+ case MLT_DEL_SV:
+ len = my_snprintf(buf, sizeof(buf),
+ "%s_SV: %s:%d:%s: %"UVxf SV_LOG_SERIAL_FMT "\n",
+ mlt == MLT_NEW_SV ? "new" : "del",
+ filename, linenumber, funcname,
+ PTR2UV(sv) _SV_LOG_SERIAL_ARG(sv));
+ break;
}
PerlLIO_write(fd, buf, len);
}
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);
+ mem_log_common(MLT_ALLOC, n, typesize, typename, NULL, NULL, newalloc, filename, linenumber, funcname);
#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
- mem_log_common(MLT_REALLOC, n, typesize, typename, oldalloc, newalloc, filename, linenumber, funcname);
+ mem_log_common(MLT_REALLOC, n, typesize, typename, NULL, oldalloc, newalloc, filename, linenumber, funcname);
#endif
return newalloc;
}
Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname)
{
#ifdef PERL_MEM_LOG_STDERR
- mem_log_common(MLT_FREE, 0, 0, "", oldalloc, NULL, filename, linenumber, funcname);
+ mem_log_common(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, filename, linenumber, funcname);
#endif
return oldalloc;
}
+void
+Perl_mem_log_new_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname)
+{
+#ifdef PERL_MEM_LOG_STDERR
+ mem_log_common(MLT_NEW_SV, 0, 0, "", sv, NULL, NULL, filename, linenumber, funcname);
+#endif
+}
+
+void
+Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname)
+{
+#ifdef PERL_MEM_LOG_STDERR
+ mem_log_common(MLT_DEL_SV, 0, 0, "", sv, NULL, NULL, filename, linenumber, funcname);
+#endif
+}
+
#endif /* PERL_MEM_LOG */
/*
projects / p5sagit/p5-mst-13.2.git / commitdiff