From fd0854ffd71f437c5e7d44b6f60361faf0bd6d15 Mon Sep 17 00:00:00 2001 From: Dave Mitchell Date: Mon, 28 Mar 2005 21:38:44 +0000 Subject: [PATCH] expand -DDEBUG_LEAKING_SCALARS to instrument the creation of each SV p4raw-id: //depot/perl@24088 --- dump.c | 8 ++++++++ ext/Devel/Peek/t/Peek.t | 2 ++ pad.c | 4 ++++ perl.c | 12 ++++++++++-- pod/perlhack.pod | 11 +++++++---- sv.c | 46 ++++++++++++++++++++++++++++++++++++++++++++++ sv.h | 7 +++++++ 7 files changed, 84 insertions(+), 6 deletions(-) diff --git a/dump.c b/dump.c index 8143bfb..9acd3c6 100644 --- a/dump.c +++ b/dump.c @@ -1203,6 +1203,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo sv_catpv(d, ")"); s = SvPVX(d); +#ifdef DEBUG_LEAKING_SCALARS + Perl_dump_indent(aTHX_ level, file, "ALLOCATED at %s:%d %s %s%s\n", + sv->sv_debug_file ? sv->sv_debug_file : "(unknown)", + sv->sv_debug_line, + sv->sv_debug_inpad ? "for" : "by", + sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)", + sv->sv_debug_cloned ? " (cloned)" : ""); +#endif Perl_dump_indent(aTHX_ level, file, "SV = "); switch (type) { case SVt_NULL: diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index 8d7189e..ac57026 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -28,6 +28,8 @@ sub do_test { local $/; $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g; $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g; + # handle DEBUG_LEAKING_SCALARS prefix + $pattern =~ s/^(\s*)(SV =.* at )/$1ALLOCATED at .*?\n$1$2/mg; print $pattern, "\n" if $DEBUG; my $dump = ; print $dump, "\n" if $DEBUG; diff --git a/pad.c b/pad.c index 3182ac8..b0cac8d 100644 --- a/pad.c +++ b/pad.c @@ -434,7 +434,11 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n", PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval, PL_op_name[optype])); +#ifdef DEBUG_LEAKING_SCALARS + sv->sv_debug_optype = optype; + sv->sv_debug_inpad = 1; return (PADOFFSET)retval; +#endif } /* diff --git a/perl.c b/perl.c index 9d3ecf4..118c1f4 100644 --- a/perl.c +++ b/perl.c @@ -827,8 +827,16 @@ perl_destruct(pTHXx) if (SvTYPE(sv) != SVTYPEMASK) { PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p" " flags=0x08%"UVxf - " refcnt=%"UVuf pTHX__FORMAT "\n", - sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE); + " refcnt=%"UVuf pTHX__FORMAT "\n" + "\tallocated at %s:%d %s %s%s\n", + sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE, + sv->sv_debug_file ? sv->sv_debug_file : "(unknown)", + sv->sv_debug_line, + sv->sv_debug_inpad ? "for" : "by", + sv->sv_debug_optype ? + PL_op_name[sv->sv_debug_optype]: "(none)", + sv->sv_debug_cloned ? " (cloned)" : "" + ); } } } diff --git a/pod/perlhack.pod b/pod/perlhack.pod index 5e188c0..78226bd 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -2310,10 +2310,13 @@ documentation for more information. Also, spawned threads do the equivalent of setting this variable to the value 1.) If, at the end of a run you get the message I, you can -recompile with C<-DDEBUG_LEAKING_SCALARS>, which will cause -the addresses of all those leaked SVs to be dumped; it also converts -C from a macro into a real function, so you can use your -favourite debugger to discover where those pesky SVs were allocated. +recompile with C<-DDEBUG_LEAKING_SCALARS>, which will cause the addresses +of all those leaked SVs to be dumped along with details as to where each +SV was originally allocated. This information is also displayed by +Devel::Peek. Note that the extra details recorded with each SV increases +memory usage, so it shouldn't be used in production environments. It also +converts C from a macro into a real function, so you can use +your favourite debugger to discover where those pesky SVs were allocated. =head2 Profiling diff --git a/sv.c b/sv.c index ee631e5..37edaf8 100644 --- a/sv.c +++ b/sv.c @@ -165,8 +165,19 @@ Public API: * "A time to plant, and a time to uproot what was planted..." */ +#ifdef DEBUG_LEAKING_SCALARS +# ifdef NETWARE +# define FREE_SV_DEBUG_FILE(sv) PerlMemfree((sv)->sv_debug_file) +# else +# define FREE_SV_DEBUG_FILE(sv) PerlMemShared_free((sv)->sv_debug_file) +# endif +#else +# define FREE_SV_DEBUG_FILE(sv) +#endif + #define plant_SV(p) \ STMT_START { \ + FREE_SV_DEBUG_FILE(p); \ SvANY(p) = (void *)PL_sv_root; \ SvFLAGS(p) = SVTYPEMASK; \ PL_sv_root = (p); \ @@ -200,6 +211,17 @@ S_new_SV(pTHX) SvANY(sv) = 0; SvREFCNT(sv) = 1; SvFLAGS(sv) = 0; + sv->sv_debug_optype = PL_op ? PL_op->op_type : 0; + sv->sv_debug_line = (U16) ((PL_copline == NOLINE) ? + (PL_curcop ? CopLINE(PL_curcop) : 0) : PL_copline); + sv->sv_debug_inpad = 0; + sv->sv_debug_cloned = 0; +# ifdef NETWARE + sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL; +# else + sv->sv_debug_file = PL_curcop ? savesharedpv(CopFILE(PL_curcop)): NULL; +# endif + return sv; } # define new_SV(p) (p)=S_new_SV(aTHX) @@ -5822,7 +5844,14 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) SvREFCNT(sv) = 0; sv_clear(sv); assert(!SvREFCNT(sv)); +#ifdef DEBUG_LEAKING_SCALARS + sv->sv_flags = nsv->sv_flags; + sv->sv_any = nsv->sv_any; + sv->sv_refcnt = nsv->sv_refcnt; +#else StructCopy(nsv,sv,SV); +#endif + #ifdef PERL_COPY_ON_WRITE if (SvIsCOW_normal(nsv)) { /* We need to follow the pointers around the loop to make the @@ -10727,6 +10756,19 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) /* create anew and remember what it is */ new_SV(dstr); + +#ifdef DEBUG_LEAKING_SCALARS + dstr->sv_debug_optype = sstr->sv_debug_optype; + dstr->sv_debug_line = sstr->sv_debug_line; + dstr->sv_debug_inpad = sstr->sv_debug_inpad; + dstr->sv_debug_cloned = 1; +# ifdef NETWARE + dstr->sv_debug_file = savepv(sstr->sv_debug_file); +# else + dstr->sv_debug_file = savesharedpv(sstr->sv_debug_file); +# endif +#endif + ptr_table_store(PL_ptr_table, sstr, dstr); /* clone */ @@ -11540,6 +11582,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, # ifdef DEBUGGING Poison(my_perl, 1, PerlInterpreter); + PL_op = Nullop; + PL_curcop = Nullop; PL_markstack = 0; PL_scopestack = 0; PL_savestack = 0; @@ -11572,6 +11616,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, # ifdef DEBUGGING Poison(my_perl, 1, PerlInterpreter); + PL_op = Nullop; + PL_curcop = Nullop; PL_markstack = 0; PL_scopestack = 0; PL_savestack = 0; diff --git a/sv.h b/sv.h index 9fe3657..05c4449 100644 --- a/sv.h +++ b/sv.h @@ -68,6 +68,13 @@ struct STRUCT_SV { /* struct sv { */ void* sv_any; /* pointer to something */ U32 sv_refcnt; /* how many references to us */ U32 sv_flags; /* what we are */ +#ifdef DEBUG_LEAKING_SCALARS + unsigned sv_debug_optype:9; /* the type of OP that allocated us */ + unsigned sv_debug_inpad:1; /* was allocated in a pad for an OP */ + unsigned sv_debug_cloned:1; /* was cloned for an ithread */ + unsigned sv_debug_line:16; /* the line where we were allocated */ + char * sv_debug_file; /* the file where we were allocated */ +#endif }; struct gv { -- 1.8.3.1