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

◆ main openmsx / share / scripts / _slot.tcl

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

namespace eval slot {

#
# get_selected_slot
#
set_help_text get_selected_slot \
{Returns the selected slot for the given memory page.
This proc is typically used as a helper for a larger proc.

 @param page The memory page (0-3)
 @result Returns a Tcl list with two elements.
         First element is the primary slot (0-3).
         Second element is the secondary slot (0-3) or 'X'
         in case this slot was not expanded
}
# Please note that for a Superexpanded SVI-328 we use hardcoded names of these
# memory devices from the configuration file... Maybe that's acceptable as
# we're never going to add more variations?
proc get_selected_primary_slot_svi {page} {
	set ps_reg [debug read "PSG regs" 15]

	if {$ps_reg == 0} {
		return 0
	}
	if {($page & 2) == 0} {
		if       {([machine_info slot 3 0 0] eq [list "Expanded RAM bank 31, 32"]) && (($ps_reg &  8) == 0)} {
			return 3
		} elseif {([machine_info slot 2 0 0] eq [list "Main RAM bank 21"        ]) && (($ps_reg &  2) == 0)} {
			return 2
		} elseif {($ps_reg & 1) == 0} {
			return 1
		} else {
			return 0
		}
	} else {
		if       {([machine_info slot 3 0 0] eq [list "Expanded RAM bank 31, 32"]) && (($ps_reg & 16) == 0)} {
			return 3
		} elseif {([machine_info slot 2 0 2] eq [list "Expanded RAM bank 22"    ]) && (($ps_reg &  4) == 0)} {
			return 2
		} elseif {($ps_reg & 1) == 0 && ($ps_reg & 0xC0) < 0xC0} {
			return 1
		} else {
			return 0
		}
	}
}

proc get_selected_slot {page} {
	if {[machine_info type] eq "SVI"} {
		return [list [get_selected_primary_slot_svi $page] "X"]
	}
	set ps_reg [debug read "ioports" 0xA8]
	set ps [expr {($ps_reg >> (2 * $page)) & 0x03}]
	if {[machine_info "issubslotted" $ps]} {
		set ss_reg [debug read "slotted memory" [expr {0x40000 * $ps + 0xFFFF}]]
		set ss [expr {(($ss_reg ^ 255) >> (2 * $page)) & 0x03}]
	} else {
		set ss "X"
	}
	list $ps $ss
}

#
# slotselect
#
set_help_text slotselect \
{Returns a nicely formatted overview of the selected slots.}
proc slotselect {} {
	set result ""
	for {set page 0} {$page < 4} {incr page} {
		lassign [get_selected_slot $page] ps ss
		append result [format "%04X: slot %d" [expr {0x4000 * $page}] $ps]
		if {$ss ne "X"} {append result "." $ss}
		append result "\n"
	}
	return $result
}

#
# get_mapper_size
#
set_help_text get_mapper_size \
{Returns the size of the memory mapper in a given slot.
Result is 0 when there is no memory mapper in the slot.}
proc get_mapper_size {ps ss} {
	set result 0
	catch { ;# for multi-mem devices, but those aren't memory mappers
		set device [lindex [machine_info slot $ps $ss 0] 0]
		if {[debug desc $device] eq "memory mapper"} {
			set result [expr {[debug size $device] / 0x4000}]
		}
	}
	return $result
}

#
# get (rom) block size
# e.g. for a 'Konami' rom mapper it returns 8kB
# TODO it would be nice to generalize this so that it also works for memory
# mappers, or even all memory mapped devices (whether they have switchable
# blocks or not)
#
proc get_block_size {ps ss page} {
	set block_size 0
	catch {
		set device_list [machine_info slot $ps $ss $page]
		if {[llength $device_list] != 1} {return 0}
		set device_info [machine_info device [lindex $device_list 0]]
		set romtype [dict get $device_info "mappertype"] ;# can return ""
		set romtype_info [openmsx_info romtype $romtype] ;# fails if romtype == ""
		set block_size [dict get $romtype_info blocksize];# could fail??
	}
	return $block_size
}

#
# pc_in_slot
#
set_help_text pc_in_slot \
{Test whether the CPU's program counter is inside a certain slot.
Typically used to set breakpoints in specific slots.}
proc pc_in_slot {ps {ss "X"} {mapper "X"}} {
	return [address_in_slot [reg PC] $ps $ss $mapper]
}

#
# watch_in_slot
#
set_help_text watch_in_slot \
{Test whether the address watched is inside a certain slot.
To be used only to set watchpoints in specific slots.}
proc watch_in_slot {ps {ss "X"} {mapper "X"}} {
	return [address_in_slot $::wp_last_address $ps $ss $mapper]
}

#
# helper proc for pc_in_slot and watch_in_slot
#
set_help_text address_in_slot \
{Test whether an address is inside a certain slot.
Typically used by pc_in_slot and watch_in_slot.}
proc address_in_slot {addr ps {ss "X"} {block "X"}} {
	# get current page and slots
	set page [expr {$addr >> 14}]
	lassign [get_selected_slot $page] pc_ps pc_ss

	# check primary and secondary slot
	if {($ps ne "X") &&                    ($pc_ps != $ps)} {return 0}
	if {($ss ne "X") && ($pc_ss ne "X") && ($pc_ss != $ss)} {return 0}

	# need to check block?
	if {$block eq "X"} {return true}

	# first (try to) check memory mapper
	if {$pc_ss eq "X"} {set pc_ss 0}
	set mapper_size [get_mapper_size $pc_ps $pc_ss]
	if {$mapper_size != 0} {
		set pc_block [debug read "MapperIO" $page]
		return [expr {$block == ($pc_block & ($mapper_size - 1))}]
	}

	# next (try to) check rom mapper
	set block_size [get_block_size $pc_ps $pc_ss $page]
	if {$block_size != 0} {
		set device_name [lindex [machine_info slot $pc_ps $pc_ss $page] 0]
		# note: I'm assuming that if get_block_size returns a non-zero
		#       value, then the "romblocks" debuggable always exixts.
		#       Is that correct?
		set pc_block [debug read "$device_name romblocks" $addr]
		return [expr {$block == $pc_block}]
	}

	# no mapper present, ok (or should we check block==0 ?)
	return 1
}

#
# slotmap
#
set_help_text slotmap \
{Gives an overview of the devices in the different slots.}
proc slotmap_helper {ps ss} {
	set result ""
	for {set page 0} {$page < 4} {incr page} {
		set device_list [machine_info slot $ps $ss $page]
		# This 'if' introduces a parsing ambiguity (list of elements
		# without embedded spaces versus single element with embedded
		# spaces) though usually this looks nicer.
		# Though this means the output of this script should not be
		# further parsed in scripts.
		if {[llength $device_list] == 1} {
			set name [lindex $device_list 0]
		} else {
			set name $device_list
		}
		append result [format "%04X: %s\n" [expr {$page * 0x4000}] $name]
	}
	return $result
}
proc slotmap_name {ps ss} {
	set t [list $ps $ss]
	foreach slot [machine_info external_slot] {
		if {[lrange [machine_info external_slot $slot] 0 1] eq $t} {
			return " (${slot})"
		}
	}
	return ""
}
proc slotmap {} {
	set result ""
	for {set ps 0} {$ps < 4} {incr ps} {
		if {[machine_info issubslotted $ps]} {
			for {set ss 0} {$ss < 4} {incr ss} {
				append result "slot $ps.$ss[slotmap_name $ps $ss]:\n"
				append result [slotmap_helper $ps $ss]
			}
		} else {
			append result "slot $ps[slotmap_name $ps X]:\n"
			append result [slotmap_helper $ps 0]
		}
	}
	return $result
}

#
# iomap
#
set_help_text iomap \
{Gives an overview of the devices connected to the different I/O ports.}
proc iomap_helper {prefix begin end name} {
	if {$name eq ""} {return ""}
	set result [format "port %02X" $begin]
	if {$begin == ($end - 1)} {
		append result ":   "
	} else {
		append result [format "-%02X:" [expr {$end - 1}]]
	}
	append result " $prefix $name\n"
}
proc iomap {} {
	set result ""
	set port 0
	while {$port < 256} {
		set in  [machine_info input_port  $port]
		set out [machine_info output_port $port]
		set end [expr {$port + 1}]
		while {($end < 256) &&
		       ($in  eq [machine_info input_port  $end]) &&
		       ($out eq [machine_info output_port $end])} {
			incr end
		}
		if {$in eq $out} {
			append result [iomap_helper "I/O" $port $end [join $in  ", "]]
		} else {
			append result [iomap_helper "I  " $port $end [join $in  ", "]]
			append result [iomap_helper "  O" $port $end [join $out ", "]]
		}
		set port $end
	}
	return $result
}

namespace export get_selected_slot
namespace export slotselect
namespace export get_mapper_size
namespace export pc_in_slot
namespace export watch_in_slot
namespace export address_in_slot
namespace export slotmap
namespace export iomap

} ;# namespace slot

namespace import slot::*

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

e8555c89 Andy McCall 1 month ago	1	namespace eval slot {
	2
	3	#
	4	# get_selected_slot
	5	#
	6	set_help_text get_selected_slot \
	7	{Returns the selected slot for the given memory page.
	8	This proc is typically used as a helper for a larger proc.
	9
	10	@param page The memory page (0-3)
	11	@result Returns a Tcl list with two elements.
	12	First element is the primary slot (0-3).
	13	Second element is the secondary slot (0-3) or 'X'
	14	in case this slot was not expanded
	15	}
	16	# Please note that for a Superexpanded SVI-328 we use hardcoded names of these
	17	# memory devices from the configuration file... Maybe that's acceptable as
	18	# we're never going to add more variations?
	19	proc get_selected_primary_slot_svi {page} {
	20	set ps_reg [debug read "PSG regs" 15]
	21
	22	if {$ps_reg == 0} {
	23	return 0
	24	}
	25	if {($page & 2) == 0} {
	26	if {([machine_info slot 3 0 0] eq [list "Expanded RAM bank 31, 32"]) && (($ps_reg & 8) == 0)} {
	27	return 3
	28	} elseif {([machine_info slot 2 0 0] eq [list "Main RAM bank 21" ]) && (($ps_reg & 2) == 0)} {
	29	return 2
	30	} elseif {($ps_reg & 1) == 0} {
	31	return 1
	32	} else {
	33	return 0
	34	}
	35	} else {
	36	if {([machine_info slot 3 0 0] eq [list "Expanded RAM bank 31, 32"]) && (($ps_reg & 16) == 0)} {
	37	return 3
	38	} elseif {([machine_info slot 2 0 2] eq [list "Expanded RAM bank 22" ]) && (($ps_reg & 4) == 0)} {
	39	return 2
	40	} elseif {($ps_reg & 1) == 0 && ($ps_reg & 0xC0) < 0xC0} {
	41	return 1
	42	} else {
	43	return 0
	44	}
	45	}
	46	}
	47
	48	proc get_selected_slot {page} {
	49	if {[machine_info type] eq "SVI"} {
	50	return [list [get_selected_primary_slot_svi $page] "X"]
	51	}
	52	set ps_reg [debug read "ioports" 0xA8]
	53	set ps [expr {($ps_reg >> (2 * $page)) & 0x03}]
	54	if {[machine_info "issubslotted" $ps]} {
	55	set ss_reg [debug read "slotted memory" [expr {0x40000 * $ps + 0xFFFF}]]
	56	set ss [expr {(($ss_reg ^ 255) >> (2 * $page)) & 0x03}]
	57	} else {
	58	set ss "X"
	59	}
	60	list $ps $ss
	61	}
	62
	63	#
	64	# slotselect
65	#
66	set_help_text slotselect \
67	{Returns a nicely formatted overview of the selected slots.}
68	proc slotselect {} {
69	set result ""
70	for {set page 0} {$page < 4} {incr page} {
71	lassign [get_selected_slot $page] ps ss
72	append result [format "%04X: slot %d" [expr {0x4000 * $page}] $ps]
73	if {$ss ne "X"} {append result "." $ss}
74	append result "\n"
75	}
76	return $result
77	}
78
79	#
80	# get_mapper_size
81	#
82	set_help_text get_mapper_size \
83	{Returns the size of the memory mapper in a given slot.
84	Result is 0 when there is no memory mapper in the slot.}
85	proc get_mapper_size {ps ss} {
86	set result 0
87	catch { ;# for multi-mem devices, but those aren't memory mappers
88	set device [lindex [machine_info slot $ps $ss 0] 0]
89	if {[debug desc $device] eq "memory mapper"} {
90	set result [expr {[debug size $device] / 0x4000}]
91	}
92	}
93	return $result
94	}
95
96	#
97	# get (rom) block size
98	# e.g. for a 'Konami' rom mapper it returns 8kB
99	# TODO it would be nice to generalize this so that it also works for memory
100	# mappers, or even all memory mapped devices (whether they have switchable
101	# blocks or not)
102	#
103	proc get_block_size {ps ss page} {
104	set block_size 0
105	catch {
106	set device_list [machine_info slot $ps $ss $page]
107	if {[llength $device_list] != 1} {return 0}
108	set device_info [machine_info device [lindex $device_list 0]]
109	set romtype [dict get $device_info "mappertype"] ;# can return ""
110	set romtype_info [openmsx_info romtype $romtype] ;# fails if romtype == ""
111	set block_size [dict get $romtype_info blocksize];# could fail??
112	}
113	return $block_size
114	}
115
116	#
117	# pc_in_slot
118	#
119	set_help_text pc_in_slot \
120	{Test whether the CPU's program counter is inside a certain slot.
121	Typically used to set breakpoints in specific slots.}
122	proc pc_in_slot {ps {ss "X"} {mapper "X"}} {
123	return [address_in_slot [reg PC] $ps $ss $mapper]
124	}
125
126	#
127	# watch_in_slot
128	#
129	set_help_text watch_in_slot \
130	{Test whether the address watched is inside a certain slot.
131	To be used only to set watchpoints in specific slots.}
132	proc watch_in_slot {ps {ss "X"} {mapper "X"}} {
133	return [address_in_slot $::wp_last_address $ps $ss $mapper]
134	}
135
136	#
137	# helper proc for pc_in_slot and watch_in_slot
138	#
139	set_help_text address_in_slot \
140	{Test whether an address is inside a certain slot.
141	Typically used by pc_in_slot and watch_in_slot.}
142	proc address_in_slot {addr ps {ss "X"} {block "X"}} {
143	# get current page and slots
144	set page [expr {$addr >> 14}]
145	lassign [get_selected_slot $page] pc_ps pc_ss
146
147	# check primary and secondary slot
148	if {($ps ne "X") && ($pc_ps != $ps)} {return 0}
149	if {($ss ne "X") && ($pc_ss ne "X") && ($pc_ss != $ss)} {return 0}
150
151	# need to check block?
152	if {$block eq "X"} {return true}
153
154	# first (try to) check memory mapper
155	if {$pc_ss eq "X"} {set pc_ss 0}
156	set mapper_size [get_mapper_size $pc_ps $pc_ss]
157	if {$mapper_size != 0} {
158	set pc_block [debug read "MapperIO" $page]
159	return [expr {$block == ($pc_block & ($mapper_size - 1))}]
160	}
161
162	# next (try to) check rom mapper
163	set block_size [get_block_size $pc_ps $pc_ss $page]
164	if {$block_size != 0} {
165	set device_name [lindex [machine_info slot $pc_ps $pc_ss $page] 0]
166	# note: I'm assuming that if get_block_size returns a non-zero
167	# value, then the "romblocks" debuggable always exixts.
168	# Is that correct?
169	set pc_block [debug read "$device_name romblocks" $addr]
170	return [expr {$block == $pc_block}]
171	}
172
173	# no mapper present, ok (or should we check block==0 ?)
174	return 1
175	}
176
177	#
178	# slotmap
179	#
180	set_help_text slotmap \
181	{Gives an overview of the devices in the different slots.}
182	proc slotmap_helper {ps ss} {
183	set result ""
184	for {set page 0} {$page < 4} {incr page} {
185	set device_list [machine_info slot $ps $ss $page]
186	# This 'if' introduces a parsing ambiguity (list of elements
187	# without embedded spaces versus single element with embedded
188	# spaces) though usually this looks nicer.
189	# Though this means the output of this script should not be
190	# further parsed in scripts.
191	if {[llength $device_list] == 1} {
192	set name [lindex $device_list 0]
193	} else {
194	set name $device_list
195	}
196	append result [format "%04X: %s\n" [expr {$page * 0x4000}] $name]
197	}
198	return $result
199	}
200	proc slotmap_name {ps ss} {
201	set t [list $ps $ss]
202	foreach slot [machine_info external_slot] {
203	if {[lrange [machine_info external_slot $slot] 0 1] eq $t} {
204	return " (${slot})"
205	}
206	}
207	return ""
208	}
209	proc slotmap {} {
210	set result ""
211	for {set ps 0} {$ps < 4} {incr ps} {
212	if {[machine_info issubslotted $ps]} {
213	for {set ss 0} {$ss < 4} {incr ss} {
214	append result "slot $ps.$ss[slotmap_name $ps $ss]:\n"
215	append result [slotmap_helper $ps $ss]
216	}
217	} else {
218	append result "slot $ps[slotmap_name $ps X]:\n"
219	append result [slotmap_helper $ps 0]
220	}
221	}
222	return $result
223	}
224
225	#
226	# iomap
227	#
228	set_help_text iomap \
229	{Gives an overview of the devices connected to the different I/O ports.}
230	proc iomap_helper {prefix begin end name} {
231	if {$name eq ""} {return ""}
232	set result [format "port %02X" $begin]
233	if {$begin == ($end - 1)} {
234	append result ": "
235	} else {
236	append result [format "-%02X:" [expr {$end - 1}]]
237	}
238	append result " $prefix $name\n"
239	}
240	proc iomap {} {
241	set result ""
242	set port 0
243	while {$port < 256} {
244	set in [machine_info input_port $port]
245	set out [machine_info output_port $port]
246	set end [expr {$port + 1}]
247	while {($end < 256) &&
248	($in eq [machine_info input_port $end]) &&
249	($out eq [machine_info output_port $end])} {
250	incr end
251	}
252	if {$in eq $out} {
253	append result [iomap_helper "I/O" $port $end [join $in ", "]]
254	} else {
255	append result [iomap_helper "I " $port $end [join $in ", "]]
256	append result [iomap_helper " O" $port $end [join $out ", "]]
257	}
258	set port $end
259	}
260	return $result
261	}
262
263	namespace export get_selected_slot
264	namespace export slotselect
265	namespace export get_mapper_size
266	namespace export pc_in_slot
267	namespace export watch_in_slot
268	namespace export address_in_slot
269	namespace export slotmap
270	namespace export iomap
271
272	} ;# namespace slot
273
274	namespace import slot::*

Keyboard