Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/rlm_assembly.clj @ 404:41647cb85901

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
403:ea37e98e188e 404:41647cb85901
68 68
69 (defn ->signed-8-bit [n] 69 (defn ->signed-8-bit [n]
70 (if (< n 0) 70 (if (< n 0)
71 (+ 256 n) n)) 71 (+ 256 n) n))
72 72
73 (defn frame-metronome 73 (defn frame-metronome** []
74 ([] (frame-metronome true)) 74 (let [init [0xC5] ;; save value of BC
75 ([spin-loop?] 75 timing-loop
76 (let [init [0xC5] ;; save value of BC 76 [0x01 ; \
77 timing-loop 77 0x43 ; |
78 [0x01 ; \ 78 0xFE ; | load 0xFF44 into BC without repeats
79 0x43 ; | 79 0x0C ; |
80 0xFE ; | load 0xFF44 into BC without repeats 80 0x04 ; /
81 0x0C ; | 81 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
82 0x04 ; / 82 continue-if-144
83 0x0A] ;; (BC) -> A, now A = LY (vertical line coord) 83 [0xFE
84 continue-if-144 84 144 ;; compare LY (in A) with 144
85 [0xFE 85 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
86 144 ;; compare LY (in A) with 144 86 (->signed-8-bit
87 0x20 ;; jump back to beginning if LY != 144 (not-v-blank) 87 (+ -4 (- (count timing-loop))))]
88 (->signed-8-bit 88 spin-loop
89 (+ -4 (- (count timing-loop))))] 89 [0x05 ;; dec B, which is 0xFF
90 spin-loop 90 0x20 ;; spin until B==0
91 [0x05 ;; dec B, which is 0xFF 91 0xFD]]
92 0x20 ;; spin until B==0 92 (concat init timing-loop continue-if-144 spin-loop)))
93 0xFD]] 93
94 (concat init timing-loop continue-if-144 94 (defn frame-metronome* []
95 (if spin-loop? 95 [0x3E ;; smallest version, but uses repeated nybbles
96 spin-loop []))))) 96 0x01
97 0xE0
98 0xFF])
99
100
101 (defn frame-metronome []
102 [0x06 ;; load 0xFE into B
103 0xFE
104 0x04 ;; inc B, now B == FF
105 0x3E
106 0x01 ;; 1->A
107
108 0x48 ;; B->C
109 0x02]) ;; A->(BC) set exclusive v-blank interrupt
97 110
98 (defn test-frame-metronome 111 (defn test-frame-metronome
99 "Ensure that frame-metronome ticks exactly once every frame." 112 "Ensure that frame-metronome ticks exactly once every frame."
100 ([] (test-frame-metronome 151)) 113 ([] (test-frame-metronome 151))
101 ([steps] 114 ([steps]
102 (let [inc-E [0x1C 0x18 115 (let [inc-E [0x1C 0x76 0x18
103 (->signed-8-bit 116 (->signed-8-bit -4)]
104 (+ -3 (- (count (frame-metronome)))))] 117
105 program (concat (frame-metronome) inc-E) 118 program (concat (frame-metronome) inc-E)
106 count-frames 119 count-frames
107 (-> (tick (mid-game)) 120 (-> (tick (mid-game))
108 (IE! 0) 121 (IE! 0)
109 (DE! 0) 122 (DE! 0)
111 (PC! pokemon-list-start)) 124 (PC! pokemon-list-start))
112 E-after-moves 125 E-after-moves
113 (E (run-moves count-frames (repeat steps [])))] 126 (E (run-moves count-frames (repeat steps [])))]
114 (println "E:" E-after-moves) 127 (println "E:" E-after-moves)
115 (assert (= steps E-after-moves)) 128 (assert (= steps E-after-moves))
116 129
117 (println "E =" E-after-moves "after" steps "steps") 130 (println "E =" E-after-moves "after" steps "steps")
118 count-frames))) 131 count-frames)))
119 132
120 (defn read-user-input [] 133 (defn read-user-input []
121 [0x3E 134 [0xAF 0x4F 0x47 ;; 0->A; 0->C; 0->B
135 0xC5 ;; save value of BC
136
137 0x3E
122 0x20 ; prepare to measure d-pad 138 0x20 ; prepare to measure d-pad
123 139
124 0x01 ;\ 140 0x01 ;\
125 0x01 ; | 141 0x01 ; |
126 0xFE ; | load 0xFF00 into BC without repeats 142 0xFE ; | load 0xFF00 into BC without repeats
154 0x37 ;; swap A nybbles 170 0x37 ;; swap A nybbles
155 171
156 0xB0 ;; (or A B) -> A 172 0xB0 ;; (or A B) -> A
157 173
158 0x2F ;; (NOT A) -> A 174 0x2F ;; (NOT A) -> A
159
160 ]) 175 ])
161 176
162 (defn test-read-user-input [] 177 (defn test-read-user-input []
163 (let [program 178 (let [program
164 (concat 179 (concat
165 (frame-metronome) (read-user-input) 180 (frame-metronome) (read-user-input)
166 [0x5F ;; A-> E 181 [0x5F ;; A-> E
182 0x76
167 0x18 183 0x18
168 (->signed-8-bit 184 (->signed-8-bit
169 (+ (- (count (frame-metronome))) 185 (+ (- (count (read-user-input)))
170 (- (count (read-user-input))) 186 (- 4)))])
171 (- 3)))])
172 read-input 187 read-input
173 (-> (tick (mid-game)) 188 (-> (tick (mid-game))
174 (IE! 0) 189 (IE! 0)
175 (set-memory-range pokemon-list-start program) 190 (set-memory-range pokemon-list-start program)
176 (PC! pokemon-list-start))] 191 (PC! pokemon-list-start))]
177 (dorun 192 (dorun
178 (for [i (range 0x100)] 193 (for [i (range 0x100)]
179 (assert (= (E (step read-input (buttons i))) i)))) 194 (assert (= (E (step read-input (buttons i))) i))))
180 (println "Tested all inputs.") 195 (println "Tested all inputs.")
181 read-input)) 196 read-input))
182 197
183 (def symbol-index 198 (def symbol-index
184 (fn [symbol sequence] 199 (fn [symbol sequence]
206 ;; JUMP 0xE9 ;; jump to (HL) 221 ;; JUMP 0xE9 ;; jump to (HL)
207 222
208 ;; multi-action-modes 223 ;; multi-action-modes
209 ;; WRITE 0x47 ;; A->B 224 ;; WRITE 0x47 ;; A->B
210 225
211 (let [[start-high start-low] (disect-bytes-2 start-address) 226 (let [header (concat (frame-metronome) (read-user-input))
212 jump-distance (+ (count (frame-metronome)) 227
213 (count (read-user-input)))
214
215 init
216 [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
217
218 input 228 input
219 [0xC1 ;; pop BC so it's not volatile 229 [0xC1 ;; pop BC so it's not volatile
220 230
221 0x5F ;; A->E 231 0x5F ;; A->E
222 0xAF ;; test for output-mode (bytes-to-write > 0) 232 0xAF ;; test for output-mode (bytes-to-write > 0)
242 :to-be-executed-address 252 :to-be-executed-address
243 253
244 0x7B ;; E->A 254 0x7B ;; E->A
245 0x4F ;; A->C now C stores previous instruction 255 0x4F ;; A->C now C stores previous instruction
246 0x18 ;; return 256 0x18 ;; return
247 :to-beginning-1] 257 :to-halt]
248 258
249 output 259 output
250 [:output-start ;; just a label 260 [:output-start ;; just a label
251 0x54 ;; 261 0x54 ;;
252 0x5D ;; HL->DE \ 262 0x5D ;; HL->DE \
253 ;; | This mess is here to do 263 ;; | This mess is here to do
254 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without 264 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
255 ;; | any repeating nybbles 265 ;; | any repeating nybbles
256 0x23 ;; inc HL / 266 0x23 ;; inc HL /
257 267
258 0x05 ;; DEC bytes-to-write (B) 268 0x05 ;; DEC bytes-to-write (B)
259 269
270 0x76 ;; HALT, peasant!
260 0x18 271 0x18
261 :to-beginning-2] 272 :to-beginning]
262 273
263 symbols 274 symbols
264 {:to-be-executed-address 275 {:to-be-executed-address
265 (reverse 276 (reverse
266 (disect-bytes-2 277 (disect-bytes-2
267 (+ start-address jump-distance 278 (+ start-address
268 (count init) 279 (count header)
269 (symbol-index :to-be-executed input)))) 280 (symbol-index :to-be-executed input))))
270 :to-be-executed 0x00} ;; clear carry flag no-op 281 :to-be-executed 0x00} ;; clear carry flag no-op
271 282
272 program** (flatten 283 program** (flatten
273 (replace 284 (replace symbols (concat header input output)))
274 symbols 285
275 (concat init (frame-metronome)
276 (read-user-input)
277 input output)))
278 resolve-internal-jumps 286 resolve-internal-jumps
279 {:output-start [] 287 {:output-start []
280 :to-output 288 :to-output
281 (->signed-8-bit 289 (->signed-8-bit
282 (dec 290 (dec
285 293
286 program* 294 program*
287 (flatten (replace resolve-internal-jumps program**)) 295 (flatten (replace resolve-internal-jumps program**))
288 296
289 resolve-external-jumps 297 resolve-external-jumps
290 {:to-beginning-1 298 {:to-halt
299 (- (- (symbol-index :to-beginning program*)
300 (symbol-index :to-halt program*)) 3)
301
302 :to-beginning
291 (->signed-8-bit 303 (->signed-8-bit
292 (+ (count init) 304 (+ 2 (count (frame-metronome))
293 -2 (- (dec (symbol-index :to-beginning-1 program*))))) 305 (- (symbol-index :to-beginning program*))))}
294 :to-beginning-2
295 (->signed-8-bit
296 (+ (count init)
297 -2 (- (dec (symbol-index :to-beginning-2 program*)))))}
298 306
299 program 307 program
300 (replace resolve-external-jumps program*)] 308 (replace resolve-external-jumps program*)]
301 program))) 309 program)))
302 310