share/scripts/_disasm.tcl at main · doomsdayone/openmsx

◆ main openmsx / share / scripts / _disasm.tcl

12.0 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw

namespace eval disasm {

# very common debug functions

proc peek {addr {m memory}} {
	debug read $m $addr
}
proc peek8 {addr {m memory}} {
	peek $addr $m
}
proc peek_u8 {addr {m memory}} {
	peek $addr $m
}
proc peek_s8 {addr {m memory}} {
	set b [peek $addr $m]
	expr {($b < 128) ? $b : ($b - 256)}
}
proc peek16 {addr {m memory}} {
	expr {[peek $addr $m] + 256 * [peek [expr {$addr + 1}] $m]}
}
proc peek16_LE {addr {m memory}} {
	peek16 $addr $m
}
proc peek16_BE {addr {m memory}} {
	expr {256 * [peek $addr $m] + [peek [expr {$addr + 1}] $m]}
}
proc peek_u16 {addr {m memory}} {
	peek16 $addr $m
}
proc peek_u16LE {addr {m memory}} {
	peek16 $addr $m
}
proc peek_u16BE {addr {m memory}} {
	peek16_BE $addr $m
}
proc peek_s16 {addr {m memory}} {
	set w [peek16 $addr $m]
	expr {($w < 32768) ? $w : ($w - 65536)}
}
proc peek_s16LE {addr {m memory}} {
	peek_s16 $addr $m
}
proc peek_s16BE {addr {m memory}} {
	set w [peek16_BE $addr $m]
	expr {($w < 32768) ? $w : ($w - 65536)}
}

set help_text_peek \
{Read a byte or word from the given memory location.
Optionally allows to specify a different 'debuggable' (default is 'memory').

usage:
  peek        <addr> [<mem>] Read unsigned 8-bit value from address
  peek8       <addr> [<mem>]      unsigned 8-bit
  peek_u8     <addr> [<mem>]      unsigned 8-bit
  peek_s8     <addr> [<mem>]        signed 8-bit
  peek16      <addr> [<mem>]      unsigned 16-bit little endian
  peek16_LE   <addr> [<mem>]      unsigned 16-bit little endian
  peek16_BE   <addr> [<mem>]      unsigned 16-bit big    endian
  peek_u16    <addr> [<mem>]      unsigned 16-bit little endian
  peek_u16_LE <addr> [<mem>]      unsigned 16-bit little endian
  peek_u16_BE <addr> [<mem>]      unsigned 16-bit big    endian
  peek_s16    <addr> [<mem>]        signed 16-bit little endian
  peek_s16_LE <addr> [<mem>]        signed 16-bit little endian
  peek_s16_BE <addr> [<mem>]        signed 16-bit big    endian
}
set_help_text peek        $help_text_peek
set_help_text peek8       $help_text_peek
set_help_text peek_u8     $help_text_peek
set_help_text peek_s8     $help_text_peek
set_help_text peek16      $help_text_peek
set_help_text peek16_LE   $help_text_peek
set_help_text peek16_BE   $help_text_peek
set_help_text peek_u16    $help_text_peek
set_help_text peek_u16_LE $help_text_peek
set_help_text peek_u16_BE $help_text_peek
set_help_text peek_s16    $help_text_peek
set_help_text peek_s16_LE $help_text_peek
set_help_text peek_s16_BE $help_text_peek


proc poke {addr val {m memory}} {
	debug write $m $addr $val
}
proc poke8 {addr val {m memory}} {
	poke $addr $val $m
}
proc poke16 {addr val {m memory}} {
	poke        $addr       [expr { $val       & 255}] $m
	poke [expr {$addr + 1}] [expr {($val >> 8) & 255}] $m
}
proc poke16_LE {addr val {m memory}} {
	poke16 $addr $val $m
}
proc poke16_BE {addr val {m memory}} {
	 poke        $addr       [expr {($val >> 8) & 255}] $m
	 poke [expr {$addr + 1}] [expr { $val       & 255}] $m
}
set help_text_poke \
{Write a byte or word to the given memory location.
Optionally allows to specify a different 'debuggable' (default is 'memory').

usage:
  poke      <addr> <val> [<mem>]   Write 8-bit value
  poke8     <addr> <val> [<mem>]         8-bit
  poke16    <addr> <val> [<mem>]        16-bit little endian
  poke16_LE <addr> <val> [<mem>]        16-bit little endian
  poke16_BE <addr> <val> [<mem>]        16-bit big    endian
}
set_help_text poke      $help_text_poke
set_help_text poke8     $help_text_poke
set_help_text poke16    $help_text_poke
set_help_text poke16_LE $help_text_poke
set_help_text poke16_BE $help_text_poke


# because of reverse we can now save replays to a file,
# poke-ing adds an entry into the replay file and therefore
# the file size can grow significantly. Therefor dpoke (poke
# if different or diffpoke) is introduced.
proc dpoke {addr val {m memory}} {
	if {[peek $addr $m] != $val} {poke $addr $val $m}
}


#
# disasm
#
set_help_text disasm \
{Disassemble z80 instructions

Usage:
  disasm                Disassemble 8 instr starting at the currect PC
  disasm <addr>         Disassemble 8 instr starting at address <adr>
  disasm <addr> <num>   Disassemble <num> instr starting at address <addr>
}
proc disasm {{address -1} {num 8}} {
	if {$address == -1} {set address [reg PC]}
	for {set i 0} {$i < int($num)} {incr i} {
		set l [debug disasm $address]
		append result [format "%04X  %s\n" $address [join $l]]
		set address [expr {($address + [llength $l] - 1) & 0xFFFF}]
	}
	return $result
}


#
# run_to
#
set_help_text run_to \
{Run to the specified address, if a breakpoint is reached earlier we stop
at that breakpoint.}
proc run_to {address} {
	debug set_bp -once $address
	debug cont
}


#
# toggle_breaked
#
set_help_text toggle_breaked \
{Toggles breaked status.}
proc toggle_breaked {} {
	if ([debug breaked]) {
		debug cont
	} else {
		debug break
	}
}


#
# step_in
#
set_help_text step_in \
{Step in. Execute the next instruction, also go into subroutines.}
proc step_in {} {
	debug step
}
set_help_text step \
{Same as step_in.}
proc step {} {
	debug step
}


#
# step_out
#
set_help_text step_out \
{Step out of the current subroutine. In other words, execute till right after
the next 'ret' instruction (more if there were also extra 'call' instructions).
Note: simulation can be slow during execution of 'step_out', though for not
extremely large subroutines this is not a problem.}

variable step_out_bp1
variable step_out_bp2

proc step_out_is_ret {} {
	# ret        0xC9
	# ret <cc>   0xC0,0xC8,0xD0,..,0xF8
	# reti retn  0xED + 0x45,0x4D,0x55,..,0x7D
	set instr [peek16 [reg pc]]
	expr {(($instr & 0x00FF) == 0x00C9) ||
	      (($instr & 0x00C7) == 0x00C0) ||
	      (($instr & 0xC7FF) == 0x45ED)}
}
proc step_out_after_break {} {
	variable step_out_bp1
	variable step_out_bp2

	# also clean up when breaked, but not because of step_out
	catch {debug remove_condition $step_out_bp1}
	catch {debug remove_condition $step_out_bp2}
}
proc step_out_after_next {} {
	variable step_out_bp1
	variable step_out_bp2
	variable step_out_sp

	catch {debug remove_condition $step_out_bp2}
	if {[reg sp] > $step_out_sp} {
		catch {debug remove_condition $step_out_bp1}
		debug break
	}
}
proc step_out_after_ret {} {
	variable step_out_bp2

	catch {debug remove_condition $step_out_bp2}
	set step_out_bp2 [debug set_condition 1 [namespace code step_out_after_next]]
}
proc step_out {} {
	variable step_out_bp1
	variable step_out_bp2
	variable step_out_sp

	catch {debug remove_condition $step_out_bp1}
	catch {debug remove_condition $step_out_bp2}
	set step_out_sp [reg sp]
	set step_out_bp1 [debug set_condition {[disasm::step_out_is_ret]} [namespace code step_out_after_ret]]
	after break [namespace code step_out_after_break]
	debug cont
}


#
# step_over
#
set_help_text step_over \
{Step over. Execute the next instruction but don't step into subroutines.
Only 'call' or 'rst' instructions are stepped over. Note: 'push xx / jp nn'
sequences can in theory also be used as calls but these are not skipped
by this command.}
proc step_over {} {
	set address [reg PC]
	set l [debug disasm $address]
	set instr [lindex $l 0]
	if {[string match "call*" $instr] ||
	    [string match "rst*"  $instr] ||
	    [string match "ldir*" $instr] ||
	    [string match "cpir*" $instr] ||
	    [string match "inir*" $instr] ||
	    [string match "otir*" $instr] ||
	    [string match "lddr*" $instr] ||
	    [string match "cpdr*" $instr] ||
	    [string match "indr*" $instr] ||
	    [string match "otdr*" $instr] ||
	    [string match "halt*" $instr]} {
		run_to [expr {$address + [llength $l] - 1}]
	} else {
		debug step
	}
}


#
# step_back
#
set_help_text step_back \
{Step back. Go back in time till right before the last instruction was
executed. Note that this operation is relatively slow (compared to the other
step functions). Also the reverse feature must be enabled for this to work
(normally it's enabled by default).}
proc step_back {} {
	# In the past this proc was implemented totally different. It's worth
	# mentioning this old algorithm and explain why it wasn't good enough.
	# The old algorithm went like this:
	#  - take small steps back till we're not at the start instruction
	#    anymore (this works because 'reverse goto' only stops after
	#    emulating a full instruction)
	# The problem was that on R800 it could take _many_ (more than 80)
	# steps till the destination was reached.
	#
	# The current algorithm goes like this:
	#  - take a large step back
	#  - take small steps forward till we're back at the start
	#  - we now know where the previous instruction started, so go there
	#    (= take a small step back again)
	#
	# So the old algorithm takes (potentially) many backwards steps. While
	# the new algorithm takes exactly 2 backwards steps and (potentially)
	# many forward steps. In the current openMSX implementation, (small)
	# forward steps are orders of magnitude faster than backwards steps (an
	# optimization I added specifically for this use case). So the worst
	# execution time should now be much better.

	# 'z80' or 'r800'
	set cpu [get_active_cpu]

	# Get duration of one CPU cycle.
	set cycle_period [expr {1.0 / [machine_info ${cpu}_freq]}]

	# (Overestimation) for the maximum instruction length.
	#  On Z80 the slowest instruction is probably 'EX (SP),IX' (25 cycles).
	#  On R800 it's probably some I/O instruction to the VDP, followed by
	#  a memory refresh (up to 87(!) cycles). I added some extra cycles as
	#  a safety margin in case I forgot some extra penalty cycles (e.g.
	#  access to a device that inserts extra wait cycles).
	set max_instr_len [expr {(($cpu eq "z80") ? 35 : 100) * $cycle_period}]

	# Get time of the start instruction.
	set start [dict get [reverse status] "current"]

	# Go back till a moment that's certainly before the start instruction.
	reverse goback -novideo $max_instr_len
	set curr [dict get [reverse status] "current"]
	if {$curr >= $start} {
		error "Internal error: initial step-back was not big enough"
	}

	# Take small steps (forward) till we again reach the start instruction.
	while {1} {
		# Note that 'reverse goto' for a small forward step is
		# orders of magnitudes faster than a backwards 'reverse goto'.
		# The '-novideo' flag is required to not (temporarily
		# internally) step back a few video frames (so that immediately
		# after 'reverse goto' we have the correct video output).
		# Also note that this may take a bigger step forward than
		# requested: it will only stop after a complete instruction is
		# emulated.
		reverse goto -novideo [expr {$curr + $cycle_period}]
		set next [dict get [reverse status] "current"]
		if {$next >= $start} {
			# Check for '$next >= $start' (instead of $next == $start).
			# IO is emulated with sub-instruction precision, it's
			# possible to call this script from a watchpoint-callback
			# (which triggers in the middle of an instruction). However
			# 'reverse goto' always stops at instruction boundaries. So
			# the combination of this may cause this algorithm to
			# overshoot the destination timestamp.
			break
		}
		set curr $next
	}

	# The previous step was the correct one, so go back there.
	# Note that (only here) we don't pass the '-novideo' flag
	reverse goto $curr
}


#
# skip one instruction
#
set_help_text skip_instruction \
{Skip the current instruction. In other words increase the program counter with the length of the current instruction.}
proc skip_instruction {} {
	set pc [reg pc]
	reg pc [expr {$pc + [llength [debug disasm $pc]] - 1}]
}

namespace export peek
namespace export peek8
namespace export peek_u8
namespace export peek_s8
namespace export peek16
namespace export peek16_LE
namespace export peek16_BE
namespace export peek_u16
namespace export peek_u16_LE
namespace export peek_u16_BE
namespace export peek_s16
namespace export peek_s16_LE
namespace export peek_s16_BE
namespace export poke
namespace export poke8
namespace export poke16
namespace export poke16_LE
namespace export poke16_BE
namespace export dpoke
namespace export disasm
namespace export run_to
namespace export toggle_breaked
namespace export step_over
namespace export step_back
namespace export step_out
namespace export step_in
namespace export step
namespace export skip_instruction

} ;# namespace disasm

namespace import disasm::*

`/`	Search
`g` `c`	Code
`g` `h`	History
`g` `b`	Bookmarks
`g` `t`	Trust
`y`	Permalink to this state (files and trees)
`?`	This sheet

1	namespace eval disasm {
2
3	# very common debug functions
4
5	proc peek {addr {m memory}} {
6	debug read $m $addr
7	}
8	proc peek8 {addr {m memory}} {
9	peek $addr $m
10	}
11	proc peek_u8 {addr {m memory}} {
12	peek $addr $m
13	}
14	proc peek_s8 {addr {m memory}} {
15	set b [peek $addr $m]
16	expr {($b < 128) ? $b : ($b - 256)}
17	}
18	proc peek16 {addr {m memory}} {
19	expr {[peek $addr $m] + 256 * [peek [expr {$addr + 1}] $m]}
20	}
21	proc peek16_LE {addr {m memory}} {
22	peek16 $addr $m
23	}
24	proc peek16_BE {addr {m memory}} {
25	expr {256 * [peek $addr $m] + [peek [expr {$addr + 1}] $m]}
26	}
27	proc peek_u16 {addr {m memory}} {
28	peek16 $addr $m
29	}
30	proc peek_u16LE {addr {m memory}} {
31	peek16 $addr $m
32	}
33	proc peek_u16BE {addr {m memory}} {
34	peek16_BE $addr $m
35	}
36	proc peek_s16 {addr {m memory}} {
37	set w [peek16 $addr $m]
38	expr {($w < 32768) ? $w : ($w - 65536)}
39	}
40	proc peek_s16LE {addr {m memory}} {
41	peek_s16 $addr $m
42	}
43	proc peek_s16BE {addr {m memory}} {
44	set w [peek16_BE $addr $m]
45	expr {($w < 32768) ? $w : ($w - 65536)}
46	}
47
48	set help_text_peek \
49	{Read a byte or word from the given memory location.
50	Optionally allows to specify a different 'debuggable' (default is 'memory').
51
52	usage:
53	peek <addr> [<mem>] Read unsigned 8-bit value from address
54	peek8 <addr> [<mem>] unsigned 8-bit
55	peek_u8 <addr> [<mem>] unsigned 8-bit
56	peek_s8 <addr> [<mem>] signed 8-bit
57	peek16 <addr> [<mem>] unsigned 16-bit little endian
58	peek16_LE <addr> [<mem>] unsigned 16-bit little endian
59	peek16_BE <addr> [<mem>] unsigned 16-bit big endian
60	peek_u16 <addr> [<mem>] unsigned 16-bit little endian
61	peek_u16_LE <addr> [<mem>] unsigned 16-bit little endian
62	peek_u16_BE <addr> [<mem>] unsigned 16-bit big endian
63	peek_s16 <addr> [<mem>] signed 16-bit little endian
64	peek_s16_LE <addr> [<mem>] signed 16-bit little endian
65	peek_s16_BE <addr> [<mem>] signed 16-bit big endian
66	}
67	set_help_text peek $help_text_peek
68	set_help_text peek8 $help_text_peek
69	set_help_text peek_u8 $help_text_peek
70	set_help_text peek_s8 $help_text_peek
71	set_help_text peek16 $help_text_peek
72	set_help_text peek16_LE $help_text_peek
73	set_help_text peek16_BE $help_text_peek
74	set_help_text peek_u16 $help_text_peek
75	set_help_text peek_u16_LE $help_text_peek
76	set_help_text peek_u16_BE $help_text_peek
77	set_help_text peek_s16 $help_text_peek
78	set_help_text peek_s16_LE $help_text_peek
79	set_help_text peek_s16_BE $help_text_peek
80
81
82	proc poke {addr val {m memory}} {
83	debug write $m $addr $val
84	}
85	proc poke8 {addr val {m memory}} {
86	poke $addr $val $m
87	}
88	proc poke16 {addr val {m memory}} {
89	poke $addr [expr { $val & 255}] $m
90	poke [expr {$addr + 1}] [expr {($val >> 8) & 255}] $m
91	}
92	proc poke16_LE {addr val {m memory}} {
93	poke16 $addr $val $m
94	}
95	proc poke16_BE {addr val {m memory}} {
96	poke $addr [expr {($val >> 8) & 255}] $m
97	poke [expr {$addr + 1}] [expr { $val & 255}] $m
98	}
99	set help_text_poke \
100	{Write a byte or word to the given memory location.
101	Optionally allows to specify a different 'debuggable' (default is 'memory').
102
103	usage:
104	poke <addr> <val> [<mem>] Write 8-bit value
105	poke8 <addr> <val> [<mem>] 8-bit
106	poke16 <addr> <val> [<mem>] 16-bit little endian
107	poke16_LE <addr> <val> [<mem>] 16-bit little endian
108	poke16_BE <addr> <val> [<mem>] 16-bit big endian
109	}
110	set_help_text poke $help_text_poke
111	set_help_text poke8 $help_text_poke
112	set_help_text poke16 $help_text_poke
113	set_help_text poke16_LE $help_text_poke
114	set_help_text poke16_BE $help_text_poke
115
116
117	# because of reverse we can now save replays to a file,
118	# poke-ing adds an entry into the replay file and therefore
119	# the file size can grow significantly. Therefor dpoke (poke
120	# if different or diffpoke) is introduced.
121	proc dpoke {addr val {m memory}} {
122	if {[peek $addr $m] != $val} {poke $addr $val $m}
123	}
124
125
126	#
127	# disasm
128	#
129	set_help_text disasm \
130	{Disassemble z80 instructions
131
132	Usage:
133	disasm Disassemble 8 instr starting at the currect PC
134	disasm <addr> Disassemble 8 instr starting at address <adr>
135	disasm <addr> <num> Disassemble <num> instr starting at address <addr>
136	}
137	proc disasm {{address -1} {num 8}} {
138	if {$address == -1} {set address [reg PC]}
139	for {set i 0} {$i < int($num)} {incr i} {
140	set l [debug disasm $address]
141	append result [format "%04X %s\n" $address [join $l]]
142	set address [expr {($address + [llength $l] - 1) & 0xFFFF}]
143	}
144	return $result
145	}
146
147
148	#
149	# run_to
150	#
151	set_help_text run_to \
152	{Run to the specified address, if a breakpoint is reached earlier we stop
153	at that breakpoint.}
154	proc run_to {address} {
155	debug set_bp -once $address
156	debug cont
157	}
158
159
160	#
161	# toggle_breaked
162	#
163	set_help_text toggle_breaked \
164	{Toggles breaked status.}
165	proc toggle_breaked {} {
166	if ([debug breaked]) {
167	debug cont
168	} else {
169	debug break
170	}
171	}
172
173
174	#
175	# step_in
176	#
177	set_help_text step_in \
178	{Step in. Execute the next instruction, also go into subroutines.}
179	proc step_in {} {
180	debug step
181	}
182	set_help_text step \
183	{Same as step_in.}
184	proc step {} {
185	debug step
186	}
187
188
189	#
190	# step_out
191	#
192	set_help_text step_out \
193	{Step out of the current subroutine. In other words, execute till right after
194	the next 'ret' instruction (more if there were also extra 'call' instructions).
195	Note: simulation can be slow during execution of 'step_out', though for not
196	extremely large subroutines this is not a problem.}
197
198	variable step_out_bp1
199	variable step_out_bp2
200
201	proc step_out_is_ret {} {
202	# ret 0xC9
203	# ret <cc> 0xC0,0xC8,0xD0,..,0xF8
204	# reti retn 0xED + 0x45,0x4D,0x55,..,0x7D
205	set instr [peek16 [reg pc]]
206	expr {(($instr & 0x00FF) == 0x00C9) \|\|
207	(($instr & 0x00C7) == 0x00C0) \|\|
208	(($instr & 0xC7FF) == 0x45ED)}
209	}
210	proc step_out_after_break {} {
211	variable step_out_bp1
212	variable step_out_bp2
213
214	# also clean up when breaked, but not because of step_out
215	catch {debug remove_condition $step_out_bp1}
216	catch {debug remove_condition $step_out_bp2}
217	}
218	proc step_out_after_next {} {
219	variable step_out_bp1
220	variable step_out_bp2
221	variable step_out_sp
222
223	catch {debug remove_condition $step_out_bp2}
224	if {[reg sp] > $step_out_sp} {
225	catch {debug remove_condition $step_out_bp1}
226	debug break
227	}
228	}
229	proc step_out_after_ret {} {
230	variable step_out_bp2
231
232	catch {debug remove_condition $step_out_bp2}
233	set step_out_bp2 [debug set_condition 1 [namespace code step_out_after_next]]
234	}
235	proc step_out {} {
236	variable step_out_bp1
237	variable step_out_bp2
238	variable step_out_sp
239
240	catch {debug remove_condition $step_out_bp1}
241	catch {debug remove_condition $step_out_bp2}
242	set step_out_sp [reg sp]
243	set step_out_bp1 [debug set_condition {[disasm::step_out_is_ret]} [namespace code step_out_after_ret]]
244	after break [namespace code step_out_after_break]
245	debug cont
246	}
247
248
249	#
250	# step_over
251	#
252	set_help_text step_over \
253	{Step over. Execute the next instruction but don't step into subroutines.
254	Only 'call' or 'rst' instructions are stepped over. Note: 'push xx / jp nn'
255	sequences can in theory also be used as calls but these are not skipped
256	by this command.}
257	proc step_over {} {
258	set address [reg PC]
259	set l [debug disasm $address]
260	set instr [lindex $l 0]
261	if {[string match "call*" $instr] \|\|
262	[string match "rst*" $instr] \|\|
263	[string match "ldir*" $instr] \|\|
264	[string match "cpir*" $instr] \|\|
265	[string match "inir*" $instr] \|\|
266	[string match "otir*" $instr] \|\|
267	[string match "lddr*" $instr] \|\|
268	[string match "cpdr*" $instr] \|\|
269	[string match "indr*" $instr] \|\|
270	[string match "otdr*" $instr] \|\|
271	[string match "halt*" $instr]} {
272	run_to [expr {$address + [llength $l] - 1}]
273	} else {
274	debug step
275	}
276	}
277
278
279	#
280	# step_back
281	#
282	set_help_text step_back \
283	{Step back. Go back in time till right before the last instruction was
284	executed. Note that this operation is relatively slow (compared to the other
285	step functions). Also the reverse feature must be enabled for this to work
286	(normally it's enabled by default).}
287	proc step_back {} {
288	# In the past this proc was implemented totally different. It's worth
289	# mentioning this old algorithm and explain why it wasn't good enough.
290	# The old algorithm went like this:
291	# - take small steps back till we're not at the start instruction
292	# anymore (this works because 'reverse goto' only stops after
293	# emulating a full instruction)
294	# The problem was that on R800 it could take _many_ (more than 80)
295	# steps till the destination was reached.
296	#
297	# The current algorithm goes like this:
298	# - take a large step back
299	# - take small steps forward till we're back at the start
300	# - we now know where the previous instruction started, so go there
301	# (= take a small step back again)
302	#
303	# So the old algorithm takes (potentially) many backwards steps. While
304	# the new algorithm takes exactly 2 backwards steps and (potentially)
305	# many forward steps. In the current openMSX implementation, (small)
306	# forward steps are orders of magnitude faster than backwards steps (an
307	# optimization I added specifically for this use case). So the worst
308	# execution time should now be much better.
309
310	# 'z80' or 'r800'
311	set cpu [get_active_cpu]
312
313	# Get duration of one CPU cycle.
314	set cycle_period [expr {1.0 / [machine_info ${cpu}_freq]}]
315
316	# (Overestimation) for the maximum instruction length.
317	# On Z80 the slowest instruction is probably 'EX (SP),IX' (25 cycles).
318	# On R800 it's probably some I/O instruction to the VDP, followed by
319	# a memory refresh (up to 87(!) cycles). I added some extra cycles as
320	# a safety margin in case I forgot some extra penalty cycles (e.g.
321	# access to a device that inserts extra wait cycles).
322	set max_instr_len [expr {(($cpu eq "z80") ? 35 : 100) * $cycle_period}]
323
324	# Get time of the start instruction.
325	set start [dict get [reverse status] "current"]
326
327	# Go back till a moment that's certainly before the start instruction.
328	reverse goback -novideo $max_instr_len
329	set curr [dict get [reverse status] "current"]
330	if {$curr >= $start} {
331	error "Internal error: initial step-back was not big enough"
332	}
333
334	# Take small steps (forward) till we again reach the start instruction.
335	while {1} {
336	# Note that 'reverse goto' for a small forward step is
337	# orders of magnitudes faster than a backwards 'reverse goto'.
338	# The '-novideo' flag is required to not (temporarily
339	# internally) step back a few video frames (so that immediately
340	# after 'reverse goto' we have the correct video output).
341	# Also note that this may take a bigger step forward than
342	# requested: it will only stop after a complete instruction is
343	# emulated.
344	reverse goto -novideo [expr {$curr + $cycle_period}]
345	set next [dict get [reverse status] "current"]
346	if {$next >= $start} {
347	# Check for '$next >= $start' (instead of $next == $start).
348	# IO is emulated with sub-instruction precision, it's
349	# possible to call this script from a watchpoint-callback
350	# (which triggers in the middle of an instruction). However
351	# 'reverse goto' always stops at instruction boundaries. So
352	# the combination of this may cause this algorithm to
353	# overshoot the destination timestamp.
354	break
355	}
356	set curr $next
357	}
358
359	# The previous step was the correct one, so go back there.
360	# Note that (only here) we don't pass the '-novideo' flag
361	reverse goto $curr
362	}
363
364
365	#
366	# skip one instruction
367	#
368	set_help_text skip_instruction \
369	{Skip the current instruction. In other words increase the program counter with the length of the current instruction.}
370	proc skip_instruction {} {
371	set pc [reg pc]
372	reg pc [expr {$pc + [llength [debug disasm $pc]] - 1}]
373	}
374
375	namespace export peek
376	namespace export peek8
377	namespace export peek_u8
378	namespace export peek_s8
379	namespace export peek16
380	namespace export peek16_LE
381	namespace export peek16_BE
382	namespace export peek_u16
383	namespace export peek_u16_LE
384	namespace export peek_u16_BE
385	namespace export peek_s16
386	namespace export peek_s16_LE
387	namespace export peek_s16_BE
388	namespace export poke
389	namespace export poke8
390	namespace export poke16
391	namespace export poke16_LE
392	namespace export poke16_BE
393	namespace export dpoke
394	namespace export disasm
395	namespace export run_to
396	namespace export toggle_breaked
397	namespace export step_over
398	namespace export step_back
399	namespace export step_out
400	namespace export step_in
401	namespace export step
402	namespace export skip_instruction
403
404	} ;# namespace disasm
405
406	namespace import disasm::*

Keyboard