# HG changeset patch # User Robert McIntyre # Date 1334329172 18000 # Node ID ea37e98e188e2d648f2569264b56b564bcd3759e # Parent eee219d1a259410d2ac2369f07a60fe8cb2262a0 removed one opcode diff -r eee219d1a259 -r ea37e98e188e clojure/com/aurellem/gb/rlm_assembly.clj --- a/clojure/com/aurellem/gb/rlm_assembly.clj Fri Apr 13 09:47:34 2012 -0500 +++ b/clojure/com/aurellem/gb/rlm_assembly.clj Fri Apr 13 09:59:32 2012 -0500 @@ -70,26 +70,30 @@ (if (< n 0) (+ 256 n) n)) -(defn frame-metronome [] - (let [init [0xC5] ;; save value of BC - timing-loop - [0x01 ; \ - 0x43 ; | - 0xFE ; | load 0xFF44 into BC without repeats - 0x0C ; | - 0x04 ; / - 0x0A] ;; (BC) -> A, now A = LY (vertical line coord) - continue-if-144 - [0xFE - 144 ;; compare LY (in A) with 144 - 0x20 ;; jump back to beginning if LY != 144 (not-v-blank) - (->signed-8-bit - (+ -4 (- (count timing-loop))))] - spin-loop - [0x05 ;; dec B, which is 0xFF - 0x20 ;; spin until B==0 - 0xFD]] - (concat init timing-loop continue-if-144 spin-loop))) +(defn frame-metronome + ([] (frame-metronome true)) + ([spin-loop?] + (let [init [0xC5] ;; save value of BC + timing-loop + [0x01 ; \ + 0x43 ; | + 0xFE ; | load 0xFF44 into BC without repeats + 0x0C ; | + 0x04 ; / + 0x0A] ;; (BC) -> A, now A = LY (vertical line coord) + continue-if-144 + [0xFE + 144 ;; compare LY (in A) with 144 + 0x20 ;; jump back to beginning if LY != 144 (not-v-blank) + (->signed-8-bit + (+ -4 (- (count timing-loop))))] + spin-loop + [0x05 ;; dec B, which is 0xFF + 0x20 ;; spin until B==0 + 0xFD]] + (concat init timing-loop continue-if-144 + (if spin-loop? + spin-loop []))))) (defn test-frame-metronome "Ensure that frame-metronome ticks exactly once every frame." @@ -182,118 +186,119 @@ (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 [[start-high start-low] (disect-bytes-2 start-address) + jump-distance (+ (count (frame-metronome)) + (count (read-user-input))) - (let [[start-high start-low] (disect-bytes-2 start-address) - jump-distance (+ (count (frame-metronome)) - (count (read-user-input))) + init + [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B - init - [0xAF 0x4F 0x57 0x47] ;; 0->A; 0->C; 0->D; 0->B + input + [0xC1 ;; pop BC so it's not volatile - input - [0xC1 ;; pop BC so it's not volatile + 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 - 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 + ;; write mode to instruction-to-be-executed (pun) + 0xEA + :to-be-executed-address - ;; write mode to instruction-to-be-executed (pun) - 0xEA - :to-be-executed-address + ;; 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 \ + ;; | This mess is here to do + 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without + ;; | any repeating nybbles + 0x23 ;; inc HL / - ;; 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 \ - ;; | This mess is here to do - 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without - ;; | any repeating nybbles - 0x23 ;; inc HL / + 0x05 ;; DEC bytes-to-write (B) - 0x05 ;; DEC bytes-to-write (B) + 0x18 + :to-beginning-2] + + 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 - 0x18 - :to-beginning-2] - - 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 + (dec + (- (symbol-index :output-start program**) + (symbol-index :to-output program**))))} - program** (flatten - (replace - symbols - (concat init (frame-metronome) - (read-user-input) - 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-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* - (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 ;;;;;; @@ -324,8 +329,9 @@ ;;(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 "tested all H values") + result))) (defn test-write-bytes [] (let [target-address 0xC00F