Mercurial > vba-clojure
view clojure/com/aurellem/gb/rlm_assembly.clj @ 490:151c96d60921
edit to image.clj
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Mon, 11 Jun 2012 00:53:20 -0500 |
parents | 21b8b3350b20 |
children | 9068685e7d96 |
line wrap: on
line source
1 (ns com.aurellem.gb.rlm-assembly2 "Version of main bootstrap program that is valid output for the3 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-program8 []9 (let [limit 20110 [target-high target-low] (disect-bytes-2 pokemon-list-start)]11 (flatten12 [[0x00 ;; (item-hack) set increment stack pointer no-op13 0x1E ;; load limit into E14 limit15 0x3F ;; (item-hack) set carry flag no-op17 ;; load 2 into C.18 0x0E ;; C == 1 means input-first nybble19 0x04 ;; C == 0 means input-second nybble21 0x21 ;; load target into HL22 target-low23 target-high24 0x37 ;; (item-hack) set carry flag no-op26 0x00 ;; (item-hack) no-op27 0x37 ;; (item-hack) set carry flag no-op29 0x00 ;; (item-hack) no-op30 0xF3 ;; disable interrupts31 ;; Input Section33 0x3E ;; load 0x20 into A, to measure buttons34 0x1036 0x00 ;; (item-hack) no-op37 0xE0 ;; load A into [FF00]38 0x0040 0xF0 ;; load 0xFF00 into A to get41 0x00 ;; button presses43 0xE644 0x0F ;; select bottom four bits of A45 0x37 ;; (item-hack) set carry flag no-op47 0x00 ;; (item-hack) no-op48 0xB8 ;; see if input is different (CP A B)50 0x00 ;; (item-hack) (INC SP)51 0x28 ;; repeat above steps if input is not different52 ;; (jump relative backwards if B != A)53 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)55 0x47 ;; load A into B57 0x0D ;; dec C58 0x37 ;; (item-hack) set-carry flag59 ;; branch based on C:60 0x20 ;; JR NZ61 23 ;; skip "input second nybble" and "jump to target" below63 ;; input second nybble65 0x0C ;; inc C66 0x0C ;; inc C68 0x00 ;; (item-hack) no-op69 0xE6 ;; select bottom bits70 0x0F71 0x37 ;; (item-hack) set-carry flag no-op73 0x00 ;; (item-hack) no-op74 0xB2 ;; (OR A D) -> A76 0x22 ;; (do (A -> (HL)) (INC HL))78 0x1D ;; (DEC E)80 0x00 ;; (item-hack)81 0x20 ;; jump back to input section if not done82 0xDA ;; literal -36 == TM 18 (counter)83 0x01 ;; (item-hack) set BC to literal (no-op)85 ;; jump to target86 0x00 ;; (item-hack) these two bytes can be anything.87 0x0189 0x00 ;; (item-hack) no-op90 0xBF ;; (CP A A) ensures Z92 0xCA ;; (item-hack) jump if Z93 target-low94 target-high95 0x01 ;; (item-hack) will never be reached.97 ;; input first nybble98 0x0099 0xCB100 0x37 ;; swap nybbles on A102 0x57 ;; A -> D104 0x37 ;; (item-hack) set carry flag no-op105 0x18 ;; relative jump backwards106 0xCD ;; literal -51 == TM05; go back to input section107 0x01 ;; (item-hack) will never reach this instruction109 ]110 (repeat 8 [0x00 0x01]);; these can be anything112 [;; jump to actual program113 0x00114 0x37 ;; (item-hack) set carry flag no-op116 0x2E ;; 0x3A -> L117 0x3A120 0x00 ;; (item-hack) no-op121 0x26 ;; 0xD5 -> L122 0xD5123 0x01 ;; (item-hack) set-carry BC125 0x00 ;; (item-hack) these can be anything126 0x01128 0x00129 0xE9 ;; jump to (HL)130 ]])))134 ;; Specs for Main Bootstrap Program136 ;; Number-Input137 ;; Number input works using all eight buttons to138 ;; spell out an 8 bit number. The order of buttons is139 ;; [:d :u :l :r :start :select :b :a] --> 11111111140 ;; [ :l :start :a] --> 00101001142 ;;; MODES143 ;; There are five modes in total:144 ;; MODE-SELECT145 ;; SET-H146 ;; SET-L147 ;; WRITE148 ;; JUMP150 ;;; MODE-SELECT151 ;; The bootstrap program starts in MODE-SELECT mode.152 ;; MODE-SELECT transitions to one of three modes depending153 ;; on which buttons are pressed:154 ;; 0 : MODE-SELECT155 ;; 0x67 : SET-H156 ;; 0x6F : SET-L157 ;; 0x47 : WRITE158 ;; 0xE9 : JUMP160 ;;; SET-H161 ;; SET-H sets the high 8 bits of the target address to which162 ;; data will be written / the program will jump. It expects163 ;; the following:164 ;;165 ;; Byte 0 : New Value of H166 ;; Byte 1 : 0x00168 ;;; SET-L169 ;; This mode sets the low 8 bits of the target address and has170 ;; the same semantics as SET-H.172 ;;; WRITE-BYTES173 ;; WRITE-BYTES mode writes sequences of arbitray values to174 ;; arbitray memory locations. It expects you to enter a175 ;; header of one byte describing how many bytes to write.177 ;; Byte 0 : Number of Bytes to Write179 ;; Then, you enter the number of bytes specified in Byte 0180 ;; and they are written to the start address in sequence.181 ;; After the last byte is written control returns to182 ;; MODE-SELECT mode. The Target address will be incremented by183 ;; Number of Bytes to Write once you are done writing.185 ;; Example: to write the sequence [1 2 3 4] starting at186 ;; 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 ;;; JUMP194 ;; JUMP mode jumps program control to the target address.196 ;;; EXAMPLE197 ;; To write the infinite loop program [0x18 0xFE] to address198 ;; 0xC00F and then jump to said program, enter the following199 ;; starting from MODE-SELECT mode.201 ;; Byte 0 : 0x67 [:a :b :l :u :select] ;; SET-H mode202 ;; Byte 1 : 0xC0 [:d :u] ;; 0xC0 -> H203 ;; Byte 2 : 0x00 [] ;; trailer205 ;; Byte 3 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode206 ;; Byte 4 : 0x0F [:a :start :b :select] ;; 0x0F -> L207 ;; Byte 5 : 0x00 [] ;; trailer209 ;; Byte 6 : 0x47 [:a :b :u :select] ;; WRITE-MODE210 ;; Byte 7 : 0x02 [:b] ;; write 2 bytes211 ;; Byte 8 : 0x18 [:r :start] ;; assembly212 ;; Byte 9 : 0xFE [:r :start :b :d :l :u :select] ;; assembly214 ;; 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 mode218 ;; Byte 12 : 0x0F [:a :start :b :select] ;; 0x0F -> L219 ;; Byte 13 : 0x00 [] ;; trailer221 ;; Byte 14 : 0xE9 ;; JUMP-MODE223 (defn ->signed-8-bit [n]224 (if (< n 0)225 (+ 256 n) n))227 (defn frame-metronome []228 (let [init [0xC5] ;; save value of BC229 timing-loop230 [0x01 ; \231 0x43 ; |232 0xFE ; | load 0xFF44 into BC without repeats233 0x0C ; |234 0x04 ; /235 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)236 continue-if-144237 [0xFE238 144 ;; compare LY (in A) with 144239 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)240 (->signed-8-bit241 (+ -4 (- (count timing-loop))))]242 spin-loop243 [0x05 ;; dec B, which is 0xFF244 0x20 ;; spin until B==0245 0xFD]]246 (concat init timing-loop continue-if-144 spin-loop)))248 (defn frame-metronome* []249 [0x3E ;; smallest version, but uses repeated nybbles250 0x01251 0xE0252 0xFF])254 (defn frame-metronome** []255 [0x06 ;; load 0xFE into B256 0xFE257 0x04 ;; inc B, now B == FF259 0x3E ;; RLM-debug260 0x01 ;; 1->A262 0x48 ;; B->C263 0x02]) ;; A->(BC) set exclusive v-blank interrupt265 (defn test-frame-metronome266 "Ensure that frame-metronome ticks exactly once every frame."267 ([] (test-frame-metronome 151))268 ([steps]269 (let [inc-E [0x1C 0x18270 (->signed-8-bit271 (+ -3272 (-(count (frame-metronome)))))]274 program (concat (frame-metronome) inc-E)275 count-frames276 (-> (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-moves282 (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 [0x3E290 0x20 ; prepare to measure d-pad292 0x3F ; clear carry flag no-op to prevent repeated nybbles294 0x01 ;\295 0x01 ; |296 0xFE ; | load 0xFF00 into BC without repeats297 0x04 ; |298 0x0D ;/300 0x02301 0x0A ;; get D-pad info303 0xF5 ;; push AF305 0x3E306 0x10 ; prepare to measure buttons308 0x3F ;; clear carry flag no-op to prevent repeated nybbbles310 0x02311 0x0A ;; get button info313 0xE6 ;; select bottom bits of A314 0x0F316 0x47 ;; A->B318 0xF1 ;; pop AF320 0xE6321 0x0F ;; select bottom bits of A323 0xCB324 0x37 ;; swap A nybbles326 0xB0 ;; (or A B) -> A328 0x2F ;; (NOT A) -> A329 ])331 (defn test-read-user-input []332 (let [program333 (concat334 (frame-metronome) (read-user-input)335 [0x5F ;; A-> E336 0x76337 0x18338 (->signed-8-bit339 (+ (- (count (read-user-input)))340 (- 4)))])341 read-input342 (-> (tick (mid-game))343 (IE! 0)344 (set-memory-range pokemon-list-start program)345 (PC! pokemon-list-start))]346 (dorun347 (for [i (range 0x100)]348 (assert (= (E (step read-input (buttons i))) i))))349 (println "tested all inputs.")350 read-input))352 (def symbol-index353 (fn [symbol sequence]354 (count (take-while355 (partial not= symbol)356 sequence))))358 (defn main-bootstrap-program359 ([] (main-bootstrap-program pokemon-list-start))360 ([start-address]361 ;; Register Use:363 ;; ED non-volitale scratch365 ;; A user-input366 ;; HL target-address367 ;; B bytes-to-write368 ;; C non-volatile scratch370 ;; Modes (with codes) are:372 ;; single-action-modes:373 ;; SET-TARGET-HIGH 0x67 ;; A->H374 ;; SET-TARGET-LOW 0x6F ;; A->L375 ;; JUMP 0xE9 ;; jump to (HL)377 ;; multi-action-modes378 ;; WRITE 0x47 ;; A->B380 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B381 header (concat (frame-metronome) (read-user-input))383 input384 [0xC1 ;; pop BC so it's not volatile386 0x5F ;; A->E387 0xAF ;; test for output-mode (bytes-to-write > 0)388 0xB8 ;; (cp A B)389 0x7B ;; E->A390 0x20 ;; skip to output section if391 :to-output ;; we're not in input mode393 :to-be-executed395 ;; write mode to instruction-to-be-executed (pun)396 0xEA397 :to-be-executed-address399 ;; protection region -- do not queue this op for400 ;; execution if the last one was non-zero401 0x79 ;; C->A402 0xA7 ;; test A==0403 0x28404 0x04405 0xAF ;; put a no op (0x00) in to-be-executed406 0xEA ;;407 :to-be-executed-address409 0x7B ;; E->A410 0x4F ;; A->C now C stores previous instruction411 0x18 ;; return412 :to-jump]414 output415 [:output-start ;; just a label416 0x3F ;; ;; prevent repeated nybbles417 0x54 ;;418 0x5D ;; HL->DE \419 ;; | This mess is here to do420 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without421 ;; / any repeating nybbles422 0x05 ;; DEC bytes-to-write (B)424 0x23 ;; inc HL426 0x18427 :to-beginning]429 symbols430 {:to-be-executed-address431 (reverse432 (disect-bytes-2433 (+ start-address434 (count header)435 (count init)436 (symbol-index :to-be-executed input))))437 :to-be-executed 0x3F} ;; clear carry flag no-op439 program** (flatten440 (replace441 symbols442 (concat init header input output)))444 resolve-internal-jumps445 {:output-start []446 :to-output447 (->signed-8-bit448 (dec449 (- (symbol-index :output-start program**)450 (symbol-index :to-output program**))))}452 program*453 (flatten (replace resolve-internal-jumps program**))455 resolve-external-jumps456 {:to-jump457 (- (- (symbol-index :to-beginning program*)458 (symbol-index :to-jump program*)) 2)460 :to-beginning461 (->signed-8-bit462 (+ (count init) -1463 (- (symbol-index :to-beginning program*))))}465 program466 (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-pattern477 "Given an assembly sequence, generate the keypresses required to478 create that sequence in memory using the pc-item-writer479 program. The assembly must not have any consecutive repeating480 nybbles."481 [assembly]482 (let [nybbles (flatten (map byte->nybbles assembly))483 moves (map (comp buttons (partial - 15)) nybbles)484 header (map buttons485 (concat (repeat486 50487 (- 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-writer503 (-> (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 [after512 (-> state513 (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 0xC00F525 [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 after531 (-> before532 (step []) ; make sure it can handle blanks533 (step []) ; at the beginning.534 (step [])535 (step (buttons set-H-mode)) ; select set-H536 (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 bytes543 (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 0xC00F555 [target-high target-low] (disect-bytes-2 target-address)556 post-jump557 (-> (test-write-bytes)558 (step (buttons set-H-mode)) ; select set-H559 (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-counters566 (capture-program-counter567 post-jump568 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."))