summaryrefslogtreecommitdiffstats
path: root/third_party/sqlite/tool/memleak3.tcl
blob: 3c6e9b9c562641b4bec09244a097cb8d06dc96c9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
#/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