rlm@377: (ns com.aurellem.gb.rlm-assembly rlm@377: "Version of main bootstrap program that is valid output for the rlm@377: item-writer program." rlm@377: (:use (com.aurellem.gb gb-driver assembly util vbm constants)) rlm@377: (:import [com.aurellem.gb.gb_driver SaveState])) rlm@377: rlm@414: (defn pc-item-writer-program rlm@414: [] rlm@414: (let [limit 201 rlm@414: [target-high target-low] (disect-bytes-2 pokemon-list-start)] rlm@414: (flatten rlm@414: [[0x00 ;; (item-hack) set increment stack pointer no-op rlm@414: 0x1E ;; load limit into E rlm@414: limit rlm@414: 0x3F ;; (item-hack) set carry flag no-op rlm@414: rlm@414: ;; load 2 into C. rlm@414: 0x0E ;; C == 1 means input-first nybble rlm@414: 0x04 ;; C == 0 means input-second nybble rlm@414: rlm@414: 0x21 ;; load target into HL rlm@414: target-low rlm@414: target-high rlm@414: 0x37 ;; (item-hack) set carry flag no-op rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0x37 ;; (item-hack) set carry flag no-op rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0xF3 ;; disable interrupts rlm@414: ;; Input Section rlm@414: rlm@414: 0x3E ;; load 0x20 into A, to measure buttons rlm@414: 0x10 rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0xE0 ;; load A into [FF00] rlm@414: 0x00 rlm@414: rlm@414: 0xF0 ;; load 0xFF00 into A to get rlm@414: 0x00 ;; button presses rlm@414: rlm@414: 0xE6 rlm@414: 0x0F ;; select bottom four bits of A rlm@414: 0x37 ;; (item-hack) set carry flag no-op rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0xB8 ;; see if input is different (CP A B) rlm@414: rlm@414: 0x00 ;; (item-hack) (INC SP) rlm@414: 0x28 ;; repeat above steps if input is not different rlm@414: ;; (jump relative backwards if B != A) rlm@414: 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37) rlm@414: rlm@414: 0x47 ;; load A into B rlm@414: rlm@414: 0x0D ;; dec C rlm@414: 0x37 ;; (item-hack) set-carry flag rlm@414: ;; branch based on C: rlm@414: 0x20 ;; JR NZ rlm@414: 23 ;; skip "input second nybble" and "jump to target" below rlm@414: rlm@414: ;; input second nybble rlm@414: rlm@414: 0x0C ;; inc C rlm@414: 0x0C ;; inc C rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0xE6 ;; select bottom bits rlm@414: 0x0F rlm@414: 0x37 ;; (item-hack) set-carry flag no-op rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0xB2 ;; (OR A D) -> A rlm@414: rlm@414: 0x22 ;; (do (A -> (HL)) (INC HL)) rlm@414: rlm@414: 0x1D ;; (DEC E) rlm@414: rlm@414: 0x00 ;; (item-hack) rlm@414: 0x20 ;; jump back to input section if not done rlm@414: 0xDA ;; literal -36 == TM 18 (counter) rlm@414: 0x01 ;; (item-hack) set BC to literal (no-op) rlm@414: rlm@414: ;; jump to target rlm@414: 0x00 ;; (item-hack) these two bytes can be anything. rlm@414: 0x01 rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0xBF ;; (CP A A) ensures Z rlm@414: rlm@414: 0xCA ;; (item-hack) jump if Z rlm@414: target-low rlm@414: target-high rlm@414: 0x01 ;; (item-hack) will never be reached. rlm@414: rlm@414: ;; input first nybble rlm@414: 0x00 rlm@414: 0xCB rlm@414: 0x37 ;; swap nybbles on A rlm@414: rlm@414: 0x57 ;; A -> D rlm@414: rlm@414: 0x37 ;; (item-hack) set carry flag no-op rlm@414: 0x18 ;; relative jump backwards rlm@414: 0xCD ;; literal -51 == TM05; go back to input section rlm@414: 0x01 ;; (item-hack) will never reach this instruction rlm@414: rlm@414: ] rlm@414: (repeat 8 [0x00 0x01]);; these can be anything rlm@414: rlm@414: [;; jump to actual program rlm@414: 0x00 rlm@414: 0x37 ;; (item-hack) set carry flag no-op rlm@414: rlm@414: 0x2E ;; 0x3A -> L rlm@414: 0x3A rlm@414: rlm@414: rlm@414: 0x00 ;; (item-hack) no-op rlm@414: 0x26 ;; 0xD5 -> L rlm@414: 0xD5 rlm@414: 0x01 ;; (item-hack) set-carry BC rlm@414: rlm@414: 0x00 ;; (item-hack) these can be anything rlm@414: 0x01 rlm@414: rlm@414: 0x00 rlm@414: 0xE9 ;; jump to (HL) rlm@414: ]]))) rlm@414: rlm@390: rlm@390: rlm@377: ;; Specs for Main Bootstrap Program rlm@377: rlm@377: ;; Number-Input rlm@377: ;; Number input works using all eight buttons to rlm@377: ;; spell out an 8 bit number. The order of buttons is rlm@377: ;; [:d :u :l :r :start :select :b :a] --> 11111111 rlm@377: ;; [ :l :start :a] --> 00101001 rlm@377: rlm@409: ;;; MODES rlm@409: ;; There are five modes in total: rlm@409: ;; MODE-SELECT rlm@409: ;; SET-H rlm@409: ;; SET-L rlm@409: ;; WRITE rlm@409: ;; JUMP rlm@409: rlm@377: ;;; MODE-SELECT rlm@377: ;; The bootstrap program starts in MODE-SELECT mode. rlm@377: ;; MODE-SELECT transitions to one of three modes depending rlm@377: ;; on which buttons are pressed: rlm@409: ;; 0 : MODE-SELECT rlm@409: ;; 0x67 : SET-H rlm@409: ;; 0x6F : SET-L rlm@409: ;; 0x47 : WRITE rlm@409: ;; 0xE9 : JUMP rlm@409: rlm@409: ;;; SET-H rlm@409: ;; SET-H sets the high 8 bits of the target address to which rlm@409: ;; data will be written / the program will jump. It expects rlm@409: ;; the following: rlm@409: ;; rlm@409: ;; Byte 0 : New Value of H rlm@409: ;; Byte 1 : 0x00 rlm@409: rlm@409: ;;; SET-L rlm@409: ;; This mode sets the low 8 bits of the target address and has rlm@409: ;; the same semantics as SET-H. rlm@377: rlm@377: ;;; WRITE-BYTES rlm@377: ;; WRITE-BYTES mode writes sequences of arbitray values to rlm@377: ;; arbitray memory locations. It expects you to enter a rlm@409: ;; header of one byte describing how many bytes to write. rlm@377: rlm@377: ;; Byte 0 : Number of Bytes to Write rlm@377: rlm@377: ;; Then, you enter the number of bytes specified in Byte 0 rlm@409: ;; and they are written to the start address in sequence. rlm@409: ;; After the last byte is written control returns to rlm@409: ;; MODE-SELECT mode. The Target address will be incremented by rlm@409: ;; Number of Bytes to Write once you are done writing. rlm@377: rlm@377: ;; Example: to write the sequence [1 2 3 4] starting at rlm@409: ;; the target address enter: rlm@377: ;; Byte 0 : 4 (will write four bytes) rlm@377: ;; Byte 3 : 1 (write 1 to 0xC01F) rlm@377: ;; Byte 4 : 2 (write 2 to 0xC020) rlm@377: ;; Byte 5 : 3 (write 3 to 0xC021) rlm@377: ;; Byte 6 : 4 (write 4 to 0xC022) rlm@377: rlm@377: ;;; JUMP rlm@409: ;; JUMP mode jumps program control to the target address. rlm@377: rlm@409: ;;; EXAMPLE rlm@409: ;; To write the infinite loop program [0x18 0xFE] to address rlm@409: ;; 0xC00F and then jump to said program, enter the following rlm@409: ;; starting from MODE-SELECT mode. rlm@377: rlm@409: ;; Byte 0 : 0x67 [:a :b :l :u :select] ;; SET-H mode rlm@409: ;; Byte 1 : 0xC0 [:d :u] ;; 0xC0 -> H rlm@409: ;; Byte 2 : 0x00 [] ;; trailer rlm@409: rlm@409: ;; Byte 3 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode rlm@409: ;; Byte 4 : 0x0F [:a :start :b :select] ;; 0x0F -> L rlm@409: ;; Byte 5 : 0x00 [] ;; trailer rlm@409: rlm@409: ;; Byte 6 : 0x47 [:a :b :u :select] ;; WRITE-MODE rlm@409: ;; Byte 7 : 0x02 [:b] ;; write 2 bytes rlm@409: ;; Byte 8 : 0x18 [:r :start] ;; assembly rlm@409: ;; Byte 9 : 0xFE [:r :start :b :d :l :u :select] ;; assembly rlm@409: rlm@409: ;; target address is now 0xC011 since we wrote 2 bytes. rlm@409: ;; set it back to 0xC00F. rlm@409: rlm@409: ;; Byte 10 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode rlm@409: ;; Byte 12 : 0x0F [:a :start :b :select] ;; 0x0F -> L rlm@409: ;; Byte 13 : 0x00 [] ;; trailer rlm@409: rlm@409: ;; Byte 14 : 0xE9 ;; JUMP-MODE rlm@377: rlm@378: (defn ->signed-8-bit [n] rlm@378: (if (< n 0) rlm@378: (+ 256 n) n)) rlm@378: rlm@416: (defn frame-metronome [] rlm@404: (let [init [0xC5] ;; save value of BC rlm@404: timing-loop rlm@404: [0x01 ; \ rlm@404: 0x43 ; | rlm@404: 0xFE ; | load 0xFF44 into BC without repeats rlm@404: 0x0C ; | rlm@404: 0x04 ; / rlm@404: 0x0A] ;; (BC) -> A, now A = LY (vertical line coord) rlm@404: continue-if-144 rlm@404: [0xFE rlm@404: 144 ;; compare LY (in A) with 144 rlm@404: 0x20 ;; jump back to beginning if LY != 144 (not-v-blank) rlm@404: (->signed-8-bit rlm@404: (+ -4 (- (count timing-loop))))] rlm@404: spin-loop rlm@404: [0x05 ;; dec B, which is 0xFF rlm@404: 0x20 ;; spin until B==0 rlm@404: 0xFD]] rlm@404: (concat init timing-loop continue-if-144 spin-loop))) rlm@404: rlm@404: (defn frame-metronome* [] rlm@404: [0x3E ;; smallest version, but uses repeated nybbles rlm@416: 0x01 rlm@404: 0xE0 rlm@404: 0xFF]) rlm@404: rlm@416: (defn frame-metronome** [] rlm@404: [0x06 ;; load 0xFE into B rlm@404: 0xFE rlm@404: 0x04 ;; inc B, now B == FF rlm@416: rlm@416: 0x3E ;; RLM-debug rlm@404: 0x01 ;; 1->A rlm@416: rlm@404: 0x48 ;; B->C rlm@404: 0x02]) ;; A->(BC) set exclusive v-blank interrupt rlm@378: rlm@379: (defn test-frame-metronome rlm@379: "Ensure that frame-metronome ticks exactly once every frame." rlm@379: ([] (test-frame-metronome 151)) rlm@379: ([steps] rlm@416: (let [inc-E [0x1C 0x18 rlm@416: (->signed-8-bit rlm@416: (+ -3 rlm@416: (-(count (frame-metronome)))))] rlm@404: rlm@388: program (concat (frame-metronome) inc-E) rlm@379: count-frames rlm@379: (-> (tick (mid-game)) rlm@379: (IE! 0) rlm@388: (DE! 0) rlm@379: (set-memory-range pokemon-list-start program) rlm@379: (PC! pokemon-list-start)) rlm@390: E-after-moves rlm@390: (E (run-moves count-frames (repeat steps [])))] rlm@405: ;;(println "E:" E-after-moves) rlm@388: (assert (= steps E-after-moves)) rlm@405: (println "frame-count test passed.") rlm@379: count-frames))) rlm@379: rlm@384: (defn read-user-input [] rlm@416: [0x3E rlm@388: 0x20 ; prepare to measure d-pad rlm@384: rlm@405: 0x3F ; clear carry flag no-op to prevent repeated nybbles rlm@405: rlm@388: 0x01 ;\ rlm@388: 0x01 ; | rlm@388: 0xFE ; | load 0xFF00 into BC without repeats rlm@388: 0x04 ; | rlm@388: 0x0D ;/ rlm@386: rlm@388: 0x02 rlm@388: 0x0A ;; get D-pad info rlm@385: rlm@385: 0xF5 ;; push AF rlm@385: rlm@385: 0x3E rlm@388: 0x10 ; prepare to measure buttons rlm@388: rlm@388: 0x3F ;; clear carry flag no-op to prevent repeated nybbbles rlm@385: rlm@388: 0x02 rlm@388: 0x0A ;; get button info rlm@385: rlm@384: 0xE6 ;; select bottom bits of A rlm@384: 0x0F rlm@384: rlm@388: 0x47 ;; A->B rlm@385: rlm@385: 0xF1 ;; pop AF rlm@385: rlm@385: 0xE6 rlm@385: 0x0F ;; select bottom bits of A rlm@385: rlm@384: 0xCB rlm@384: 0x37 ;; swap A nybbles rlm@387: rlm@388: 0xB0 ;; (or A B) -> A rlm@387: rlm@384: 0x2F ;; (NOT A) -> A rlm@384: ]) rlm@384: rlm@384: (defn test-read-user-input [] rlm@384: (let [program rlm@384: (concat rlm@384: (frame-metronome) (read-user-input) rlm@388: [0x5F ;; A-> E rlm@404: 0x76 rlm@384: 0x18 rlm@384: (->signed-8-bit rlm@404: (+ (- (count (read-user-input))) rlm@404: (- 4)))]) rlm@384: read-input rlm@384: (-> (tick (mid-game)) rlm@384: (IE! 0) rlm@384: (set-memory-range pokemon-list-start program) rlm@384: (PC! pokemon-list-start))] rlm@384: (dorun rlm@404: (for [i (range 0x100)] rlm@404: (assert (= (E (step read-input (buttons i))) i)))) rlm@405: (println "tested all inputs.") rlm@384: read-input)) rlm@384: rlm@393: (def symbol-index rlm@393: (fn [symbol sequence] rlm@393: (count (take-while rlm@393: (partial not= symbol) rlm@393: sequence)))) rlm@385: rlm@552: (defn bootstrap-state-machine rlm@403: ([start-address] rlm@403: ;; Register Use: rlm@403: rlm@403: ;; ED non-volitale scratch rlm@403: rlm@552: ;; A user-input (A MUST contain user-input for this to work!) rlm@403: ;; HL target-address rlm@403: ;; B bytes-to-write rlm@403: ;; C non-volatile scratch rlm@385: rlm@403: ;; Modes (with codes) are: rlm@390: rlm@403: ;; single-action-modes: rlm@403: ;; SET-TARGET-HIGH 0x67 ;; A->H rlm@403: ;; SET-TARGET-LOW 0x6F ;; A->L rlm@403: ;; JUMP 0xE9 ;; jump to (HL) rlm@390: rlm@403: ;; multi-action-modes rlm@403: ;; WRITE 0x47 ;; A->B rlm@552: (let [ rlm@403: input rlm@403: [0xC1 ;; pop BC so it's not volatile rlm@388: rlm@403: 0x5F ;; A->E rlm@403: 0xAF ;; test for output-mode (bytes-to-write > 0) rlm@403: 0xB8 ;; (cp A B) rlm@403: 0x7B ;; E->A rlm@403: 0x20 ;; skip to output section if rlm@403: :to-output ;; we're not in input mode rlm@403: rlm@403: :to-be-executed rlm@391: rlm@403: ;; write mode to instruction-to-be-executed (pun) rlm@403: 0xEA rlm@403: :to-be-executed-address rlm@388: rlm@403: ;; protection region -- do not queue this op for rlm@403: ;; execution if the last one was non-zero rlm@403: 0x79 ;; C->A rlm@403: 0xA7 ;; test A==0 rlm@403: 0x28 rlm@403: 0x04 rlm@403: 0xAF ;; put a no op (0x00) in to-be-executed rlm@403: 0xEA ;; rlm@403: :to-be-executed-address rlm@403: rlm@403: 0x7B ;; E->A rlm@403: 0x4F ;; A->C now C stores previous instruction rlm@403: 0x18 ;; return rlm@416: :to-jump] rlm@403: rlm@403: output rlm@403: [:output-start ;; just a label rlm@405: 0x3F ;; ;; prevent repeated nybbles rlm@403: 0x54 ;; rlm@403: 0x5D ;; HL->DE \ rlm@552: ;; | This mess is here to do rlm@403: 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without rlm@552: ;; / any repeating nybbles rlm@403: 0x05 ;; DEC bytes-to-write (B) rlm@391: rlm@405: 0x23 ;; inc HL rlm@552: ] rlm@552: rlm@403: symbols rlm@403: {:to-be-executed-address rlm@403: (reverse rlm@403: (disect-bytes-2 rlm@404: (+ start-address rlm@403: (symbol-index :to-be-executed input)))) rlm@405: :to-be-executed 0x3F} ;; clear carry flag no-op rlm@392: rlm@403: program** (flatten rlm@416: (replace rlm@416: symbols rlm@552: (concat input output))) rlm@404: rlm@403: resolve-internal-jumps rlm@403: {:output-start [] rlm@403: :to-output rlm@403: (->signed-8-bit rlm@403: (dec rlm@403: (- (symbol-index :output-start program**) rlm@403: (symbol-index :to-output program**))))} rlm@391: rlm@403: program* rlm@403: (flatten (replace resolve-internal-jumps program**)) rlm@403: rlm@403: resolve-external-jumps rlm@416: {:to-jump rlm@552: (- (- (count program*) rlm@552: (symbol-index :to-jump program*)) 1)} rlm@403: program rlm@403: (replace resolve-external-jumps program*)] rlm@403: program))) rlm@552: rlm@552: rlm@552: (defn main-bootstrap-program rlm@552: ([] (main-bootstrap-program pokemon-list-start)) rlm@552: ([start-address] rlm@552: (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B rlm@552: header (concat (frame-metronome) (read-user-input)) rlm@552: state-machine-start-address rlm@552: (+ start-address (count init) (count header)) rlm@552: state-machine rlm@552: (bootstrap-state-machine state-machine-start-address) rlm@552: rlm@552: return-to-header rlm@552: (flatten rlm@552: [0x18 rlm@552: (->signed-8-bit rlm@552: (- (count init) rlm@552: 2 ;; this command length rlm@552: 3 ;; I have no idea why we need a 3 here rlm@552: ;; need to investigate. rlm@552: (count header) rlm@552: (count state-machine)))])] rlm@552: rlm@552: (concat init header state-machine return-to-header)))) rlm@552: rlm@414: rlm@414: rlm@414: (defn no-consecutive-repeats? [seq] rlm@414: (not (contains? (set(map - seq (rest seq))) 0))) rlm@414: rlm@414: (defn byte->nybbles [byte] rlm@414: [(bit-shift-right byte 4) (bit-and byte 0x0F)]) rlm@414: rlm@414: (defn bootstrap-pattern rlm@414: "Given an assembly sequence, generate the keypresses required to rlm@414: create that sequence in memory using the pc-item-writer rlm@414: program. The assembly must not have any consecutive repeating rlm@414: nybbles." rlm@414: [assembly] rlm@414: (let [nybbles (flatten (map byte->nybbles assembly)) rlm@414: moves (map (comp buttons (partial - 15)) nybbles) rlm@414: header (map buttons rlm@414: (concat (repeat rlm@414: 50 rlm@414: (- 15 (first nybbles))) rlm@415: [(first nybbles)]))] rlm@414: (assert (no-consecutive-repeats? nybbles)) rlm@415: (concat header moves))) rlm@378: rlm@377: ;;;;;; TESTS ;;;;;; rlm@377: rlm@401: (def set-H-mode 0x67) rlm@401: (def set-L-mode 0x6F) rlm@401: (def jump-mode 0xE9) rlm@401: (def write-mode 0x47) rlm@401: rlm@401: rlm@377: (defn bootstrap-base [] rlm@377: (let [program (main-bootstrap-program pokemon-list-start)] rlm@377: ;; make sure program is valid output for item-writer rlm@377: (-> (tick (mid-game)) rlm@377: (set-memory-range pokemon-list-start program) rlm@400: (PC! pokemon-list-start) rlm@400: (step []) rlm@400: (step [])))) rlm@377: rlm@400: (defn test-set-H [] rlm@400: (letfn [(test-H [state n] rlm@400: (let [after rlm@400: (-> state rlm@402: (step (buttons set-H-mode)) rlm@400: (step (buttons n)) rlm@400: (step []))] rlm@401: ;;(println "desired H =" n "actual =" (H after)) rlm@400: (assert (= n (H after))) rlm@400: after))] rlm@403: (let [result (reduce test-H (bootstrap-base) (range 0x100))] rlm@405: (println "set H test passed.") rlm@403: result))) rlm@400: rlm@401: (defn test-write-bytes [] rlm@377: (let [target-address 0xC00F rlm@377: [target-high target-low] (disect-bytes-2 target-address) rlm@377: assembly [0xF3 0x18 0xFE 0x12] rlm@377: get-mem-region #(subvec (vec (memory %)) rlm@377: target-address (+ target-address 20)) rlm@377: before (bootstrap-base) rlm@377: after rlm@377: (-> before rlm@392: (step []) ; make sure it can handle blanks rlm@392: (step []) ; at the beginning. rlm@377: (step []) rlm@402: (step (buttons set-H-mode)) ; select set-H rlm@401: (step (buttons target-high)) rlm@401: (step []) rlm@402: (step (buttons set-L-mode)) rlm@401: (step (buttons target-low)) rlm@401: (step []) rlm@401: (step (buttons write-mode)) rlm@392: (step (buttons 4)) ; write 4 bytes rlm@377: (step (buttons (nth assembly 0))) rlm@377: (step (buttons (nth assembly 1))) rlm@377: (step (buttons (nth assembly 2))) rlm@409: (step (buttons (nth assembly 3))))] rlm@405: ;;(println "before :" (get-mem-region before)) rlm@405: ;;(println "after :" (get-mem-region after)) rlm@405: ;;(assert (= assembly (take 4 (get-mem-region after)))) rlm@405: (println "write-test-passed.") rlm@377: after)) rlm@377: rlm@402: (defn test-jump [] rlm@377: (let [target-address 0xC00F rlm@377: [target-high target-low] (disect-bytes-2 target-address) rlm@377: post-jump rlm@402: (-> (test-write-bytes) rlm@402: (step (buttons set-H-mode)) ; select set-H rlm@402: (step (buttons target-high)) rlm@377: (step []) rlm@402: (step (buttons set-L-mode)) rlm@402: (step (buttons target-low)) rlm@377: (step []) rlm@402: (step (buttons jump-mode))) ; Select JUMP mode. rlm@377: program-counters rlm@377: (capture-program-counter rlm@377: post-jump rlm@377: 10000)] rlm@377: (assert (contains? (set program-counters) target-address)) rlm@405: (println "jump test passed.") rlm@377: post-jump)) rlm@402: rlm@405: (defn test-no-repeated-nybbles [] rlm@405: (bootstrap-pattern (main-bootstrap-program)) rlm@405: (println "no-repeated-nybbles")) rlm@402: rlm@402: (defn run-all-tests [] rlm@402: (test-frame-metronome) rlm@402: (test-read-user-input) rlm@402: (test-set-H) rlm@402: (test-write-bytes) rlm@405: (test-jump) rlm@405: (test-no-repeated-nybbles) rlm@405: (println "\n all tests passed."))