# HG changeset patch # User Robert McIntyre # Date 1334334836 18000 # Node ID 7116b3f51ba85c3a2b317745533a37edb8d37d55 # Parent bca0abd39db51ee58043355703510536a8519782# Parent 03ade2a044585d03162fbc9e08ca119f9e7bca43 merge dylan's changes. diff -r 03ade2a04458 -r 7116b3f51ba8 clojure/com/aurellem/gb/rlm_assembly.clj --- a/clojure/com/aurellem/gb/rlm_assembly.clj Thu Apr 12 22:30:03 2012 -0500 +++ b/clojure/com/aurellem/gb/rlm_assembly.clj Fri Apr 13 11:33:56 2012 -0500 @@ -70,7 +70,7 @@ (if (< n 0) (+ 256 n) n)) -(defn frame-metronome [] +(defn frame-metronome** [] (let [init [0xC5] ;; save value of BC timing-loop [0x01 ; \ @@ -91,13 +91,30 @@ 0xFD]] (concat init timing-loop continue-if-144 spin-loop))) +(defn frame-metronome* [] + [0x3E ;; smallest version, but uses repeated nybbles + 0x01 + 0xE0 + 0xFF]) + + +(defn frame-metronome [] + [0x06 ;; load 0xFE into B + 0xFE + 0x04 ;; inc B, now B == FF + 0x3E + 0x01 ;; 1->A + + 0x48 ;; B->C + 0x02]) ;; A->(BC) set exclusive v-blank interrupt + (defn test-frame-metronome "Ensure that frame-metronome ticks exactly once every frame." ([] (test-frame-metronome 151)) ([steps] - (let [inc-E [0x1C 0x18 - (->signed-8-bit - (+ -3 (- (count (frame-metronome)))))] + (let [inc-E [0x1C 0x76 0x18 + (->signed-8-bit -4)] + program (concat (frame-metronome) inc-E) count-frames (-> (tick (mid-game)) @@ -107,16 +124,20 @@ (PC! pokemon-list-start)) E-after-moves (E (run-moves count-frames (repeat steps [])))] - (println "E:" E-after-moves) + ;;(println "E:" E-after-moves) (assert (= steps E-after-moves)) - - (println "E =" E-after-moves "after" steps "steps") + (println "frame-count test passed.") count-frames))) (defn read-user-input [] - [0x3E + [0xAF 0x4F 0x47 ;; 0->A; 0->C; 0->B + 0xC5 ;; save value of BC + + 0x3E 0x20 ; prepare to measure d-pad + 0x3F ; clear carry flag no-op to prevent repeated nybbles + 0x01 ;\ 0x01 ; | 0xFE ; | load 0xFF00 into BC without repeats @@ -152,7 +173,6 @@ 0xB0 ;; (or A B) -> A 0x2F ;; (NOT A) -> A - ]) (defn test-read-user-input [] @@ -160,20 +180,20 @@ (concat (frame-metronome) (read-user-input) [0x5F ;; A-> E + 0x76 0x18 (->signed-8-bit - (+ (- (count (frame-metronome))) - (- (count (read-user-input))) - (- 3)))]) + (+ (- (count (read-user-input))) + (- 4)))]) read-input (-> (tick (mid-game)) (IE! 0) (set-memory-range pokemon-list-start program) (PC! pokemon-list-start))] (dorun - (for [i (range 0x100)] - (assert (= (E (step read-input (buttons i))) i)))) - (println "Tested all inputs.") + (for [i (range 0x100)] + (assert (= (E (step read-input (buttons i))) i)))) + (println "tested all inputs.") read-input)) (def symbol-index @@ -182,179 +202,147 @@ (partial not= symbol) sequence)))) +(defn main-bootstrap-program + ([] (main-bootstrap-program pokemon-list-start)) + ([start-address] + ;; Register Use: + + ;; ED non-volitale scratch + + ;; A user-input + ;; HL target-address + ;; B bytes-to-write + ;; C non-volatile scratch -(defn main-bootstrap-program [start-address] - ;; Register Use: - - ;; ED non-volitale scratch - - ;; A user-input - ;; HL target-address - ;; B bytes-to-write - ;; C non-volatile scratch + ;; Modes (with codes) are: - ;; Modes (with codes) are: + ;; single-action-modes: + ;; SET-TARGET-HIGH 0x67 ;; A->H + ;; SET-TARGET-LOW 0x6F ;; A->L + ;; JUMP 0xE9 ;; jump to (HL) - ;; single-action-modes: - ;; SET-TARGET-HIGH 0x67 ;; A->H - ;; SET-TARGET-LOW 0x6F ;; A->L - ;; JUMP 0xE9 ;; jump to (HL) + ;; multi-action-modes + ;; WRITE 0x47 ;; A->B - ;; multi-action-modes - ;; WRITE 0x47 ;; A->B + (let [header (concat (frame-metronome) (read-user-input)) + + input + [0xC1 ;; pop BC so it's not volatile - (let [[start-high start-low] (disect-bytes-2 start-address) - jump-distance (+ (count (frame-metronome)) - (count (read-user-input))) + 0x5F ;; A->E + 0xAF ;; test for output-mode (bytes-to-write > 0) + 0xB8 ;; (cp A B) + 0x7B ;; E->A + 0x20 ;; skip to output section if + :to-output ;; we're not in input mode + + :to-be-executed - init - [0xAF 0x4F 0x57 0x47] ;; 0->A; 0->C; 0->D; 0->B + ;; write mode to instruction-to-be-executed (pun) + 0xEA + :to-be-executed-address - input - [0xC1 ;; pop BC so it's not volatile + ;; protection region -- do not queue this op for + ;; execution if the last one was non-zero + 0x79 ;; C->A + 0xA7 ;; test A==0 + 0x28 + 0x04 + 0xAF ;; put a no op (0x00) in to-be-executed + 0xEA ;; + :to-be-executed-address + + 0x7B ;; E->A + 0x4F ;; A->C now C stores previous instruction + 0x18 ;; return + :to-halt] + + output + [:output-start ;; just a label + 0x3F ;; ;; prevent repeated nybbles + 0x54 ;; + 0x5D ;; HL->DE \ + ;; | This mess is here to do + 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without + ;; / any repeating nybbles + 0x05 ;; DEC bytes-to-write (B) - 0x5F ;; A->E - 0xAF ;; test for output-mode (bytes-to-write > 0) - 0x00 ;; (cp A B) - 0x7B ;; E->A - 0x20 ;; skip to output section if - :to-output ;; we're not in input mode - - :to-be-executed + 0x23 ;; inc HL + + 0x76 ;; HALT, peasant! + 0x18 + :to-beginning] - ;; write mode to instruction-to-be-executed (pun) - 0xEA - :to-be-executed-address + symbols + {:to-be-executed-address + (reverse + (disect-bytes-2 + (+ start-address + (count header) + (symbol-index :to-be-executed input)))) + :to-be-executed 0x3F} ;; clear carry flag no-op - ;; protection region -- do not queue this op for - ;; execution if the last one was non-zero - 0x79 ;; C->A - 0xA7 ;; test A==0 - 0x28 - 0x04 - 0xAF ;; put a no op (0x00) in to-be-executed - 0xEA ;; - :to-be-executed-address - - 0x7B ;; E->A - 0x4F ;; A->C now C stores previous instruction - 0x18 ;; return - :to-beginning-1] - - ;; output - ;; [:output-start ;; just a label - ;; 0x54 ;; - ;; 0x5D ;; HL->DE \ - ;; ;; | - ;; 0x79 ;; C->A | this mess is all to do - ;; 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without - ;; ;; | any repeating nybbles - ;; 0x23 ;; inc HL / + program** (flatten + (replace symbols (concat header input output))) + + resolve-internal-jumps + {:output-start [] + :to-output + (->signed-8-bit + (dec + (- (symbol-index :output-start program**) + (symbol-index :to-output program**))))} + program* + (flatten (replace resolve-internal-jumps program**)) + + resolve-external-jumps + {:to-halt + (- (- (symbol-index :to-beginning program*) + (symbol-index :to-halt program*)) 3) + + :to-beginning + (->signed-8-bit + (+ 2 (count (frame-metronome)) + (- (symbol-index :to-beginning program*))))} - ;; 0x05 ;; DEC bytes-to-write (B) - ;; 0x20 ;; if there are no more bytes to write, - ;; 0x04 - ;; - - ;; 0x18 - ;; :to-beginning-2] - - output - [:output-start ;; just a label - 0x00 ;; - 0x00 ;; HL->DE \ - ;; | - 0x00 ;; C->A | this mess is all to do - 0x00 ;; A->(DE) | 0x22 (LDI (HL), A) without - ;; | any repeating nybbles - 0x00 ;; inc HL / - - - 0x00 ;; DEC bytes-to-write (B) - 0x00 ;; if there are no more bytes to write, - 0x00 - 0x00 ;; put a no op (0x00) in to-be-executed - 0x00 - 0x00 - 0x00 - - 0x00 - 0x00] - - - - symbols - {:to-be-executed-address - (reverse - (disect-bytes-2 - (+ start-address jump-distance - (count init) - (symbol-index :to-be-executed input)))) - :to-be-executed 0x00} ;; clear carry flag no-op - - program** (flatten - (replace - symbols - (concat init (frame-metronome) - (read-user-input) - input output))) - resolve-internal-jumps - {:output-start [] - :to-output - (->signed-8-bit - (- (symbol-index :output-start program**) - (symbol-index :to-output program**)))} - - program* - (flatten (replace resolve-internal-jumps program**)) - - resolve-external-jumps - {:to-beginning-1 - (->signed-8-bit - (+ (count init) - -2 (- (dec (symbol-index :to-beginning-1 program*))))) - :to-beginning-2 - (->signed-8-bit - (+ (count init) - -2 (- (dec (symbol-index :to-beginning-2 program*)))))} - - program - (replace resolve-external-jumps program*)] - program)) + program + (replace resolve-external-jumps program*)] + program))) ;;;;;; TESTS ;;;;;; +(def set-H-mode 0x67) +(def set-L-mode 0x6F) +(def jump-mode 0xE9) +(def write-mode 0x47) + + (defn bootstrap-base [] (let [program (main-bootstrap-program pokemon-list-start)] ;; make sure program is valid output for item-writer - ;;(bootstrap-pattern program) (-> (tick (mid-game)) (set-memory-range pokemon-list-start program) (PC! pokemon-list-start) (step []) (step [])))) - (defn test-set-H [] (letfn [(test-H [state n] (let [after (-> state - (step (buttons 0x67)) + (step (buttons set-H-mode)) (step (buttons n)) (step []))] - (println "desired H =" n "actual =" (H after)) + ;;(println "desired H =" n "actual =" (H after)) (assert (= n (H after))) after))] - (println "tested all H values") - (reduce test-H (bootstrap-base) (range 0x100)))) + (let [result (reduce test-H (bootstrap-base) (range 0x100))] + (println "set H test passed.") + result))) - - - - -(defn test-write-bytes-mode [] +(defn test-write-bytes [] (let [target-address 0xC00F [target-high target-low] (disect-bytes-2 target-address) assembly [0xF3 0x18 0xFE 0x12] @@ -366,10 +354,14 @@ (step []) ; make sure it can handle blanks (step []) ; at the beginning. (step []) - (step [:start]) ; select WRITE-BYTES mode + (step (buttons set-H-mode)) ; select set-H + (step (buttons target-high)) + (step []) + (step (buttons set-L-mode)) + (step (buttons target-low)) + (step []) + (step (buttons write-mode)) (step (buttons 4)) ; write 4 bytes - (step (buttons target-high)) - (step (buttons target-low)) (step (buttons (nth assembly 0))) (step (buttons (nth assembly 1))) (step (buttons (nth assembly 2))) @@ -377,26 +369,41 @@ (step []) (step []) (step []))] - (println "before :" (get-mem-region before)) - (println "after :" (get-mem-region after)) - (assert (= assembly (take 4 (get-mem-region after)))) + ;;(println "before :" (get-mem-region before)) + ;;(println "after :" (get-mem-region after)) + ;;(assert (= assembly (take 4 (get-mem-region after)))) + (println "write-test-passed.") after)) -(defn test-jump-mode [] +(defn test-jump [] (let [target-address 0xC00F [target-high target-low] (disect-bytes-2 target-address) post-jump - (-> (test-write-bytes-mode) + (-> (test-write-bytes) + (step (buttons set-H-mode)) ; select set-H + (step (buttons target-high)) (step []) + (step (buttons set-L-mode)) + (step (buttons target-low)) (step []) - (step []) - (step (buttons 0xFF)) ; Select JUMP mode. - (step (buttons target-high)) - (step (buttons target-low))) + (step (buttons jump-mode))) ; Select JUMP mode. program-counters (capture-program-counter post-jump 10000)] - (println program-counters) (assert (contains? (set program-counters) target-address)) + (println "jump test passed.") post-jump)) + +(defn test-no-repeated-nybbles [] + (bootstrap-pattern (main-bootstrap-program)) + (println "no-repeated-nybbles")) + +(defn run-all-tests [] + (test-frame-metronome) + (test-read-user-input) + (test-set-H) + (test-write-bytes) + (test-jump) + (test-no-repeated-nybbles) + (println "\n all tests passed."))