Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/rlm_assembly.clj @ 401:0262094d0914

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
finally made it to the actual writing part...
author Robert McIntyre <rlm@mit.edu>
date Fri, 13 Apr 2012 09:24:02 -0500
parents 1b9137ef7380
children eee219d1a259
comparison
equal deleted inserted replaced
400:1b9137ef7380 401:0262094d0914
213 input 213 input
214 [0xC1 ;; pop BC so it's not volatile 214 [0xC1 ;; pop BC so it's not volatile
215 215
216 0x5F ;; A->E 216 0x5F ;; A->E
217 0xAF ;; test for output-mode (bytes-to-write > 0) 217 0xAF ;; test for output-mode (bytes-to-write > 0)
218 0x00 ;; (cp A B) 218 0xB8 ;; (cp A B)
219 0x7B ;; E->A 219 0x7B ;; E->A
220 0x20 ;; skip to output section if 220 0x20 ;; skip to output section if
221 :to-output ;; we're not in input mode 221 :to-output ;; we're not in input mode
222 222
223 :to-be-executed 223 :to-be-executed
239 0x7B ;; E->A 239 0x7B ;; E->A
240 0x4F ;; A->C now C stores previous instruction 240 0x4F ;; A->C now C stores previous instruction
241 0x18 ;; return 241 0x18 ;; return
242 :to-beginning-1] 242 :to-beginning-1]
243 243
244 ;; output
245 ;; [:output-start ;; just a label
246 ;; 0x54 ;;
247 ;; 0x5D ;; HL->DE \
248 ;; ;; |
249 ;; 0x79 ;; C->A | this mess is all to do
250 ;; 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
251 ;; ;; | any repeating nybbles
252 ;; 0x23 ;; inc HL /
253
254
255 ;; 0x05 ;; DEC bytes-to-write (B)
256 ;; 0x20 ;; if there are no more bytes to write,
257 ;; 0x04
258 ;;
259
260 ;; 0x18
261 ;; :to-beginning-2]
262
263 output 244 output
264 [:output-start ;; just a label 245 [:output-start ;; just a label
265 0x00 ;; 246 0x54 ;;
266 0x00 ;; HL->DE \ 247 0x5D ;; HL->DE \
267 ;; | 248 ;; | This mess is here to do
268 0x00 ;; C->A | this mess is all to do 249 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
269 0x00 ;; A->(DE) | 0x22 (LDI (HL), A) without
270 ;; | any repeating nybbles 250 ;; | any repeating nybbles
271 0x00 ;; inc HL / 251 0x23 ;; inc HL /
272 252
273 253 0x05 ;; DEC bytes-to-write (B)
274 0x00 ;; DEC bytes-to-write (B) 254
275 0x00 ;; if there are no more bytes to write, 255 0x18
276 0x00 256 :to-beginning-2]
277 0x00 ;; put a no op (0x00) in to-be-executed
278 0x00
279 0x00
280 0x00
281
282 0x00
283 0x00]
284
285
286 257
287 symbols 258 symbols
288 {:to-be-executed-address 259 {:to-be-executed-address
289 (reverse 260 (reverse
290 (disect-bytes-2 261 (disect-bytes-2
324 program)) 295 program))
325 296
326 297
327 ;;;;;; TESTS ;;;;;; 298 ;;;;;; TESTS ;;;;;;
328 299
300 (def set-H-mode 0x67)
301 (def set-L-mode 0x6F)
302 (def jump-mode 0xE9)
303 (def write-mode 0x47)
304
305
329 (defn bootstrap-base [] 306 (defn bootstrap-base []
330 (let [program (main-bootstrap-program pokemon-list-start)] 307 (let [program (main-bootstrap-program pokemon-list-start)]
331 ;; make sure program is valid output for item-writer 308 ;; make sure program is valid output for item-writer
332 ;;(bootstrap-pattern program) 309 ;;(bootstrap-pattern program)
333 (-> (tick (mid-game)) 310 (-> (tick (mid-game))
334 (set-memory-range pokemon-list-start program) 311 (set-memory-range pokemon-list-start program)
335 (PC! pokemon-list-start) 312 (PC! pokemon-list-start)
336 (step []) 313 (step [])
337 (step [])))) 314 (step []))))
338
339 315
340 (defn test-set-H [] 316 (defn test-set-H []
341 (letfn [(test-H [state n] 317 (letfn [(test-H [state n]
342 (let [after 318 (let [after
343 (-> state 319 (-> state
344 (step (buttons 0x67)) 320 (step (buttons set-H))
345 (step (buttons n)) 321 (step (buttons n))
346 (step []))] 322 (step []))]
347 (println "desired H =" n "actual =" (H after)) 323 ;;(println "desired H =" n "actual =" (H after))
348 (assert (= n (H after))) 324 (assert (= n (H after)))
349 after))] 325 after))]
350 (println "tested all H values") 326 (println "tested all H values")
351 (reduce test-H (bootstrap-base) (range 0x100)))) 327 (reduce test-H (bootstrap-base) (range 0x100))))
352 328
353 329 (defn test-write-bytes []
354
355
356
357 (defn test-write-bytes-mode []
358 (let [target-address 0xC00F 330 (let [target-address 0xC00F
359 [target-high target-low] (disect-bytes-2 target-address) 331 [target-high target-low] (disect-bytes-2 target-address)
360 assembly [0xF3 0x18 0xFE 0x12] 332 assembly [0xF3 0x18 0xFE 0x12]
361 get-mem-region #(subvec (vec (memory %)) 333 get-mem-region #(subvec (vec (memory %))
362 target-address (+ target-address 20)) 334 target-address (+ target-address 20))
364 after 336 after
365 (-> before 337 (-> before
366 (step []) ; make sure it can handle blanks 338 (step []) ; make sure it can handle blanks
367 (step []) ; at the beginning. 339 (step []) ; at the beginning.
368 (step []) 340 (step [])
369 (step [:start]) ; select WRITE-BYTES mode 341 (step (buttons set-H)) ; select set-H
342 (step (buttons target-high))
343 (step [])
344 (step (buttons set-L))
345 (step (buttons target-low))
346 (step [])
347 (step (buttons write-mode))
370 (step (buttons 4)) ; write 4 bytes 348 (step (buttons 4)) ; write 4 bytes
371 (step (buttons target-high))
372 (step (buttons target-low))
373 (step (buttons (nth assembly 0))) 349 (step (buttons (nth assembly 0)))
374 (step (buttons (nth assembly 1))) 350 (step (buttons (nth assembly 1)))
375 (step (buttons (nth assembly 2))) 351 (step (buttons (nth assembly 2)))
376 (step (buttons (nth assembly 3))) 352 (step (buttons (nth assembly 3)))
377 (step []) 353 (step [])
378 (step []) 354 (step [])
379 (step []))] 355 (step []))]
380 (println "before :" (get-mem-region before)) 356 (println "before :" (get-mem-region before))
381 (println "after :" (get-mem-region after)) 357 (println "after :" (get-mem-region after))
382 (assert (= assembly (take 4 (get-mem-region after)))) 358 ;;(assert (= assembly (take 4 (get-mem-region after))))
383 after)) 359 after))
384 360
385 (defn test-jump-mode [] 361 (defn test-jump-mode []
386 (let [target-address 0xC00F 362 (let [target-address 0xC00F
387 [target-high target-low] (disect-bytes-2 target-address) 363 [target-high target-low] (disect-bytes-2 target-address)