Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/rlm_assembly.clj @ 403:ea37e98e188e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
removed one opcode
author Robert McIntyre <rlm@mit.edu>
date Fri, 13 Apr 2012 09:59:32 -0500
parents eee219d1a259
children 41647cb85901
comparison
equal deleted inserted replaced
402:eee219d1a259 403:ea37e98e188e
68 68
69 (defn ->signed-8-bit [n] 69 (defn ->signed-8-bit [n]
70 (if (< n 0) 70 (if (< n 0)
71 (+ 256 n) n)) 71 (+ 256 n) n))
72 72
73 (defn frame-metronome [] 73 (defn frame-metronome
74 (let [init [0xC5] ;; save value of BC 74 ([] (frame-metronome true))
75 timing-loop 75 ([spin-loop?]
76 [0x01 ; \ 76 (let [init [0xC5] ;; save value of BC
77 0x43 ; | 77 timing-loop
78 0xFE ; | load 0xFF44 into BC without repeats 78 [0x01 ; \
79 0x0C ; | 79 0x43 ; |
80 0x04 ; / 80 0xFE ; | load 0xFF44 into BC without repeats
81 0x0A] ;; (BC) -> A, now A = LY (vertical line coord) 81 0x0C ; |
82 continue-if-144 82 0x04 ; /
83 [0xFE 83 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
84 144 ;; compare LY (in A) with 144 84 continue-if-144
85 0x20 ;; jump back to beginning if LY != 144 (not-v-blank) 85 [0xFE
86 (->signed-8-bit 86 144 ;; compare LY (in A) with 144
87 (+ -4 (- (count timing-loop))))] 87 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
88 spin-loop 88 (->signed-8-bit
89 [0x05 ;; dec B, which is 0xFF 89 (+ -4 (- (count timing-loop))))]
90 0x20 ;; spin until B==0 90 spin-loop
91 0xFD]] 91 [0x05 ;; dec B, which is 0xFF
92 (concat init timing-loop continue-if-144 spin-loop))) 92 0x20 ;; spin until B==0
93 0xFD]]
94 (concat init timing-loop continue-if-144
95 (if spin-loop?
96 spin-loop [])))))
93 97
94 (defn test-frame-metronome 98 (defn test-frame-metronome
95 "Ensure that frame-metronome ticks exactly once every frame." 99 "Ensure that frame-metronome ticks exactly once every frame."
96 ([] (test-frame-metronome 151)) 100 ([] (test-frame-metronome 151))
97 ([steps] 101 ([steps]
180 (fn [symbol sequence] 184 (fn [symbol sequence]
181 (count (take-while 185 (count (take-while
182 (partial not= symbol) 186 (partial not= symbol)
183 sequence)))) 187 sequence))))
184 188
185 189 (defn main-bootstrap-program
186 (defn main-bootstrap-program [start-address] 190 ([] (main-bootstrap-program pokemon-list-start))
187 ;; Register Use: 191 ([start-address]
188 192 ;; Register Use:
189 ;; ED non-volitale scratch 193
190 194 ;; ED non-volitale scratch
191 ;; A user-input 195
192 ;; HL target-address 196 ;; A user-input
193 ;; B bytes-to-write 197 ;; HL target-address
194 ;; C non-volatile scratch 198 ;; B bytes-to-write
195 199 ;; C non-volatile scratch
196 ;; Modes (with codes) are: 200
197 201 ;; Modes (with codes) are:
198 ;; single-action-modes: 202
199 ;; SET-TARGET-HIGH 0x67 ;; A->H 203 ;; single-action-modes:
200 ;; SET-TARGET-LOW 0x6F ;; A->L 204 ;; SET-TARGET-HIGH 0x67 ;; A->H
201 ;; JUMP 0xE9 ;; jump to (HL) 205 ;; SET-TARGET-LOW 0x6F ;; A->L
202 206 ;; JUMP 0xE9 ;; jump to (HL)
203 ;; multi-action-modes 207
204 ;; WRITE 0x47 ;; A->B 208 ;; multi-action-modes
205 209 ;; WRITE 0x47 ;; A->B
206 (let [[start-high start-low] (disect-bytes-2 start-address) 210
207 jump-distance (+ (count (frame-metronome)) 211 (let [[start-high start-low] (disect-bytes-2 start-address)
208 (count (read-user-input))) 212 jump-distance (+ (count (frame-metronome))
209 213 (count (read-user-input)))
210 init 214
211 [0xAF 0x4F 0x57 0x47] ;; 0->A; 0->C; 0->D; 0->B 215 init
212 216 [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
213 input 217
214 [0xC1 ;; pop BC so it's not volatile 218 input
215 219 [0xC1 ;; pop BC so it's not volatile
216 0x5F ;; A->E 220
217 0xAF ;; test for output-mode (bytes-to-write > 0) 221 0x5F ;; A->E
218 0xB8 ;; (cp A B) 222 0xAF ;; test for output-mode (bytes-to-write > 0)
219 0x7B ;; E->A 223 0xB8 ;; (cp A B)
220 0x20 ;; skip to output section if 224 0x7B ;; E->A
221 :to-output ;; we're not in input mode 225 0x20 ;; skip to output section if
222 226 :to-output ;; we're not in input mode
223 :to-be-executed 227
224 228 :to-be-executed
225 ;; write mode to instruction-to-be-executed (pun) 229
226 0xEA 230 ;; write mode to instruction-to-be-executed (pun)
227 :to-be-executed-address 231 0xEA
228 232 :to-be-executed-address
229 ;; protection region -- do not queue this op for 233
230 ;; execution if the last one was non-zero 234 ;; protection region -- do not queue this op for
231 0x79 ;; C->A 235 ;; execution if the last one was non-zero
232 0xA7 ;; test A==0 236 0x79 ;; C->A
233 0x28 237 0xA7 ;; test A==0
234 0x04 238 0x28
235 0xAF ;; put a no op (0x00) in to-be-executed 239 0x04
236 0xEA ;; 240 0xAF ;; put a no op (0x00) in to-be-executed
237 :to-be-executed-address 241 0xEA ;;
238 242 :to-be-executed-address
239 0x7B ;; E->A 243
240 0x4F ;; A->C now C stores previous instruction 244 0x7B ;; E->A
241 0x18 ;; return 245 0x4F ;; A->C now C stores previous instruction
242 :to-beginning-1] 246 0x18 ;; return
243 247 :to-beginning-1]
244 output 248
245 [:output-start ;; just a label 249 output
246 0x54 ;; 250 [:output-start ;; just a label
247 0x5D ;; HL->DE \ 251 0x54 ;;
248 ;; | This mess is here to do 252 0x5D ;; HL->DE \
249 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without 253 ;; | This mess is here to do
250 ;; | any repeating nybbles 254 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
251 0x23 ;; inc HL / 255 ;; | any repeating nybbles
252 256 0x23 ;; inc HL /
253 0x05 ;; DEC bytes-to-write (B) 257
254 258 0x05 ;; DEC bytes-to-write (B)
255 0x18 259
256 :to-beginning-2] 260 0x18
257 261 :to-beginning-2]
258 symbols 262
259 {:to-be-executed-address 263 symbols
260 (reverse 264 {:to-be-executed-address
261 (disect-bytes-2 265 (reverse
262 (+ start-address jump-distance 266 (disect-bytes-2
263 (count init) 267 (+ start-address jump-distance
264 (symbol-index :to-be-executed input)))) 268 (count init)
265 :to-be-executed 0x00} ;; clear carry flag no-op 269 (symbol-index :to-be-executed input))))
266 270 :to-be-executed 0x00} ;; clear carry flag no-op
267 program** (flatten 271
268 (replace 272 program** (flatten
269 symbols 273 (replace
270 (concat init (frame-metronome) 274 symbols
271 (read-user-input) 275 (concat init (frame-metronome)
272 input output))) 276 (read-user-input)
273 resolve-internal-jumps 277 input output)))
274 {:output-start [] 278 resolve-internal-jumps
275 :to-output 279 {:output-start []
276 (->signed-8-bit 280 :to-output
277 (dec 281 (->signed-8-bit
278 (- (symbol-index :output-start program**) 282 (dec
279 (symbol-index :to-output program**))))} 283 (- (symbol-index :output-start program**)
280 284 (symbol-index :to-output program**))))}
281 program* 285
282 (flatten (replace resolve-internal-jumps program**)) 286 program*
283 287 (flatten (replace resolve-internal-jumps program**))
284 resolve-external-jumps 288
285 {:to-beginning-1 289 resolve-external-jumps
286 (->signed-8-bit 290 {:to-beginning-1
287 (+ (count init) 291 (->signed-8-bit
288 -2 (- (dec (symbol-index :to-beginning-1 program*))))) 292 (+ (count init)
289 :to-beginning-2 293 -2 (- (dec (symbol-index :to-beginning-1 program*)))))
290 (->signed-8-bit 294 :to-beginning-2
291 (+ (count init) 295 (->signed-8-bit
292 -2 (- (dec (symbol-index :to-beginning-2 program*)))))} 296 (+ (count init)
293 297 -2 (- (dec (symbol-index :to-beginning-2 program*)))))}
294 program 298
295 (replace resolve-external-jumps program*)] 299 program
296 program)) 300 (replace resolve-external-jumps program*)]
301 program)))
297 302
298 303
299 ;;;;;; TESTS ;;;;;; 304 ;;;;;; TESTS ;;;;;;
300 305
301 (def set-H-mode 0x67) 306 (def set-H-mode 0x67)
322 (step (buttons n)) 327 (step (buttons n))
323 (step []))] 328 (step []))]
324 ;;(println "desired H =" n "actual =" (H after)) 329 ;;(println "desired H =" n "actual =" (H after))
325 (assert (= n (H after))) 330 (assert (= n (H after)))
326 after))] 331 after))]
327 (println "tested all H values") 332 (let [result (reduce test-H (bootstrap-base) (range 0x100))]
328 (reduce test-H (bootstrap-base) (range 0x100)))) 333 (println "tested all H values")
334 result)))
329 335
330 (defn test-write-bytes [] 336 (defn test-write-bytes []
331 (let [target-address 0xC00F 337 (let [target-address 0xC00F
332 [target-high target-low] (disect-bytes-2 target-address) 338 [target-high target-low] (disect-bytes-2 target-address)
333 assembly [0xF3 0x18 0xFE 0x12] 339 assembly [0xF3 0x18 0xFE 0x12]