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