OXYGENHUB
◆ main openmsx / share / scripts / _cpuregs.tcl
2.9 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
e8555c89 Andy McCall 1 
namespace eval cpuregs {
2
3 
# reg command
4
5 
set_help_text reg \
6 
{Convenience procs to read or write Z80 registers.
7 
Usage is similar to the builtin Tcl proc 'set'
8
9 
 usage:
10 
   reg <reg>            read from a Z80 register
11 
   reg <reg> <value>    write to a Z80 register
12
13 
     <reg> must be one of
14 
        A   F   B   C   D   E   H   L
15 
        A2  F2  B2  C2  D2  E3  H2  L2
16 
        IXl IXh IYl IYh PCh PCl SPh SPl
17 
        I   R   IM  IFF
18 
        AF  BC  DE  HL
19 
        AF2 BC2 DE2 HL2
20 
        IX  IY  PC  SP
21
22 
 examples:
23 
   reg E           read register E
24 
   reg HL          read register HL
25 
   reg C 7         write 7 to register C
26 
   reg AF 0x1234   write 0x12 to register A and 0x34 to F
27 
}
28
29 
variable regB [dict create \
30 
	A    0    F    1    B    2    C    3 \
31 
	D    4    E    5    H    6    L    7 \
32 
	A2   8    F2   9    B2  10    C2  11 \
33 
	D2  12    E2  13    H2  14    L2  15 \
34 
	IXH 16    IXL 17    IYH 18    IYL 19 \
35 
	PCH 20    PCL 21    SPH 22    SPL 23 \
36 
	I   24    R   25    IM  26    IFF 27 ]
37
38 
variable regW [dict create \
39 
	AF   0    BC   2    DE   4    HL   6 \
40 
	AF2  8    BC2 10    DE2 12    HL2 14 \
41 
	IX  16    IY  18    PC  20    SP  22 ]
42
43 
set_tabcompletion_proc reg [namespace code tab_reg] false
44
45 
proc tab_reg {args} {
46 
	variable regB
47 
	variable regW
48 
	concat [dict keys $regB] [dict keys $regW]
49 
}
50
51 
proc reg {name {val ""}} {
52 
	variable regB
53 
	variable regW
54
55 
	set name [string toupper $name]
56 
	if {[dict exists $regB $name]} {
57 
		set i [dict get $regB $name]
58 
		set single 1
59 
	} elseif {[dict exists $regW $name]} {
60 
		set i [dict get $regW $name]
61 
		set single 0
62 
	} else {
63 
		error "Unknown Z80 register: $name"
64 
	}
65 
	set d "CPU regs"
66 
	if {$val eq ""} {
67 
		if {$single} {
68 
			return [debug read $d $i]
69 
		} else {
70 
			return [expr {256 * [debug read $d $i] + [debug read $d [expr {$i + 1}]]}]
71 
		}
72 
	} else {
73 
		if {$single} {
74 
			debug write $d $i $val
75 
		} else {
76 
			debug write $d $i [expr {$val / 256}]
77 
			debug write $d [expr {$i + 1}] [expr {$val & 255}]
78 
		}
79 
	}
80 
}
81
82
83 
# cpuregs command
84
85 
set_help_text cpuregs "Gives an overview of all Z80 registers."
86
87 
proc cw {reg} {format "%04X" [reg $reg]}
88 
proc cb {reg} {format "%02X" [reg $reg]}
89
90 
proc cpuregs {} {
91 
	set result ""
92 
	append result "AF =[cw AF ]  BC =[cw BC ]  DE =[cw DE ]  HL =[cw HL ]\n"
93 
	append result "AF'=[cw AF2]  BC'=[cw BC2]  DE'=[cw DE2]  HL'=[cw HL2]\n"
94 
	append result "IX =[cw IX ]  IY =[cw IY ]  PC =[cw PC ]  SP =[cw SP ]\n"
95 
	append result "I  =[cb I  ]    R  =[cb R]    IM =[cb IM]    IFF=[cb IFF]"
96 
	return $result
97 
}
98
99
100 
# get_active_cpu
101
102 
set_help_text get_active_cpu "Returns the name of the active CPU ('z80' or 'r800')."
103
104 
proc get_active_cpu {} {
105 
	set result "z80"
106 
	catch {
107 
		# On non-turbor machines this debuggable doesn't exist
108 
		if {([debug read "S1990 regs" 6] & 0x20) == 0} {
109 
			set result "r800"
110 
		}
111 
	}
112 
	return $result
113 
}
114
115
116 
namespace export reg
117 
namespace export cpuregs
118 
namespace export get_active_cpu
119
120 
} ;# namespace cpuregs
121
122 
namespace import cpuregs::*