-
Notifications
You must be signed in to change notification settings - Fork 33
/
assembler.lisp
150 lines (125 loc) · 5.47 KB
/
assembler.lisp
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
(in-package :6502-tests)
(def-suite assembler :in 6502-tests)
(in-suite assembler)
(defmacro bvec (&rest args)
"Construct a byte vector from ARGS where ARGS are symbols representing hex."
(let ((nums (cl-ppcre:split " " (format nil "~{~A~^ ~}" args))))
`(vector ,@(mapcar (lambda (x) (parse-integer x :radix 16)) nums))))
(deftest assemble-ignores-case
"Case shouldn't come into play in assembly."
(is (equalp (asm "brk") #(0)))
(is (equalp (asm "BRK") #(0)))
(is (equalp (asm "bRK") #(0)))
(is (equalp (asm "LSR a") #(#x4a)))
(is (equalp (asm "lsr A") #(#x4a))))
(deftest assemble-implied
"Implied mode instructions should be assembled correctly."
(is (equalp (asm "nop") #(#xea)))
(is (equalp (asm '(:nop)) #(#xea))))
(deftest assemble-accumulator
"Accumulator mode instructions should be assembled correctly."
(is (equalp (asm "rol a") #(#x2a)))
(is (equalp (asm '(:rol :a)) #(#x2a))))
(deftest assemble-immediate
"Immediate mode instructions should be assembled correctly."
(let ((expected (bvec a9 12)))
(is (equalp (asm "lda #$12") expected))
(is (equalp (asm '(:lda :#$12)) expected))))
(deftest assemble-immediate-decimal
"Immediate mode using decimal should be assembled correctly."
(let ((expected (bvec a9 0c)))
(is (equalp (asm "lda #12") expected))
(is (equalp (asm '(:lda :#12)) expected))))
(deftest assemble-zero-page
"Zero-page mode instructions should be assembled correctly."
(let ((expected (bvec a5 03)))
(is (equalp (asm "lda $03") expected))
(is (equalp (asm '(:lda :$03)) expected))))
(deftest assemble-zero-page-x
"Zero-page-x mode instructions should be assembled correctly."
(let ((expected (bvec b5 03)))
(is (equalp (asm "lda $03, x") expected))
(is (equalp (asm '(:lda :$03.x)) expected))))
(deftest assemble-zero-page-y
"Zero-page-y mode instructions should be assembled correctly."
(let ((expected (bvec b6 03)))
(is (equalp (asm "ldx $03, y") expected))
(is (equalp (asm '(:ldx :$03.y)) expected))))
(deftest assemble-absolute
"Absolute mode instructions should be assembled correctly."
(let ((expected (bvec ed 11 1)))
(is (equalp (asm "sbc $0111") expected))
(is (equalp (asm '(:sbc :$0111)) expected))))
(deftest assemble-absolute-x
"Absolute-x mode instructions should be assembled correctly."
(let ((expected (bvec bd 34 12)))
(is (equalp (asm "lda $1234, x") expected))
(is (equalp (asm '(:lda :$1234.x)) expected))))
(deftest assemble-absolute-y
"Absolute-y mode instructions should be assembled correctly."
(let ((expected (bvec b9 34 12)))
(is (equalp (asm "lda $1234, y") expected))
(is (equalp (asm '(:lda :$1234.y)) expected))))
(deftest assemble-indirect
"Indirect mode instructions should be assembled correctly."
(let ((expected (bvec 6c 34 12)))
(is (equalp (asm "jmp ($1234)") expected))
(is (equalp (asm '(:jmp :@1234)) expected))))
(deftest assemble-indirect-x
"Indirect-x mode instructions should be assembled correctly."
(let ((expected (bvec a1 12)))
(is (equalp (asm "lda ($12), x") expected))
(is (equalp (asm '((:lda :@12.x))) expected))))
(deftest assemble-indirect-y
"Indirect-y mode instructions should be assembled correctly."
(let ((expected (bvec b1 34)))
(is (equalp (asm "lda ($34), y") expected))
(is (equalp (asm '(:lda :@34.y)) expected))))
(deftest assemble-relative
"Relative mode instructions should be assembled correctly."
(let ((expected (bvec d0 fd)))
(is (equalp (asm "bne &fd") expected))
(is (equalp (asm '(:bne :&fd)) expected))))
(deftest assemble-comment
"Comments (;) should be ignored. Code before comments should not be ignored."
(is (equalp (asm " ; blah blah blah") #()))
(is (equalp (asm " BRK ; foo bar baz") #(0))))
(deftest assemble-program
"A basic program should assemble correctly."
(let ((code (format nil "CLC~% LDA #$00~% LDY #$00~%
INY~% bne &fd~% sbc $0001~% brk")))
(is (equalp (asm code) #(24 169 0 160 0 200 208 253 229 1 0)))
(setf (get-range 0) (asm code) (cpu-pc cpu) 0)
(cl-6502:execute cpu)
(is (eql (cpu-ar cpu) 86))))
(deftest assemble-forward-relative
"A program with a forward relative jump should assemble correctly."
(let ((code (format nil "CLC~% LDA #$00~% LDY #$00~% bne &02~% nop~%
nop~% INY~% bne &fd~% sbc $0001~% brk")))
(setf (get-range 0) (asm code) (cpu-pc cpu) 0)
(cl-6502:execute cpu)
(is (eql (cpu-ar cpu) 86))))
(deftest assemble-symbolic
"A sexp-format program should assemble correctly."
(is (equalp (asm '(:brk)) #(0)))
(is (equalp (asm '(:nop)) #(234))))
(deftest assemble-symbolic-with-args
"A sexp-format program with args should assemble correctly."
(let ((code '((:ldy :#$00)
(:iny)
(:bne :&fd)
(:sbc :$0123))))
(is (equalp (asm code) #(160 0 200 208 253 237 35 1)))))
(deftest assemble-back-label-absolute
"A program with a back reference label in an absolute jump should
assemble correctly."
(let ((code (format nil "nop~%start:~%lda $1000~%jmp start"))
(expected (bvec ea ad 00 10 4c 01 00)))
(is (equalp (asm code) expected))))
(deftest assemble-back-label-relative
"A program with a back reference label in a relative jump should
assemble correctly."
(let ((code (format nil "nop~%start:~%lda $1000~%bne start"))
(expected (bvec ea ad 00 10 d0 fb)))
(is (equalp (asm code) expected))))
; (deftest assemble-pc "*" nil)?