OXYGENHUB
◆ main openmsx / share / scripts / _profiler.tcl
4.8 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
e8555c89 Andy McCall 1 
# symboltracer: a profiler for the Probe/Trace viewer
2 
#
3 
# symboltracer uses the new Probe/Trace viewer as a profiler and symbol files
4 
# to register functions.
5
6 
namespace eval symboltracer {
7 
namespace export add list remove start stop
8 
namespace ensemble create -prefixes 0
9
10 
variable names {}         ;# user traces
11 
variable counters {}      ;# count recursive calls
12 
variable symbolfiles {}   ;# symbols file name
13
14 
set_help_proc symboltracer [namespace code symboltracer_help]
15 
proc symboltracer_help {args} {
16 
	if {[llength $args] == 1} {
17 
		return {symboltracer is a profiler that traces function calls in the Trace Viewer widget
18
19 
Recognized commands: start, stop, add, list, remove
20
21 
Type 'help symboltracer <command>' for more information about each command.
22 
}
23 
    }
24 
	switch -- [lindex $args 1] {
25 
		"start" { return {Opens a symbol file and start tracing session
26
27 
'start' reads a symbol file (like a .noi or .sym file) and creates breakpoints and traces for each entry found.
28
29 
Syntax: symboltracer start [<sym-file>]
30 
}}
31 
		"add" { return {Creates breakpoint and trace for a user-defined name and address
32
33 
'add' inserts a user-defined breakpoint and trace. No previously defined symbol is necessary. This is most useful for quick tracing sessions.
34
35 
Syntax: symboltracer add <name> <address>
36 
}}
37 
		"stop" { return {Interrupts symboltracer session
38
39 
'stop' removes all breakpoints and traces associated with symboltracer and all files included with the 'start' command.
40
41 
Syntax: symboltracer stop
42 
}}
43 
		"list" { return {Verifies if a user trace exists
44
45 
'list' returns all user traces created by symboltracer when executed without parameters or the address of the user trace if a user trace name is specified.
46
47 
Syntax: symboltracer list my_function
48 
        symboltracer list
49 
}}
50 
		"remove" { return {Removes user trace from the trace viewer
51
52 
'remove' deletes the user specified user trace and associated breakpoint.
53
54 
Syntax: symboltracer remove my_function
55 
}}
56 
		default { error "Unknown subcommand. Must be one of 'add', 'list', 'remove', 'start' or 'stop'." }
57 
	}
58 
}
59
60 
proc _enter_function {name} {
61 
	# find function return address
62 
	set retaddr [peek16 [reg SP]]
63 
	# check if we create caller breakpoint for CALL or RST
64 
	if {[peek [expr {$retaddr - 1}]] in "0 8 16 24 32 40 48 56" ||
65 
	    [peek [expr {$retaddr - 3}]] in "196 204 205 212 220 228 236 244 252"} {
66 
		variable counters
67 
		dict incr counters $name
68 
		set count [dict get $counters $name]
69 
		debug trace add $name $count
70 
		debug breakpoint create -once true -address $retaddr -command [namespace code "_exit_function {$name}"]
71 
	}
72 
}
73
74 
proc _exit_function {name} {
75 
	variable counters
76 
	# ignore a probable dangling breakpoint from a previous session
77 
	if {![dict exists $counters $name]} { return }
78 
	dict incr counters $name -1
79 
	set count [dict get $counters $name]
80 
	if {$count == 0} {
81 
		dict unset counters $name
82 
		debug trace add $name
83 
	} else {
84 
		debug trace add $name $count
85 
	}
86 
}
87
88 
proc add {name addr} {
89 
	# add user-defined name/addr pair and create function breakpoints and traces
90 
	variable names
91 
	# replace old entry
92 
	if {[dict exists $names $name]} {
93 
		catch {debug breakpoint remove [dict get $names $name]}
94 
		debug trace drop $name
95 
	}
96 
	set bp [debug breakpoint create -address $addr -command [namespace code "_enter_function {$name}"]]
97 
	dict set names $name $bp
98 
	debug trace add $name
99 
}
100
101 
proc remove {name} {
102 
	variable names
103 
	if {[dict exists $names $name]} {
104 
		debug trace drop $name
105 
		catch {debug breakpoint remove [dict get $names $name]}
106 
		dict unset names $name
107 
		variable counters
108 
		dict unset counters $name
109 
	}
110 
}
111
112 
proc list {{name {}}} {
113 
	variable names
114 
	if {$name ne {}} {
115 
		if {[dict exists $names $name]} {
116 
			return [dict get $names $name]
117 
		}
118 
	} else {
119 
		return [dict keys $names]
120 
	}
121 
}
122
123 
proc add_symbol_set {symbols} {
124 
	# run through collection of symbols
125 
	foreach entry $symbols {
126 
		dict with entry {
127 
			add $name $value
128 
		}
129 
	}
130 
}
131
132 
proc start {{file ""}} {
133 
	set symbols {}
134 
	if {$file eq ""} {
135 
		# use current symbols only
136 
		set symbols [debug symbols lookup]
137 
	} else {
138 
		# load symbol file
139 
		debug symbols load $file
140 
		set symbols [debug symbols lookup -filename $file]
141 
		variable symbolfiles
142 
		lappend symbolfiles $file
143 
	}
144 
	if {[llength $symbols] == 0} {
145 
		error "no symbols found"
146 
	}
147 
	add_symbol_set $symbols
148 
}
149
150 
proc stop {} {
151 
	variable counters
152 
	set counters {}
153
154 
	variable names
155 
	dict for {name _} $names {
156 
		debug trace drop $name
157 
	}
158 
	set names {}
159
160 
	dict for {bp entry} [debug breakpoint list] {
161 
		if {[string match "* [namespace current] *" [dict get $entry "-command"]]} {
162 
			catch {debug breakpoint remove $bp}
163 
		}
164 
	}
165
166 
	variable symbolfiles
167 
	foreach file $symbolfiles {
168 
		debug symbols remove $file
169 
	}
170 
	set symbolfiles {}
171 
}
172
173 
set_tabcompletion_proc symboltracer [namespace code _tab_symboltracer]
174
175 
proc _tab_symboltracer {args} {
176 
	::list "add" "list" "remove" "start" "stop"
177 
}
178
179 
} ;# namespace symboltracer