234 lines
6.9 KiB
Tcl
234 lines
6.9 KiB
Tcl
#/bin/sh
|
|
# \
|
|
exec `which tclsh` $0 "$@"
|
|
#
|
|
# The author disclaims copyright to this source code. In place of
|
|
# a legal notice, here is a blessing:
|
|
#
|
|
# May you do good and not evil.
|
|
# May you find forgiveness for yourself and forgive others.
|
|
# May you share freely, never taking more than you give.
|
|
######################################################################
|
|
|
|
set doco "
|
|
This script is a tool to help track down memory leaks in the sqlite
|
|
library. The library must be compiled with the preprocessor symbol
|
|
SQLITE_MEMDEBUG set to at least 2. It must be set to 3 to enable stack
|
|
traces.
|
|
|
|
To use, run the leaky application and save the standard error output.
|
|
Then, execute this program with the first argument the name of the
|
|
application binary (or interpreter) and the second argument the name of the
|
|
text file that contains the collected stderr output.
|
|
|
|
If all goes well a summary of unfreed allocations is printed out. If the
|
|
GNU C library is in use and SQLITE_DEBUG is 3 or greater a stack trace is
|
|
printed out for each unmatched allocation.
|
|
|
|
If the \"-r <n>\" option is passed, then the program stops and prints out
|
|
the state of the heap immediately after the <n>th call to malloc() or
|
|
realloc().
|
|
|
|
Example:
|
|
|
|
$ ./testfixture ../sqlite/test/select1.test 2> memtrace.out
|
|
$ tclsh $argv0 ?-r <malloc-number>? ./testfixture memtrace.out
|
|
"
|
|
|
|
|
|
proc usage {} {
|
|
set prg [file tail $::argv0]
|
|
puts "Usage: $prg ?-r <malloc-number>? <binary file> <mem trace file>"
|
|
puts ""
|
|
puts [string trim $::doco]
|
|
exit -1
|
|
}
|
|
|
|
proc shift {listvar} {
|
|
upvar $listvar l
|
|
set ret [lindex $l 0]
|
|
set l [lrange $l 1 end]
|
|
return $ret
|
|
}
|
|
|
|
# Argument handling. The following vars are set:
|
|
#
|
|
# $exe - the name of the executable (i.e. "testfixture" or "./sqlite3")
|
|
# $memfile - the name of the file containing the trace output.
|
|
# $report_at - The malloc number to stop and report at. Or -1 to read
|
|
# all of $memfile.
|
|
#
|
|
set report_at -1
|
|
while {[llength $argv]>2} {
|
|
set arg [shift argv]
|
|
switch -- $arg {
|
|
"-r" {
|
|
set report_at [shift argv]
|
|
}
|
|
default {
|
|
usage
|
|
}
|
|
}
|
|
}
|
|
if {[llength $argv]!=2} usage
|
|
set exe [lindex $argv 0]
|
|
set memfile [lindex $argv 1]
|
|
|
|
# If stack traces are enabled, the 'addr2line' program is called to
|
|
# translate a binary stack address into a human-readable form.
|
|
set addr2line addr2line
|
|
|
|
# When the SQLITE_MEMDEBUG is set as described above, SQLite prints
|
|
# out a line for each malloc(), realloc() or free() call that the
|
|
# library makes. If SQLITE_MEMDEBUG is 3, then a stack trace is printed
|
|
# out before each malloc() and realloc() line.
|
|
#
|
|
# This program parses each line the SQLite library outputs and updates
|
|
# the following global Tcl variables to reflect the "current" state of
|
|
# the heap used by SQLite.
|
|
#
|
|
set nBytes 0 ;# Total number of bytes currently allocated.
|
|
set nMalloc 0 ;# Total number of malloc()/realloc() calls.
|
|
set nPeak 0 ;# Peak of nBytes.
|
|
set iPeak 0 ;# nMalloc when nPeak was set.
|
|
#
|
|
# More detailed state information is stored in the $memmap array.
|
|
# Each key in the memmap array is the address of a chunk of memory
|
|
# currently allocated from the heap. The value is a list of the
|
|
# following form
|
|
#
|
|
# {<number-of-bytes> <malloc id> <stack trace>}
|
|
#
|
|
array unset memmap
|
|
|
|
proc process_input {input_file array_name} {
|
|
upvar $array_name mem
|
|
set input [open $input_file]
|
|
|
|
set MALLOC {([[:digit:]]+) malloc ([[:digit:]]+) bytes at 0x([[:xdigit:]]+)}
|
|
# set STACK {^[[:digit:]]+: STACK: (.*)$}
|
|
set STACK {^STACK: (.*)$}
|
|
set FREE {[[:digit:]]+ free ([[:digit:]]+) bytes at 0x([[:xdigit:]]+)}
|
|
set REALLOC {([[:digit:]]+) realloc ([[:digit:]]+) to ([[:digit:]]+)}
|
|
append REALLOC { bytes at 0x([[:xdigit:]]+) to 0x([[:xdigit:]]+)}
|
|
|
|
set stack ""
|
|
while { ![eof $input] } {
|
|
set line [gets $input]
|
|
if {[regexp $STACK $line dummy stack]} {
|
|
# Do nothing. The variable $stack now stores the hexadecimal stack dump
|
|
# for the next malloc() or realloc().
|
|
|
|
} elseif { [regexp $MALLOC $line dummy mallocid bytes addr] } {
|
|
# If this is a 'malloc' line, set an entry in the mem array. Each entry
|
|
# is a list of length three, the number of bytes allocated , the malloc
|
|
# number and the stack dump when it was allocated.
|
|
set mem($addr) [list $bytes "malloc $mallocid" $stack]
|
|
set stack ""
|
|
|
|
# Increase the current heap usage
|
|
incr ::nBytes $bytes
|
|
|
|
# Increase the number of malloc() calls
|
|
incr ::nMalloc
|
|
|
|
if {$::nBytes > $::nPeak} {
|
|
set ::nPeak $::nBytes
|
|
set ::iPeak $::nMalloc
|
|
}
|
|
|
|
} elseif { [regexp $FREE $line dummy bytes addr] } {
|
|
# If this is a 'free' line, remove the entry from the mem array. If the
|
|
# entry does not exist, or is the wrong number of bytes, announce a
|
|
# problem. This is more likely a bug in the regular expressions for
|
|
# this script than an SQLite defect.
|
|
if { [lindex $mem($addr) 0] != $bytes } {
|
|
error "byte count mismatch"
|
|
}
|
|
unset mem($addr)
|
|
|
|
# Decrease the current heap usage
|
|
incr ::nBytes [expr -1 * $bytes]
|
|
|
|
} elseif { [regexp $REALLOC $line dummy mallocid ob b oa a] } {
|
|
# "free" the old allocation in the internal model:
|
|
incr ::nBytes [expr -1 * $ob]
|
|
unset mem($oa);
|
|
|
|
# "malloc" the new allocation
|
|
set mem($a) [list $b "realloc $mallocid" $stack]
|
|
incr ::nBytes $b
|
|
set stack ""
|
|
|
|
# Increase the number of malloc() calls
|
|
incr ::nMalloc
|
|
|
|
if {$::nBytes > $::nPeak} {
|
|
set ::nPeak $::nBytes
|
|
set ::iPeak $::nMalloc
|
|
}
|
|
|
|
} else {
|
|
# puts "REJECT: $line"
|
|
}
|
|
|
|
if {$::nMalloc==$::report_at} report
|
|
}
|
|
|
|
close $input
|
|
}
|
|
|
|
proc printstack {stack} {
|
|
set fcount 10
|
|
if {[llength $stack]<10} {
|
|
set fcount [llength $stack]
|
|
}
|
|
foreach frame [lrange $stack 1 $fcount] {
|
|
foreach {f l} [split [exec $::addr2line -f --exe=$::exe $frame] \n] {}
|
|
puts [format "%-30s %s" $f $l]
|
|
}
|
|
if {[llength $stack]>0 } {puts ""}
|
|
}
|
|
|
|
proc report {} {
|
|
|
|
foreach key [array names ::memmap] {
|
|
set stack [lindex $::memmap($key) 2]
|
|
set bytes [lindex $::memmap($key) 0]
|
|
lappend summarymap($stack) $bytes
|
|
}
|
|
|
|
set sorted [list]
|
|
foreach stack [array names summarymap] {
|
|
set allocs $summarymap($stack)
|
|
set sum 0
|
|
foreach a $allocs {
|
|
incr sum $a
|
|
}
|
|
lappend sorted [list $sum $stack]
|
|
}
|
|
|
|
set sorted [lsort -integer -index 0 $sorted]
|
|
foreach s $sorted {
|
|
set sum [lindex $s 0]
|
|
set stack [lindex $s 1]
|
|
set allocs $summarymap($stack)
|
|
puts "$sum bytes in [llength $allocs] chunks ($allocs)"
|
|
printstack $stack
|
|
}
|
|
|
|
# Print out summary statistics
|
|
puts "Total allocations : $::nMalloc"
|
|
puts "Total outstanding allocations: [array size ::memmap]"
|
|
puts "Current heap usage : $::nBytes bytes"
|
|
puts "Peak heap usage : $::nPeak bytes (malloc #$::iPeak)"
|
|
|
|
exit
|
|
}
|
|
|
|
process_input $memfile memmap
|
|
report
|
|
|
|
|
|
|