blob: a50bfd6021086d4189de8dff7fc7b4e30c079a2a (
plain)
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
|
(local json (require :json))
(local inspect (require :inspect))
(local l6502 (require :l6502-lua))
(fn slurp [path]
(let [f (io.open path)]
(f:read "*all")))
(fn contains? [x xs]
(each [_ y (pairs xs)]
(when (= x y)
(lua "return true")))
nil)
(fn must-match [st fnm a e]
(if (= a e) true
true
(do
(io.stderr:write (.. "\n -> in field " fnm ", expected " (tostring e) " but found " (tostring a)))
;; (io.stderr:write (.. "\n -> initial emulator state:\n" (inspect st.initial)))
(io.stderr:write (.. "\n -> final emulator state:\n" (inspect st.final)))
(io.stderr:write "\n")
(os.exit 1))))
(fn u8-flag? [v f] (not (= (band v f) 0)))
(local flag-masks
{ :carry l6502.flag.CARRY
:zero l6502.flag.ZERO
:interrupt_disable l6502.flag.INTERRUPT_DISABLE
:decimal l6502.flag.DECIMAL
:break_command l6502.flag.BREAK_COMMAND
:overflow l6502.flag.OVERFLOW
:negative l6502.flag.NEGATIVE
})
(fn must-match-flag [st e nm f]
(must-match st nm (e:flag (. flag-masks nm)) (u8-flag? f.p (. flag-masks nm))))
(fn summary-compare-testcase [e s t]
(fn ae [actual expected] { : actual : expected })
{ :pc (ae s.pc t.pc)
:regs
{ :sp (ae s.regs.sp t.s)
:a (ae s.regs.a t.a)
:x (ae s.regs.x t.x)
:y (ae s.regs.y t.y)
:flags (ae s.regs.flags t.p)
}
:flags
(collect [nm mask (pairs flag-masks)]
(values nm (ae (. s.flags nm) (if (u8-flag? t.p mask) 1 0))))
:ram
(collect [_ [addr v] (ipairs t.ram)]
(values (.. :addr (tostring addr)) (ae (e:read addr) v)))
})
(fn run-test [e tc]
(io.stderr:write (.. "running test: " tc.name "..."))
(let [i tc.initial]
(e:set-pc i.pc)
(e:set-reg l6502.reg.SP i.s)
(e:set-reg l6502.reg.A i.a)
(e:set-reg l6502.reg.X i.x)
(e:set-reg l6502.reg.Y i.y)
(e:set-reg l6502.reg.FLAGS i.p)
(each [_ [addr v] (ipairs i.ram)]
(e:write addr v)))
(let [ initial-summary (e:summary)
ins (e:emulate)
st
{ :initial (summary-compare-testcase e initial-summary tc.initial)
:final (summary-compare-testcase e (e:summary) tc.final)
}
f tc.final]
(io.stderr:write (.. " " ins "..."))
(must-match st :pc (e:pc) f.pc)
(must-match st :sp (e:reg l6502.reg.SP) f.s)
(must-match st :a (e:reg l6502.reg.A) f.a)
(must-match st :x (e:reg l6502.reg.X) f.x)
(must-match st :y (e:reg l6502.reg.Y) f.y)
(must-match-flag st e :carry f)
(must-match-flag st e :zero f)
(must-match-flag st e :interrupt_disable f)
(must-match-flag st e :decimal f)
(must-match-flag st e :break_command f)
(must-match-flag st e :overflow f)
(must-match-flag st e :negative f)
(each [_ [addr v] (ipairs f.ram)]
(must-match st (.. :addr (tostring addr)) (e:read addr) v)))
(io.stderr:write " done\n")
)
(local villains
[ 0x02 0x03 0x04 0x07 0x0b 0x0c 0x0f
0x12 0x13 0x14 0x17 0x1a 0x1b 0x1c 0x1f
0x22 0x23 0x27 0x2b 0x2f
0x32 0x33 0x34 0x37 0x3a 0x3b 0x3c 0x3f
0x42 0x43 0x44 0x47 0x4b 0x4f
0x52 0x53 0x54 0x57 0x5a 0x5b 0x5c 0x5f ;; 0x539 <3
0x62 0x63 0x64 0x67 0x6b 0x6f
0x72 0x73 0x74 0x77 0x7a 0x7b 0x7c 0x7f
0x80 0x82 0x83 0x87 0x89 0x8b 0x8f
0x92 0x93 0x97 0x9b 0x9c 0x9e 0x9f
0xa3 0xa7 0xab 0xaf
0xb2 0xb3 0xb7 0xbb 0xbf
0xc2 0xc3 0xc7 0xcb 0xcf
0xd2 0xd3 0xd4 0xd7 0xda 0xdb 0xdc 0xdf
0xe2 0xe3 0xe7 0xeb 0xef
0xf2 0xf3 0xf4 0xf7 0xfa 0xfb 0xfc 0xff
])
(fn run-tests-file [e p]
(let [tcs (json.decode (slurp p))]
(each [_ tc (ipairs tcs)]
(when (not (u8-flag? tc.initial.p l6502.flag.DECIMAL))
(run-test e tc)))))
(let [e (l6502.new)]
(for [i 0x00 0xff]
(when (not (contains? i villains))
(run-tests-file e (string.format "testcases/6502/v1/%02x.json" i)))))
|
