blob: f99a0d6344849dbbba443a6481f4ee64d5397a8d (
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
|
(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 must-match [fnm a e]
(if (= a e) true
(io.stderr:write (.. "\n -> in field " fnm ", expected " (tostring e) " but found " (tostring a) "\n"))
(os.exit 1)))
(fn u8-flag? [v f] (not (= (band v f) 0)))
(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)))
(e:emulate)
(let [f tc.final]
(must-match :pc (e:pc) f.pc)
(must-match :sp (e:reg l6502.reg.SP) f.s)
(must-match :a (e:reg l6502.reg.A) f.a)
(must-match :x (e:reg l6502.reg.X) f.x)
(must-match :y (e:reg l6502.reg.Y) f.y))
(io.stderr:write " done\n")
)
(fn run-tests-file [e p]
(let [tcs (json.decode (slurp p))]
(each [_ tc (ipairs tcs)]
(run-test e tc))))
(let [e (l6502.new)]
(for [i 0x00 0xff]
(run-tests-file e (string.format "testcases/6502/v1/%02x.json" i))
))
|
