Mercurial > vba-clojure
changeset 404:41647cb85901
got main-bootstrap-program down to 67 opcodes.
| author | Robert McIntyre <rlm@mit.edu> |
|---|---|
| date | Fri, 13 Apr 2012 11:18:08 -0500 |
| parents | ea37e98e188e |
| children | bca0abd39db5 |
| files | clojure/com/aurellem/gb/rlm_assembly.clj |
| diffstat | 1 files changed, 69 insertions(+), 61 deletions(-) [+] |
line wrap: on
line diff
1.1 --- a/clojure/com/aurellem/gb/rlm_assembly.clj Fri Apr 13 09:59:32 2012 -0500 1.2 +++ b/clojure/com/aurellem/gb/rlm_assembly.clj Fri Apr 13 11:18:08 2012 -0500 1.3 @@ -70,38 +70,51 @@ 1.4 (if (< n 0) 1.5 (+ 256 n) n)) 1.6 1.7 -(defn frame-metronome 1.8 - ([] (frame-metronome true)) 1.9 - ([spin-loop?] 1.10 - (let [init [0xC5] ;; save value of BC 1.11 - timing-loop 1.12 - [0x01 ; \ 1.13 - 0x43 ; | 1.14 - 0xFE ; | load 0xFF44 into BC without repeats 1.15 - 0x0C ; | 1.16 - 0x04 ; / 1.17 - 0x0A] ;; (BC) -> A, now A = LY (vertical line coord) 1.18 - continue-if-144 1.19 - [0xFE 1.20 - 144 ;; compare LY (in A) with 144 1.21 - 0x20 ;; jump back to beginning if LY != 144 (not-v-blank) 1.22 - (->signed-8-bit 1.23 - (+ -4 (- (count timing-loop))))] 1.24 - spin-loop 1.25 - [0x05 ;; dec B, which is 0xFF 1.26 - 0x20 ;; spin until B==0 1.27 - 0xFD]] 1.28 - (concat init timing-loop continue-if-144 1.29 - (if spin-loop? 1.30 - spin-loop []))))) 1.31 +(defn frame-metronome** [] 1.32 + (let [init [0xC5] ;; save value of BC 1.33 + timing-loop 1.34 + [0x01 ; \ 1.35 + 0x43 ; | 1.36 + 0xFE ; | load 0xFF44 into BC without repeats 1.37 + 0x0C ; | 1.38 + 0x04 ; / 1.39 + 0x0A] ;; (BC) -> A, now A = LY (vertical line coord) 1.40 + continue-if-144 1.41 + [0xFE 1.42 + 144 ;; compare LY (in A) with 144 1.43 + 0x20 ;; jump back to beginning if LY != 144 (not-v-blank) 1.44 + (->signed-8-bit 1.45 + (+ -4 (- (count timing-loop))))] 1.46 + spin-loop 1.47 + [0x05 ;; dec B, which is 0xFF 1.48 + 0x20 ;; spin until B==0 1.49 + 0xFD]] 1.50 + (concat init timing-loop continue-if-144 spin-loop))) 1.51 + 1.52 +(defn frame-metronome* [] 1.53 + [0x3E ;; smallest version, but uses repeated nybbles 1.54 + 0x01 1.55 + 0xE0 1.56 + 0xFF]) 1.57 + 1.58 + 1.59 +(defn frame-metronome [] 1.60 + [0x06 ;; load 0xFE into B 1.61 + 0xFE 1.62 + 0x04 ;; inc B, now B == FF 1.63 + 0x3E 1.64 + 0x01 ;; 1->A 1.65 + 1.66 + 0x48 ;; B->C 1.67 + 0x02]) ;; A->(BC) set exclusive v-blank interrupt 1.68 1.69 (defn test-frame-metronome 1.70 "Ensure that frame-metronome ticks exactly once every frame." 1.71 ([] (test-frame-metronome 151)) 1.72 ([steps] 1.73 - (let [inc-E [0x1C 0x18 1.74 - (->signed-8-bit 1.75 - (+ -3 (- (count (frame-metronome)))))] 1.76 + (let [inc-E [0x1C 0x76 0x18 1.77 + (->signed-8-bit -4)] 1.78 + 1.79 program (concat (frame-metronome) inc-E) 1.80 count-frames 1.81 (-> (tick (mid-game)) 1.82 @@ -113,12 +126,15 @@ 1.83 (E (run-moves count-frames (repeat steps [])))] 1.84 (println "E:" E-after-moves) 1.85 (assert (= steps E-after-moves)) 1.86 - 1.87 + 1.88 (println "E =" E-after-moves "after" steps "steps") 1.89 count-frames))) 1.90 1.91 (defn read-user-input [] 1.92 - [0x3E 1.93 + [0xAF 0x4F 0x47 ;; 0->A; 0->C; 0->B 1.94 + 0xC5 ;; save value of BC 1.95 + 1.96 + 0x3E 1.97 0x20 ; prepare to measure d-pad 1.98 1.99 0x01 ;\ 1.100 @@ -156,7 +172,6 @@ 1.101 0xB0 ;; (or A B) -> A 1.102 1.103 0x2F ;; (NOT A) -> A 1.104 - 1.105 ]) 1.106 1.107 (defn test-read-user-input [] 1.108 @@ -164,19 +179,19 @@ 1.109 (concat 1.110 (frame-metronome) (read-user-input) 1.111 [0x5F ;; A-> E 1.112 + 0x76 1.113 0x18 1.114 (->signed-8-bit 1.115 - (+ (- (count (frame-metronome))) 1.116 - (- (count (read-user-input))) 1.117 - (- 3)))]) 1.118 + (+ (- (count (read-user-input))) 1.119 + (- 4)))]) 1.120 read-input 1.121 (-> (tick (mid-game)) 1.122 (IE! 0) 1.123 (set-memory-range pokemon-list-start program) 1.124 (PC! pokemon-list-start))] 1.125 (dorun 1.126 - (for [i (range 0x100)] 1.127 - (assert (= (E (step read-input (buttons i))) i)))) 1.128 + (for [i (range 0x100)] 1.129 + (assert (= (E (step read-input (buttons i))) i)))) 1.130 (println "Tested all inputs.") 1.131 read-input)) 1.132 1.133 @@ -208,13 +223,8 @@ 1.134 ;; multi-action-modes 1.135 ;; WRITE 0x47 ;; A->B 1.136 1.137 - (let [[start-high start-low] (disect-bytes-2 start-address) 1.138 - jump-distance (+ (count (frame-metronome)) 1.139 - (count (read-user-input))) 1.140 - 1.141 - init 1.142 - [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B 1.143 - 1.144 + (let [header (concat (frame-metronome) (read-user-input)) 1.145 + 1.146 input 1.147 [0xC1 ;; pop BC so it's not volatile 1.148 1.149 @@ -244,37 +254,35 @@ 1.150 0x7B ;; E->A 1.151 0x4F ;; A->C now C stores previous instruction 1.152 0x18 ;; return 1.153 - :to-beginning-1] 1.154 + :to-halt] 1.155 1.156 output 1.157 [:output-start ;; just a label 1.158 0x54 ;; 1.159 0x5D ;; HL->DE \ 1.160 - ;; | This mess is here to do 1.161 + ;; | This mess is here to do 1.162 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without 1.163 - ;; | any repeating nybbles 1.164 + ;; | any repeating nybbles 1.165 0x23 ;; inc HL / 1.166 1.167 0x05 ;; DEC bytes-to-write (B) 1.168 1.169 + 0x76 ;; HALT, peasant! 1.170 0x18 1.171 - :to-beginning-2] 1.172 - 1.173 + :to-beginning] 1.174 + 1.175 symbols 1.176 {:to-be-executed-address 1.177 (reverse 1.178 (disect-bytes-2 1.179 - (+ start-address jump-distance 1.180 - (count init) 1.181 + (+ start-address 1.182 + (count header) 1.183 (symbol-index :to-be-executed input)))) 1.184 :to-be-executed 0x00} ;; clear carry flag no-op 1.185 1.186 program** (flatten 1.187 - (replace 1.188 - symbols 1.189 - (concat init (frame-metronome) 1.190 - (read-user-input) 1.191 - input output))) 1.192 + (replace symbols (concat header input output))) 1.193 + 1.194 resolve-internal-jumps 1.195 {:output-start [] 1.196 :to-output 1.197 @@ -287,14 +295,14 @@ 1.198 (flatten (replace resolve-internal-jumps program**)) 1.199 1.200 resolve-external-jumps 1.201 - {:to-beginning-1 1.202 + {:to-halt 1.203 + (- (- (symbol-index :to-beginning program*) 1.204 + (symbol-index :to-halt program*)) 3) 1.205 + 1.206 + :to-beginning 1.207 (->signed-8-bit 1.208 - (+ (count init) 1.209 - -2 (- (dec (symbol-index :to-beginning-1 program*))))) 1.210 - :to-beginning-2 1.211 - (->signed-8-bit 1.212 - (+ (count init) 1.213 - -2 (- (dec (symbol-index :to-beginning-2 program*)))))} 1.214 + (+ 2 (count (frame-metronome)) 1.215 + (- (symbol-index :to-beginning program*))))} 1.216 1.217 program 1.218 (replace resolve-external-jumps program*)]