view clojure/com/aurellem/gb/rlm_assembly.clj @ 424:7bd806c4dbb6

changed assembly to handle mini-midi messages of different lengths.
author Robert McIntyre <rlm@mit.edu>
date Mon, 23 Apr 2012 04:45:55 -0500
parents 21b8b3350b20
children 9068685e7d96
line wrap: on
line source
1 (ns com.aurellem.gb.rlm-assembly
2 "Version of main bootstrap program that is valid output for the
3 item-writer program."
4 (:use (com.aurellem.gb gb-driver assembly util vbm constants))
5 (:import [com.aurellem.gb.gb_driver SaveState]))
7 (defn pc-item-writer-program
8 []
9 (let [limit 201
10 [target-high target-low] (disect-bytes-2 pokemon-list-start)]
11 (flatten
12 [[0x00 ;; (item-hack) set increment stack pointer no-op
13 0x1E ;; load limit into E
14 limit
15 0x3F ;; (item-hack) set carry flag no-op
17 ;; load 2 into C.
18 0x0E ;; C == 1 means input-first nybble
19 0x04 ;; C == 0 means input-second nybble
21 0x21 ;; load target into HL
22 target-low
23 target-high
24 0x37 ;; (item-hack) set carry flag no-op
26 0x00 ;; (item-hack) no-op
27 0x37 ;; (item-hack) set carry flag no-op
29 0x00 ;; (item-hack) no-op
30 0xF3 ;; disable interrupts
31 ;; Input Section
33 0x3E ;; load 0x20 into A, to measure buttons
34 0x10
36 0x00 ;; (item-hack) no-op
37 0xE0 ;; load A into [FF00]
38 0x00
40 0xF0 ;; load 0xFF00 into A to get
41 0x00 ;; button presses
43 0xE6
44 0x0F ;; select bottom four bits of A
45 0x37 ;; (item-hack) set carry flag no-op
47 0x00 ;; (item-hack) no-op
48 0xB8 ;; see if input is different (CP A B)
50 0x00 ;; (item-hack) (INC SP)
51 0x28 ;; repeat above steps if input is not different
52 ;; (jump relative backwards if B != A)
53 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
55 0x47 ;; load A into B
57 0x0D ;; dec C
58 0x37 ;; (item-hack) set-carry flag
59 ;; branch based on C:
60 0x20 ;; JR NZ
61 23 ;; skip "input second nybble" and "jump to target" below
63 ;; input second nybble
65 0x0C ;; inc C
66 0x0C ;; inc C
68 0x00 ;; (item-hack) no-op
69 0xE6 ;; select bottom bits
70 0x0F
71 0x37 ;; (item-hack) set-carry flag no-op
73 0x00 ;; (item-hack) no-op
74 0xB2 ;; (OR A D) -> A
76 0x22 ;; (do (A -> (HL)) (INC HL))
78 0x1D ;; (DEC E)
80 0x00 ;; (item-hack)
81 0x20 ;; jump back to input section if not done
82 0xDA ;; literal -36 == TM 18 (counter)
83 0x01 ;; (item-hack) set BC to literal (no-op)
85 ;; jump to target
86 0x00 ;; (item-hack) these two bytes can be anything.
87 0x01
89 0x00 ;; (item-hack) no-op
90 0xBF ;; (CP A A) ensures Z
92 0xCA ;; (item-hack) jump if Z
93 target-low
94 target-high
95 0x01 ;; (item-hack) will never be reached.
97 ;; input first nybble
98 0x00
99 0xCB
100 0x37 ;; swap nybbles on A
102 0x57 ;; A -> D
104 0x37 ;; (item-hack) set carry flag no-op
105 0x18 ;; relative jump backwards
106 0xCD ;; literal -51 == TM05; go back to input section
107 0x01 ;; (item-hack) will never reach this instruction
109 ]
110 (repeat 8 [0x00 0x01]);; these can be anything
112 [;; jump to actual program
113 0x00
114 0x37 ;; (item-hack) set carry flag no-op
116 0x2E ;; 0x3A -> L
117 0x3A
120 0x00 ;; (item-hack) no-op
121 0x26 ;; 0xD5 -> L
122 0xD5
123 0x01 ;; (item-hack) set-carry BC
125 0x00 ;; (item-hack) these can be anything
126 0x01
128 0x00
129 0xE9 ;; jump to (HL)
130 ]])))
134 ;; Specs for Main Bootstrap Program
136 ;; Number-Input
137 ;; Number input works using all eight buttons to
138 ;; spell out an 8 bit number. The order of buttons is
139 ;; [:d :u :l :r :start :select :b :a] --> 11111111
140 ;; [ :l :start :a] --> 00101001
142 ;;; MODES
143 ;; There are five modes in total:
144 ;; MODE-SELECT
145 ;; SET-H
146 ;; SET-L
147 ;; WRITE
148 ;; JUMP
150 ;;; MODE-SELECT
151 ;; The bootstrap program starts in MODE-SELECT mode.
152 ;; MODE-SELECT transitions to one of three modes depending
153 ;; on which buttons are pressed:
154 ;; 0 : MODE-SELECT
155 ;; 0x67 : SET-H
156 ;; 0x6F : SET-L
157 ;; 0x47 : WRITE
158 ;; 0xE9 : JUMP
160 ;;; SET-H
161 ;; SET-H sets the high 8 bits of the target address to which
162 ;; data will be written / the program will jump. It expects
163 ;; the following:
164 ;;
165 ;; Byte 0 : New Value of H
166 ;; Byte 1 : 0x00
168 ;;; SET-L
169 ;; This mode sets the low 8 bits of the target address and has
170 ;; the same semantics as SET-H.
172 ;;; WRITE-BYTES
173 ;; WRITE-BYTES mode writes sequences of arbitray values to
174 ;; arbitray memory locations. It expects you to enter a
175 ;; header of one byte describing how many bytes to write.
177 ;; Byte 0 : Number of Bytes to Write
179 ;; Then, you enter the number of bytes specified in Byte 0
180 ;; and they are written to the start address in sequence.
181 ;; After the last byte is written control returns to
182 ;; MODE-SELECT mode. The Target address will be incremented by
183 ;; Number of Bytes to Write once you are done writing.
185 ;; Example: to write the sequence [1 2 3 4] starting at
186 ;; the target address enter:
187 ;; Byte 0 : 4 (will write four bytes)
188 ;; Byte 3 : 1 (write 1 to 0xC01F)
189 ;; Byte 4 : 2 (write 2 to 0xC020)
190 ;; Byte 5 : 3 (write 3 to 0xC021)
191 ;; Byte 6 : 4 (write 4 to 0xC022)
193 ;;; JUMP
194 ;; JUMP mode jumps program control to the target address.
196 ;;; EXAMPLE
197 ;; To write the infinite loop program [0x18 0xFE] to address
198 ;; 0xC00F and then jump to said program, enter the following
199 ;; starting from MODE-SELECT mode.
201 ;; Byte 0 : 0x67 [:a :b :l :u :select] ;; SET-H mode
202 ;; Byte 1 : 0xC0 [:d :u] ;; 0xC0 -> H
203 ;; Byte 2 : 0x00 [] ;; trailer
205 ;; Byte 3 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
206 ;; Byte 4 : 0x0F [:a :start :b :select] ;; 0x0F -> L
207 ;; Byte 5 : 0x00 [] ;; trailer
209 ;; Byte 6 : 0x47 [:a :b :u :select] ;; WRITE-MODE
210 ;; Byte 7 : 0x02 [:b] ;; write 2 bytes
211 ;; Byte 8 : 0x18 [:r :start] ;; assembly
212 ;; Byte 9 : 0xFE [:r :start :b :d :l :u :select] ;; assembly
214 ;; target address is now 0xC011 since we wrote 2 bytes.
215 ;; set it back to 0xC00F.
217 ;; Byte 10 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
218 ;; Byte 12 : 0x0F [:a :start :b :select] ;; 0x0F -> L
219 ;; Byte 13 : 0x00 [] ;; trailer
221 ;; Byte 14 : 0xE9 ;; JUMP-MODE
223 (defn ->signed-8-bit [n]
224 (if (< n 0)
225 (+ 256 n) n))
227 (defn frame-metronome []
228 (let [init [0xC5] ;; save value of BC
229 timing-loop
230 [0x01 ; \
231 0x43 ; |
232 0xFE ; | load 0xFF44 into BC without repeats
233 0x0C ; |
234 0x04 ; /
235 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
236 continue-if-144
237 [0xFE
238 144 ;; compare LY (in A) with 144
239 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
240 (->signed-8-bit
241 (+ -4 (- (count timing-loop))))]
242 spin-loop
243 [0x05 ;; dec B, which is 0xFF
244 0x20 ;; spin until B==0
245 0xFD]]
246 (concat init timing-loop continue-if-144 spin-loop)))
248 (defn frame-metronome* []
249 [0x3E ;; smallest version, but uses repeated nybbles
250 0x01
251 0xE0
252 0xFF])
254 (defn frame-metronome** []
255 [0x06 ;; load 0xFE into B
256 0xFE
257 0x04 ;; inc B, now B == FF
259 0x3E ;; RLM-debug
260 0x01 ;; 1->A
262 0x48 ;; B->C
263 0x02]) ;; A->(BC) set exclusive v-blank interrupt
265 (defn test-frame-metronome
266 "Ensure that frame-metronome ticks exactly once every frame."
267 ([] (test-frame-metronome 151))
268 ([steps]
269 (let [inc-E [0x1C 0x18
270 (->signed-8-bit
271 (+ -3
272 (-(count (frame-metronome)))))]
274 program (concat (frame-metronome) inc-E)
275 count-frames
276 (-> (tick (mid-game))
277 (IE! 0)
278 (DE! 0)
279 (set-memory-range pokemon-list-start program)
280 (PC! pokemon-list-start))
281 E-after-moves
282 (E (run-moves count-frames (repeat steps [])))]
283 ;;(println "E:" E-after-moves)
284 (assert (= steps E-after-moves))
285 (println "frame-count test passed.")
286 count-frames)))
288 (defn read-user-input []
289 [0x3E
290 0x20 ; prepare to measure d-pad
292 0x3F ; clear carry flag no-op to prevent repeated nybbles
294 0x01 ;\
295 0x01 ; |
296 0xFE ; | load 0xFF00 into BC without repeats
297 0x04 ; |
298 0x0D ;/
300 0x02
301 0x0A ;; get D-pad info
303 0xF5 ;; push AF
305 0x3E
306 0x10 ; prepare to measure buttons
308 0x3F ;; clear carry flag no-op to prevent repeated nybbbles
310 0x02
311 0x0A ;; get button info
313 0xE6 ;; select bottom bits of A
314 0x0F
316 0x47 ;; A->B
318 0xF1 ;; pop AF
320 0xE6
321 0x0F ;; select bottom bits of A
323 0xCB
324 0x37 ;; swap A nybbles
326 0xB0 ;; (or A B) -> A
328 0x2F ;; (NOT A) -> A
329 ])
331 (defn test-read-user-input []
332 (let [program
333 (concat
334 (frame-metronome) (read-user-input)
335 [0x5F ;; A-> E
336 0x76
337 0x18
338 (->signed-8-bit
339 (+ (- (count (read-user-input)))
340 (- 4)))])
341 read-input
342 (-> (tick (mid-game))
343 (IE! 0)
344 (set-memory-range pokemon-list-start program)
345 (PC! pokemon-list-start))]
346 (dorun
347 (for [i (range 0x100)]
348 (assert (= (E (step read-input (buttons i))) i))))
349 (println "tested all inputs.")
350 read-input))
352 (def symbol-index
353 (fn [symbol sequence]
354 (count (take-while
355 (partial not= symbol)
356 sequence))))
358 (defn main-bootstrap-program
359 ([] (main-bootstrap-program pokemon-list-start))
360 ([start-address]
361 ;; Register Use:
363 ;; ED non-volitale scratch
365 ;; A user-input
366 ;; HL target-address
367 ;; B bytes-to-write
368 ;; C non-volatile scratch
370 ;; Modes (with codes) are:
372 ;; single-action-modes:
373 ;; SET-TARGET-HIGH 0x67 ;; A->H
374 ;; SET-TARGET-LOW 0x6F ;; A->L
375 ;; JUMP 0xE9 ;; jump to (HL)
377 ;; multi-action-modes
378 ;; WRITE 0x47 ;; A->B
380 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
381 header (concat (frame-metronome) (read-user-input))
383 input
384 [0xC1 ;; pop BC so it's not volatile
386 0x5F ;; A->E
387 0xAF ;; test for output-mode (bytes-to-write > 0)
388 0xB8 ;; (cp A B)
389 0x7B ;; E->A
390 0x20 ;; skip to output section if
391 :to-output ;; we're not in input mode
393 :to-be-executed
395 ;; write mode to instruction-to-be-executed (pun)
396 0xEA
397 :to-be-executed-address
399 ;; protection region -- do not queue this op for
400 ;; execution if the last one was non-zero
401 0x79 ;; C->A
402 0xA7 ;; test A==0
403 0x28
404 0x04
405 0xAF ;; put a no op (0x00) in to-be-executed
406 0xEA ;;
407 :to-be-executed-address
409 0x7B ;; E->A
410 0x4F ;; A->C now C stores previous instruction
411 0x18 ;; return
412 :to-jump]
414 output
415 [:output-start ;; just a label
416 0x3F ;; ;; prevent repeated nybbles
417 0x54 ;;
418 0x5D ;; HL->DE \
419 ;; | This mess is here to do
420 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
421 ;; / any repeating nybbles
422 0x05 ;; DEC bytes-to-write (B)
424 0x23 ;; inc HL
426 0x18
427 :to-beginning]
429 symbols
430 {:to-be-executed-address
431 (reverse
432 (disect-bytes-2
433 (+ start-address
434 (count header)
435 (count init)
436 (symbol-index :to-be-executed input))))
437 :to-be-executed 0x3F} ;; clear carry flag no-op
439 program** (flatten
440 (replace
441 symbols
442 (concat init header input output)))
444 resolve-internal-jumps
445 {:output-start []
446 :to-output
447 (->signed-8-bit
448 (dec
449 (- (symbol-index :output-start program**)
450 (symbol-index :to-output program**))))}
452 program*
453 (flatten (replace resolve-internal-jumps program**))
455 resolve-external-jumps
456 {:to-jump
457 (- (- (symbol-index :to-beginning program*)
458 (symbol-index :to-jump program*)) 2)
460 :to-beginning
461 (->signed-8-bit
462 (+ (count init) -1
463 (- (symbol-index :to-beginning program*))))}
465 program
466 (replace resolve-external-jumps program*)]
467 program)))
470 (defn no-consecutive-repeats? [seq]
471 (not (contains? (set(map - seq (rest seq))) 0)))
473 (defn byte->nybbles [byte]
474 [(bit-shift-right byte 4) (bit-and byte 0x0F)])
476 (defn bootstrap-pattern
477 "Given an assembly sequence, generate the keypresses required to
478 create that sequence in memory using the pc-item-writer
479 program. The assembly must not have any consecutive repeating
480 nybbles."
481 [assembly]
482 (let [nybbles (flatten (map byte->nybbles assembly))
483 moves (map (comp buttons (partial - 15)) nybbles)
484 header (map buttons
485 (concat (repeat
486 50
487 (- 15 (first nybbles)))
488 [(first nybbles)]))]
489 (assert (no-consecutive-repeats? nybbles))
490 (concat header moves)))
492 ;;;;;; TESTS ;;;;;;
494 (def set-H-mode 0x67)
495 (def set-L-mode 0x6F)
496 (def jump-mode 0xE9)
497 (def write-mode 0x47)
500 (defn bootstrap-base []
501 (let [program (main-bootstrap-program pokemon-list-start)]
502 ;; make sure program is valid output for item-writer
503 (-> (tick (mid-game))
504 (set-memory-range pokemon-list-start program)
505 (PC! pokemon-list-start)
506 (step [])
507 (step []))))
509 (defn test-set-H []
510 (letfn [(test-H [state n]
511 (let [after
512 (-> state
513 (step (buttons set-H-mode))
514 (step (buttons n))
515 (step []))]
516 ;;(println "desired H =" n "actual =" (H after))
517 (assert (= n (H after)))
518 after))]
519 (let [result (reduce test-H (bootstrap-base) (range 0x100))]
520 (println "set H test passed.")
521 result)))
523 (defn test-write-bytes []
524 (let [target-address 0xC00F
525 [target-high target-low] (disect-bytes-2 target-address)
526 assembly [0xF3 0x18 0xFE 0x12]
527 get-mem-region #(subvec (vec (memory %))
528 target-address (+ target-address 20))
529 before (bootstrap-base)
530 after
531 (-> before
532 (step []) ; make sure it can handle blanks
533 (step []) ; at the beginning.
534 (step [])
535 (step (buttons set-H-mode)) ; select set-H
536 (step (buttons target-high))
537 (step [])
538 (step (buttons set-L-mode))
539 (step (buttons target-low))
540 (step [])
541 (step (buttons write-mode))
542 (step (buttons 4)) ; write 4 bytes
543 (step (buttons (nth assembly 0)))
544 (step (buttons (nth assembly 1)))
545 (step (buttons (nth assembly 2)))
546 (step (buttons (nth assembly 3))))]
547 ;;(println "before :" (get-mem-region before))
548 ;;(println "after :" (get-mem-region after))
549 ;;(assert (= assembly (take 4 (get-mem-region after))))
550 (println "write-test-passed.")
551 after))
553 (defn test-jump []
554 (let [target-address 0xC00F
555 [target-high target-low] (disect-bytes-2 target-address)
556 post-jump
557 (-> (test-write-bytes)
558 (step (buttons set-H-mode)) ; select set-H
559 (step (buttons target-high))
560 (step [])
561 (step (buttons set-L-mode))
562 (step (buttons target-low))
563 (step [])
564 (step (buttons jump-mode))) ; Select JUMP mode.
565 program-counters
566 (capture-program-counter
567 post-jump
568 10000)]
569 (assert (contains? (set program-counters) target-address))
570 (println "jump test passed.")
571 post-jump))
573 (defn test-no-repeated-nybbles []
574 (bootstrap-pattern (main-bootstrap-program))
575 (println "no-repeated-nybbles"))
577 (defn run-all-tests []
578 (test-frame-metronome)
579 (test-read-user-input)
580 (test-set-H)
581 (test-write-bytes)
582 (test-jump)
583 (test-no-repeated-nybbles)
584 (println "\n all tests passed."))