Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
492 lines (404 sloc) 10.4 KB
/* tools.c */
#include "tools.h"
/* Enable to do old style brute force checking too */
/* #define BRUTE_FORCE */
/* #define SANITY */
typedef struct {
int line;
} where;
static hash *var_map = NULL; /* Maps SV* to location where var was created */
static list current_free;
static list current_arenas;
static int note_init_done = 0;
static int ( *runops_old ) ( pTHX );
#ifdef BRUTE_FORCE
static hash *brute = NULL;
#endif
#define live_sv(sv) \
(SvTYPE(sv) != SVTYPEMASK && SvREFCNT(sv))
#define free_sv(sv) \
(!live_sv(sv))
#define list_hint(l) \
(!(l) ? 100 : (list_used(l) + 10))
/* Perl opcodes which trigger a memory scan */
#define interesting_op(o) \
((o) == OP_NEXTSTATE || \
(o) == OP_DBSTATE)
static void
nomem( void ) {
fprintf( stderr, "Devel::LeakTrace::Fast: Out of memory\n" );
exit( 1 );
}
static const where *
get_where( int line, const char *file ) {
static int init_done = 0;
static hash *cache = NULL;
static buffer work;
where *w;
int err;
size_t sz;
if ( !file ) {
return NULL;
}
if ( !init_done ) {
if ( err = buffer_init( &work, 256, 64 ), ERR_None != err ) {
nomem( );
}
if ( err = hash_new( 1000, &cache ), ERR_None != err ) {
nomem( );
}
init_done = 1;
}
sz = sizeof( where ) + strlen( file ) + 1;
if ( err = buffer_ensure( &work, sz ), ERR_None != err ) {
nomem( );
}
w = ( where * ) work.buf;
w->line = line;
strcpy( ( char * ) ( w + 1 ), file );
/* Already got it? */
if ( w = ( where * ) hash_get( cache, w, sz ), NULL != w ) {
return w;
}
if ( w = malloc( sz ), !w ) {
nomem( );
}
memcpy( w, work.buf, sz );
/* Add it to cache */
if ( err = hash_put( cache, w, sz, w ), ERR_None != err ) {
nomem( );
}
return w;
}
static void
new_var( SV * sv, const void *p ) {
int err;
const where *w = p;
/* fprintf(stderr, "%s, line %d: New var: %p\n", (const char *) (w + 1), w->line, sv);*/
if ( !var_map ) {
fprintf( stderr, "Oops. var_map == NULL\n" );
exit( 1 );
}
if ( err =
hash_put( var_map, &sv, sizeof( sv ), ( void * ) w ),
ERR_None != err ) {
nomem( );
}
}
static void
free_var( SV * sv, const void *p ) {
int err;
/* fprintf(stderr, "%s, line %d: Free var: %p\n", (const char *) (w + 1), w->line, sv);*/
if ( !var_map ) {
fprintf( stderr, "Oops. var_map == NULL\n" );
exit( 1 );
}
if ( err =
hash_delete_key( var_map, &sv, sizeof( sv ) ), ERR_None != err ) {
nomem( );
}
}
static void
new_arena( SV * sva, const void *p ) {
const where *w = p;
int err;
/*fprintf(stderr, "%s, line %d: New arena: %p\n", (const char *) (w + 1), w->line, sva); */
SV *sv = sva + 1;
SV *svend = &sva[SvREFCNT( sva )];
while ( sv < svend ) {
if ( live_sv( sv ) ) {
/* New variable */
new_var( sv, w );
}
else {
/* Pretend any new free SVs were already in the free list otherwise
* when we compare the new free list with the old one it'll look as
* if lots of variables that never existed have been freed.
*/
if ( err = list_append( &current_free, sv ), ERR_None != err ) {
nomem( );
}
}
++sv;
}
/*fprintf(stderr, "%s, line %d: End new arena: %p\n", (const char *) (w + 1), w->line, sva); */
}
static void
free_arena( SV * sva, const void *p ) {
const where *w = p;
fprintf( stderr, "%s, line %d: Free arena: %p\n",
( const char * ) ( w + 1 ), w->line, sva );
fprintf( stderr, "Don't know what to do when an arena is freed...\n" );
exit( 1 );
}
#ifdef SANITY
static void
in_free_only( SV * sv, const void *p ) {
fprintf( stderr, "%p is in free list but not arenas", sv );
}
static void
in_comp_only( SV * sv, const void *p ) {
fprintf( stderr, "%p is in arenas but not free list", sv );
}
/* Sanity check - compare the free list with the list of free SVs in the arenas */
static void
free_list_sane( void ) {
list real_free;
list comp_free;
int err;
SV *sva;
long diff;
/* Get the real free list */
if ( err =
list_build( &real_free, PL_sv_root, list_hint( &current_free ) ),
ERR_None != err ) {
nomem( );
}
/* Get the list of all the free SVs in all the arenas */
if ( err =
list_init( &comp_free, list_hint( &real_free ) ),
ERR_None != err ) {
nomem( );
}
for ( sva = PL_sv_arenaroot; sva; sva = ( SV * ) SvANY( sva ) ) {
SV *sv = sva + 1;
SV *svend = &sva[SvREFCNT( sva )];
while ( sv < svend ) {
if ( free_sv( sv ) ) {
if ( err = list_append( &comp_free, sv ), ERR_None != err ) {
nomem( );
}
}
++sv;
}
}
diff =
list_true_diff( &real_free, &comp_free, NULL, in_free_only,
in_comp_only );
if ( diff != 0 ) {
fprintf( stderr, "Lists have %ld differences, stopping\n", diff );
fprintf( stderr,
"%ld items in free list, %ld free items in arenas\n",
( long ) list_used( &real_free ),
( long ) list_used( &comp_free ) );
exit( 1 );
}
}
#endif
static void
note_new_vars( int line, const char *file ) {
list new_arenas;
list new_free;
int err;
const where *w;
if ( !file ) {
return;
}
#ifdef SANITY
free_list_sane( );
#endif
w = get_where( line, file );
/*fprintf(stderr, "note_new_vars(%d, \"%s\")\n", line, file); */
if ( err =
list_build( &new_arenas, PL_sv_arenaroot,
list_hint( &current_arenas ) ), ERR_None != err ) {
nomem( );
}
if ( err =
list_build( &new_free, PL_sv_root, list_hint( &current_free ) ),
ERR_None != err ) {
nomem( );
}
if ( note_init_done ) {
/* Scan the lists looking for new arenas and deleted
* free slots. A deleted free slot implies the creation of a new
* variable.
*/
list_true_diff( &current_arenas, &new_arenas, w, new_arena,
free_arena );
list_true_diff( &new_free, &current_free, w, new_var, free_var );
list_delete( &current_arenas );
list_delete( &current_free );
}
/* Roll round to new versions of lists */
current_arenas = new_arenas;
current_free = new_free;
note_init_done = 1;
}
#ifdef BRUTE_FORCE
static void
brute_force( int line, const char *file ) {
SV *sva;
hash *baby;
const where *w;
int err;
fprintf( stderr, "brute_force(%d, \"%s\")\n", line, file );
w = get_where( line, file );
if ( err = hash_new( PL_sv_count, &baby ), ERR_None != err ) {
nomem( );
}
for ( sva = PL_sv_arenaroot; sva; sva = ( SV * ) SvANY( sva ) ) {
SV *sv = sva + 1;
SV *svend = &sva[SvREFCNT( sva )];
while ( sv < svend ) {
if ( live_sv( sv ) ) {
const where *nw = w;
if ( brute ) {
const where *ow;
if ( ( ow = hash_get( brute, &sv, sizeof( sv ) ) ) ) {
nw = hash_GETNULL( ow );
}
else {
if ( w ) {
fprintf( stderr,
"%s, line %d: New var (bf): %p\n",
( const char * ) ( w + 1 ), w->line, sv );
}
}
}
if ( err = hash_put( baby, &sv, sizeof( sv ),
hash_PUTNULL( ( void * ) nw ) ),
ERR_None != err ) {
nomem( );
}
}
++sv;
}
}
hash_delete( brute );
brute = baby;
}
#define NOTE_NEW_VARS(l, f) \
do { \
note_new_vars(l, f); \
brute_force(l, f); \
} while (0);
#else
#define NOTE_NEW_VARS(l, f) \
note_new_vars(l, f)
#endif
static int
runops_leakcheck( pTHX ) {
char *lastfile = NULL;
int lastline = 0;
while ( ( PL_op = CALL_FPTR( PL_op->op_ppaddr ) ( aTHX ) ) ) {
PERL_ASYNC_CHECK( );
if ( interesting_op( PL_op->op_type ) ) {
/*fprintf(stderr, "%s, line %d\n", lastfile, lastline); */
NOTE_NEW_VARS( lastline, lastfile );
free( lastfile );
if ( lastfile = strdup( CopFILE( cCOP ) ), NULL == lastfile ) {
nomem( );
}
lastline = CopLINE( cCOP );
}
}
/*fprintf(stderr, "%s, line %d\n", lastfile, lastline); */
NOTE_NEW_VARS( lastline, lastfile );
free( lastfile );
TAINT_NOT;
return 0;
}
void
tools_reset_counters( void ) {
int err;
hash_delete( var_map );
var_map = NULL;
/*fprintf(stderr, "\nNew var_map\n\n"); */
if ( err = hash_new( 1000, &var_map ), ERR_None != err ) {
nomem( );
}
list_delete( &current_arenas );
list_delete( &current_free );
note_init_done = 0;
note_new_vars( 0, NULL );
#ifdef BRUTE_FORCE
hash_delete( brute );
brute = NULL;
brute_force( 0, NULL );
#endif
}
void
tools_hook_runops( void ) {
tools_reset_counters( );
/*note_new_vars(0, NULL); */
/*brute_force(0, NULL); */
if ( PL_runops != runops_leakcheck ) {
runops_old = PL_runops;
PL_runops = runops_leakcheck;
}
}
static void
print_var( SV * sv, const where * w ) {
char *type;
if ( !w && var_map ) {
w = hash_get( var_map, &sv, sizeof( sv ) );
}
switch ( SvTYPE( sv ) ) {
case SVt_PVAV:
type = "AV";
break;
case SVt_PVCV:
type = "CV";
break;
case SVt_PVGV:
type = "GV";
break;
case SVt_PVHV:
type = "HV";
break;
case SVt_RV:
type = "RV";
break;
default:
type = "SV";
break;
}
fprintf( stderr, "leaked %s(0x%p) from %s line %d\n",
type, sv, ( const char * ) ( w + 1 ), w->line );
}
void
tools_show_used( void ) {
/* SV *sva; */
hash_iter i;
const void *k;
size_t kl;
#ifdef BRUTE_FORCE
fprintf( stderr, "Leaks found by free list snooping:\n" );
#endif
k = hash_get_first_key( var_map, &i, &kl );
while ( k ) {
const where *w =
( const where * ) hash_GETNULL( hash_get( var_map, k, kl ) );
if ( w ) {
print_var( *( SV ** ) k, w );
}
k = hash_get_next_key( var_map, &i, &kl );
}
#if 0
for ( sva = PL_sv_arenaroot; sva; sva = ( SV * ) SvANY( sva ) ) {
SV *sv = sva + 1;
SV *svend = &sva[SvREFCNT( sva )];
while ( sv < svend ) {
if ( live_sv( sv ) ) {
fprintf( stderr, "var in pool at %p\n", sv );
}
++sv;
}
}
#endif
#ifdef BRUTE_FORCE
if ( brute ) {
fprintf( stderr, "Leaks found by brute force:\n" );
k = hash_get_first_key( brute, &i, &kl );
while ( k ) {
const where *w =
( const where * ) hash_GETNULL( hash_get( brute, k, kl ) );
if ( w ) {
print_var( *( SV ** ) k, w );
}
k = hash_get_next_key( brute, &i, &kl );
}
}
#endif
}