OXYGENHUB
◆ main openmsx / share / scripts / _reg_log.tcl
3.0 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
namespace eval reg_log {
2
3 
set_help_text reg_log \
4 
{Logs the contents (e.g. registers) of a given debuggable or replays such a log.
5 
The state of the debuggable is saved to a log file every VDP frame. Note that
6 
it does not take into account different VDP interrupt rates.
7
8 
Usage:
9 
   reg_log record <debuggable> [<filename>]   record <debuggable> to <filename>
10 
                                              (default: <debuggable>.log)
11 
   reg_log stop <debuggable>                  stop recording <debuggable>
12 
   reg_log play <debuggable> <filename>       replay log in <filename>
13
14 
Examples:
15 
   reg_log record "PSG regs"        start logging PSG registers to
16 
                                    "PSG regs.log"
17 
   reg_log record memory mem.log    start logging memory to file mem.log
18 
   reg_log stop "PSG regs"          stop logging "PSG regs"
19 
   reg_log play "PSG regs" my.log   replay the log of "PSG regs" in my.log
20 
}
21
22 
set_tabcompletion_proc reg_log [namespace code tab_reg_log]
23 
proc tab_reg_log {args} {
24 
	switch [llength $args] {
25 
		2 {return "record play stop"}
26 
		3 {return [debug list]}
27 
	}
28 
}
29
30 
variable log_file
31 
variable data
32
33 
proc reg_log {subcommand debuggable {filename ""}} {
34 
	if {$filename eq ""} {set filename ${debuggable}.log}
35 
	switch $subcommand {
36 
		"record" {return [record $debuggable $filename]}
37 
		"play"   {return [play $debuggable $filename]}
38 
		"stop"   {return [stop $debuggable]}
39 
		default  {error "bad option \"$subcommand\": must be record, play or stop"}
40 
	}
41 
}
42
43 
proc check {debuggable} {
44 
	if {$debuggable ni [debug list]} {
45 
		error "No such debuggable: $debuggable"
46 
	}
47 
}
48
49 
proc record {debuggable filename} {
50 
	variable log_file
51 
	check $debuggable
52 
	stop $debuggable
53 
	set log_file($debuggable) [open $filename {WRONLY TRUNC CREAT}]
54 
	do_reg_record $debuggable
55 
	return ""
56 
}
57
58 
proc play {debuggable filename} {
59 
	variable data
60 
	check $debuggable
61 
	stop $debuggable
62 
	set log_file [open $filename RDONLY]
63 
	set data($debuggable) [split [read $log_file] \n]
64 
	close $log_file
65 
	do_reg_play $debuggable
66 
	return ""
67 
}
68
69 
proc stop {debuggable} {
70 
	variable log_file
71 
	global file data
72 
	if {[info exists log_file($debuggable)]} {
73 
		close $log_file($debuggable)
74 
		unset log_file($debuggable)
75 
	}
76 
	if {[info exists data($debuggable)]} {
77 
		unset data($debuggable)
78 
	}
79 
	return ""
80 
}
81
82 
proc do_reg_record {debuggable} {
83 
	variable log_file
84 
	if {![info exists log_file($debuggable)]} return
85 
	set size [debug size $debuggable]
86 
	for {set i 0} {$i < $size} {incr i} {
87 
		puts -nonewline $log_file($debuggable) "[debug read $debuggable $i] "
88 
	}
89 
	puts $log_file($debuggable) ""  ;#newline
90 
	after frame [list reg_log::do_reg_record $debuggable]
91 
}
92
93 
proc do_reg_play {debuggable} {
94 
	variable data
95 
	if {![info exists data($debuggable)]} return
96 
	set reg 0
97 
	foreach val [lindex $data($debuggable) 0] {
98 
		debug write $debuggable $reg $val
99 
		incr reg
100 
	}
101 
	set data($debuggable) [lrange $data($debuggable) 1 end]
102 
	if {[llength $data($debuggable)] > 0} {
103 
		after frame [list reg_log::do_reg_play $debuggable]
104 
	}
105 
}
106
107 
namespace export reg_log
108
109 
} ;# namespace reg_log
110
111 
namespace import reg_log::*