view clojure/com/aurellem/gb/rlm_assembly.clj @ 398:0591dcddf831

fixed bug where variables would be overwritten.
author Robert McIntyre <rlm@mit.edu>
date Fri, 13 Apr 2012 05:28:17 -0500
parents 9b0d79cad624
children ddb3c6299619
line wrap: on
line source
1 (ns com.aurellem.gb.rlm-assembly
2 "Version of main bootstrap program that is valid output for the
3 item-writer program."
4 (:use (com.aurellem.gb gb-driver assembly util vbm constants))
5 (:use (com.aurellem.run bootstrap-1))
6 (:import [com.aurellem.gb.gb_driver SaveState]))
9 ;; MODE-SELECT
10 ;; SET-LENGTH
11 ;; SET-TARGET
12 ;; WRITE
13 ;; JUMP
15 ;; Specs for Main Bootstrap Program
17 ;; Number-Input
18 ;; Number input works using all eight buttons to
19 ;; spell out an 8 bit number. The order of buttons is
20 ;; [:d :u :l :r :start :select :b :a] --> 11111111
21 ;; [ :l :start :a] --> 00101001
23 ;;; MODE-SELECT
24 ;; The bootstrap program starts in MODE-SELECT mode.
25 ;; MODE-SELECT transitions to one of three modes depending
26 ;; on which buttons are pressed:
27 ;; 0 (no-buttons) : MODE-SELECT
28 ;; 8 [:start] : WRITE-BYTES
29 ;; 0xFF (all-buttons) : JUMP
31 ;;; WRITE-BYTES
33 ;; WRITE-BYTES mode writes sequences of arbitray values to
34 ;; arbitray memory locations. It expects you to enter a
35 ;; header of three bytes describing what to write:
37 ;; Byte 0 : Number of Bytes to Write
38 ;; Byte 1 : Start Address High Byte
39 ;; Byte 1 : Start Address Low Byte
41 ;; Then, you enter the number of bytes specified in Byte 0
42 ;; they are written to the start address in
43 ;; sequence. After the last byte is written control
44 ;; returns to MODE-SELECT mode.
46 ;; Example: to write the sequence [1 2 3 4] starting at
47 ;; address 0xC01F enter
48 ;; Byte 0 : 4 (will write four bytes)
49 ;; Byte 1 : 0xC0 (high byte of 0xC01F)
50 ;; Byte 2 : 0x1F (low byte of 0xC01F)
51 ;; Byte 3 : 1 (write 1 to 0xC01F)
52 ;; Byte 4 : 2 (write 2 to 0xC020)
53 ;; Byte 5 : 3 (write 3 to 0xC021)
54 ;; Byte 6 : 4 (write 4 to 0xC022)
56 ;;; JUMP
57 ;; JUMP mode jumps program control to any arbitray
58 ;; location. It expects you to enter two bytes which
59 ;; correspond to the high and low bytes of the memory
60 ;; address to which you want to jump.
61 ;; Byte 0 : Jump Address High Byte
62 ;; Byte 1 : Jump Address Low Byte
64 ;; Example: to jump to address 0x1234 enter
65 ;; Byte 0 : 0x12 (high byte of 0x1234)
66 ;; Byte 1 : 0x34 (low byte of 0x1234)
69 (defn ->signed-8-bit [n]
70 (if (< n 0)
71 (+ 256 n) n))
73 (defn frame-metronome []
74 (let [init [0xC5] ;; save value of BC
75 timing-loop
76 [0x01 ; \
77 0x43 ; |
78 0xFE ; | load 0xFF44 into BC without repeats
79 0x0C ; |
80 0x04 ; /
81 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
82 continue-if-144
83 [0xFE
84 144 ;; compare LY (in A) with 144
85 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
86 (->signed-8-bit
87 (+ -4 (- (count timing-loop))))]
88 spin-loop
89 [0x05 ;; dec B, which is 0xFF
90 0x20 ;; spin until B==0
91 0xFD]]
92 (concat init timing-loop continue-if-144 spin-loop)))
94 (defn test-frame-metronome
95 "Ensure that frame-metronome ticks exactly once every frame."
96 ([] (test-frame-metronome 151))
97 ([steps]
98 (let [inc-E [0x1C 0x18
99 (->signed-8-bit
100 (+ -3 (- (count (frame-metronome)))))]
101 program (concat (frame-metronome) inc-E)
102 count-frames
103 (-> (tick (mid-game))
104 (IE! 0)
105 (DE! 0)
106 (set-memory-range pokemon-list-start program)
107 (PC! pokemon-list-start))
108 E-after-moves
109 (E (run-moves count-frames (repeat steps [])))]
110 (println "E:" E-after-moves)
111 (assert (= steps E-after-moves))
113 (println "E =" E-after-moves "after" steps "steps")
114 count-frames)))
116 (defn read-user-input []
117 [0x3E
118 0x20 ; prepare to measure d-pad
120 0x01 ;\
121 0x01 ; |
122 0xFE ; | load 0xFF00 into BC without repeats
123 0x04 ; |
124 0x0D ;/
126 0x02
127 0x0A ;; get D-pad info
129 0xF5 ;; push AF
131 0x3E
132 0x10 ; prepare to measure buttons
134 0x3F ;; clear carry flag no-op to prevent repeated nybbbles
136 0x02
137 0x0A ;; get button info
139 0xE6 ;; select bottom bits of A
140 0x0F
142 0x47 ;; A->B
144 0xF1 ;; pop AF
146 0xE6
147 0x0F ;; select bottom bits of A
149 0xCB
150 0x37 ;; swap A nybbles
152 0xB0 ;; (or A B) -> A
154 0x2F ;; (NOT A) -> A
156 ])
158 (defn test-read-user-input []
159 (let [program
160 (concat
161 (frame-metronome) (read-user-input)
162 [0x5F ;; A-> E
163 0x18
164 (->signed-8-bit
165 (+ (- (count (frame-metronome)))
166 (- (count (read-user-input)))
167 (- 3)))])
168 read-input
169 (-> (tick (mid-game))
170 (IE! 0)
171 (set-memory-range pokemon-list-start program)
172 (PC! pokemon-list-start))]
173 (dorun
174 (for [i (range 0x100)]
175 (assert (= (E (step read-input (buttons i))) i))))
176 (println "Tested all inputs.")
177 read-input))
179 (def symbol-index
180 (fn [symbol sequence]
181 (count (take-while
182 (partial not= symbol)
183 sequence))))
186 (defn main-bootstrap-program [start-address]
187 ;; Register Use:
189 ;; ED non-volitale scratch
191 ;; A user-input
192 ;; HL target-address
193 ;; B bytes-to-write
194 ;; C non-volatile scratch
196 ;; Modes (with codes) are:
198 ;; single-action-modes:
199 ;; SET-TARGET-HIGH 0x67 ;; A->H
200 ;; SET-TARGET-LOW 0x6F ;; A->L
201 ;; JUMP 0xE9 ;; jump to (HL)
203 ;; multi-action-modes
204 ;; WRITE 0x47 ;; A->B
206 (let [[start-high start-low] (disect-bytes-2 start-address)
207 jump-distance (+ (count (frame-metronome))
208 (count (read-user-input)))
210 init
211 [0xAF 0x4F 0x57 0x47] ;; 0->A; 0->C; 0->D; 0->B
213 input
214 [0xC1 ;; pop BC so it's not volatile
216 0x5F ;; A->E
217 0xAF ;; test for output-mode (bytes-to-write > 0)
218 0x00 ;; (cp A B)
219 0x7B ;; E->A
220 0x20 ;; skip input section if
221 :to-output ;; we're not in input mode
223 :to-be-executed
225 ;; write mode to instruction-to-be-executed (pun)
226 0xEA
227 :to-be-executed-address
229 0x0C ;; inc C
230 0xCB
231 0x41 ;; test bit 0 of C
232 0x20 ;; if (0 == (C % 2))
233 0x04
234 0xAF ;; put a no op (0x00) in to-be-executed
235 0xEA
236 :to-be-executed-address
238 0x18 ;; return
239 :to-beginning-1]
241 ;; output
242 ;; [:output-start ;; just a label
243 ;; 0x54 ;;
244 ;; 0x5D ;; HL->DE \
245 ;; ;; |
246 ;; 0x79 ;; C->A | this mess is all to do
247 ;; 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
248 ;; ;; | any repeating nybbles
249 ;; 0x23 ;; inc HL /
252 ;; 0x05 ;; DEC bytes-to-write (B)
253 ;; 0x20 ;; if there are no more bytes to write,
254 ;; 0x04
255 ;;
257 ;; 0x18
258 ;; :to-beginning-2]
260 output
261 [:output-start ;; just a label
262 0x00 ;;
263 0x00 ;; HL->DE \
264 ;; |
265 0x00 ;; C->A | this mess is all to do
266 0x00 ;; A->(DE) | 0x22 (LDI (HL), A) without
267 ;; | any repeating nybbles
268 0x00 ;; inc HL /
271 0x00 ;; DEC bytes-to-write (B)
272 0x00 ;; if there are no more bytes to write,
273 0x00
274 0x00 ;; put a no op (0x00) in to-be-executed
275 0x00
276 0x00
277 0x00
279 0x00
280 0x00]
284 symbols
285 {:to-be-executed-address
286 (reverse
287 (disect-bytes-2
288 (+ start-address jump-distance
289 (count init)
290 (symbol-index :to-be-executed input))))
291 :to-be-executed 0x00} ;; clear carry flag no-op
293 program** (flatten
294 (replace
295 symbols
296 (concat init (frame-metronome)
297 (read-user-input)
298 input output)))
299 resolve-internal-jumps
300 {:output-start []
301 :to-output
302 (->signed-8-bit
303 (- (symbol-index :output-start program**)
304 (symbol-index :to-output program**)))}
306 program*
307 (flatten (replace resolve-internal-jumps program**))
309 resolve-external-jumps
310 {:to-beginning-1
311 (->signed-8-bit
312 (+ (count init)
313 -2 (- (dec (symbol-index :to-beginning-1 program*)))))
314 :to-beginning-2
315 (->signed-8-bit
316 (+ (count init)
317 -2 (- (dec (symbol-index :to-beginning-2 program*)))))}
319 program
320 (replace resolve-external-jumps program*)]
321 program))
324 ;;;;;; TESTS ;;;;;;
326 (defn bootstrap-base []
327 (let [program (main-bootstrap-program pokemon-list-start)]
328 ;; make sure program is valid output for item-writer
329 ;;(bootstrap-pattern program)
330 (-> (tick (mid-game))
331 (set-memory-range pokemon-list-start program)
332 (PC! pokemon-list-start))))
334 (defn test-set-H [n]
335 (let [after
336 (-> (bootstrap-base)
337 (step [])
338 (step [])
339 (step (buttons 0x67))
340 (step (buttons n))
341 )]
342 (hex (H after))))
344 (defn test-write-bytes-mode []
345 (let [target-address 0xC00F
346 [target-high target-low] (disect-bytes-2 target-address)
347 assembly [0xF3 0x18 0xFE 0x12]
348 get-mem-region #(subvec (vec (memory %))
349 target-address (+ target-address 20))
350 before (bootstrap-base)
351 after
352 (-> before
353 (step []) ; make sure it can handle blanks
354 (step []) ; at the beginning.
355 (step [])
356 (step [:start]) ; select WRITE-BYTES mode
357 (step (buttons 4)) ; write 4 bytes
358 (step (buttons target-high))
359 (step (buttons target-low))
360 (step (buttons (nth assembly 0)))
361 (step (buttons (nth assembly 1)))
362 (step (buttons (nth assembly 2)))
363 (step (buttons (nth assembly 3)))
364 (step [])
365 (step [])
366 (step []))]
367 (println "before :" (get-mem-region before))
368 (println "after :" (get-mem-region after))
369 (assert (= assembly (take 4 (get-mem-region after))))
370 after))
372 (defn test-jump-mode []
373 (let [target-address 0xC00F
374 [target-high target-low] (disect-bytes-2 target-address)
375 post-jump
376 (-> (test-write-bytes-mode)
377 (step [])
378 (step [])
379 (step [])
380 (step (buttons 0xFF)) ; Select JUMP mode.
381 (step (buttons target-high))
382 (step (buttons target-low)))
383 program-counters
384 (capture-program-counter
385 post-jump
386 10000)]
387 (println program-counters)
388 (assert (contains? (set program-counters) target-address))
389 post-jump))