OXYGENHUB
◆ main openmsx / share / scripts / _trace.tcl
2.3 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
namespace eval trace {
2
3 
# cpu_trace
4
5 
set_help_text cpu_trace \
6 
{cpu_trace <item>...
7
8 
Enable CPU instruction/register tracing for the given items.
9 
 <item> can be one of the following:
10 
    "instr":  to trace instructions
11 
    <reg>: an 8 or 16 bit register name like 'A', 'B' or 'HL', 'PC'
12 
           the same list of registers as accepted by the 'reg' command
13
14 
For example execute:
15 
    cpu_trace instr A HL
16 
to trace the instruction together with the A and HL register.
17
18 
To disable tracing again execute:
19 
    cpu_trace
20 
so pass no arguments (no enabled items).
21
22 
Note this can be expensive and/or can quickly consume a lot of memory. The Z80 (and certainly R800) can execute almost 1 million instructions per second. So it's recommended to only enable those items you need and limit the trace duration to less than a minute.
23 
}
24 
set_tabcompletion_proc cpu_trace [namespace code cpu_trace_tab] false
25
26 
variable cond_id
27 
variable cpu_trace_list [list]
28
29 
proc get_allowed_items {} {
30 
	variable allowed_items_cache
31 
	if {![info exists allowed_items_cache]} {
32 
		reg A ; # ensure _cpuregs.tcl is loaded
33 
		set allowed_items_cache [lsort [concat [dict keys $::cpuregs::regB] [dict keys $::cpuregs::regW] "INSTR"]]
34 
	}
35 
	return $allowed_items_cache
36 
}
37
38 
proc cpu_trace_tab {args} {
39 
	return [get_allowed_items]
40 
}
41
42 
proc cpu_trace {args} {
43 
	set allowed_items [get_allowed_items]
44 
	foreach i $args {
45 
		if {[string toupper $i] ni $allowed_items} {
46 
			error "Invalid value for cpu_trace: $i, must be one of $allowed_items"
47 
		}
48 
	}
49
50 
	variable cpu_trace_list
51 
	set cpu_trace_list $args
52
53 
	variable cond_id
54 
	catch { debug condition remove $cond_id }
55 
	if {[llength $cpu_trace_list] != 0} {
56 
		set cond_id [debug condition create -command [namespace code do_cpu_trace]]
57 
	}
58
59 
	foreach e $cpu_trace_list {
60 
		if {$e eq "instr"} {
61 
			set inst [regsub -all { +} [lindex [debug disasm [reg pc]] 0] { }]
62 
			debug trace add $e $inst -type string -description "CPU instructions"
63 
		} else {
64 
			debug trace add $e [reg $e] -type int -format hex -description "CPU register $e"
65 
		}
66 
	}
67 
}
68 
namespace export cpu_trace
69
70 
proc do_cpu_trace {} {
71 
	variable cpu_trace_list
72 
	foreach e $cpu_trace_list {
73 
		if {$e eq "instr"} {
74 
			set inst [regsub -all { +} [lindex [debug disasm [reg pc]] 0] { }]
75 
			debug trace add $e $inst
76 
		} else {
77 
			debug trace add $e -merge [reg $e]
78 
		}
79 
	}
80 
}
81
82 
} ;# namespace eval trace
83
84 
namespace import trace::*