view clojure/com/aurellem/gb/rlm_assembly.clj @ 611:d9f991cddad9

spellcheck
author Robert McIntyre <rlm@mit.edu>
date Thu, 22 Nov 2012 11:24:52 -0600
parents 747d47d96d2f
children
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 (:import [com.aurellem.gb.gb_driver SaveState]))
7 (defn pc-item-writer-program
8 []
9 (let [;;limit 75
10 limit 201 ;; (item-hack 201 is the smallest I could make this.)
11 [target-high target-low] (disect-bytes-2 pokemon-list-start)]
12 (flatten
13 [[0x00 ;; (item-hack) no-op (can't buy repel (1E) at celadon)
14 0x1E ;; load limit into E
15 limit
16 0x3F ;; (item-hack) set carry flag no-op
18 ;; load 2 into C.
19 0x0E ;; C == 1 means input-first nybble
20 0x04 ;; C == 0 means input-second nybble
22 0x21 ;; load target into HL
23 target-low
24 target-high
25 0x37 ;; (item-hack) set carry flag no-op
27 0x00 ;; (item-hack) no-op
28 0x37 ;; (item-hack) set carry flag no-op
30 0x00 ;; (item-hack) no-op
31 0xF3 ;; disable interrupts
32 ;; Input Section
34 0x3E ;; load 0x20 into A, to measure buttons
35 0x10
37 0x00 ;; (item-hack) no-op
38 0xE0 ;; load A into [FF00]
39 0x00
41 0xF0 ;; load 0xFF00 into A to get
42 0x00 ;; button presses
44 0xE6
45 0x0F ;; select bottom four bits of A
46 0x37 ;; (item-hack) set carry flag no-op
48 0x00 ;; (item-hack) no-op
49 0xB8 ;; see if input is different (CP A B)
51 0x00 ;; (item-hack) (INC SP)
52 0x28 ;; repeat above steps if input is not different
53 ;; (jump relative backwards if B != A)
54 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
56 0x47 ;; load A into B
58 0x0D ;; dec C
59 0x37 ;; (item-hack) set-carry flag
60 ;; branch based on C:
61 0x20 ;; JR NZ
62 23 ;; skip "input second nybble" and "jump to target" below
64 ;; input second nybble
66 0x0C ;; inc C
67 0x0C ;; inc C
69 0x00 ;; (item-hack) no-op
70 0xE6 ;; select bottom bits
71 0x0F
72 0x37 ;; (item-hack) set-carry flag no-op
74 0x00 ;; (item-hack) no-op
75 0xB2 ;; (OR A D) -> A
77 0x22 ;; (do (A -> (HL)) (INC HL))
79 0x1D ;; (DEC E)
81 0x00 ;; (item-hack)
82 0x20 ;; jump back to input section if not done
83 0xDA ;; literal -36 == TM 18 (counter)
84 0x01 ;; (item-hack) set BC to literal (no-op)
86 ;; jump to target
87 0x00 ;; (item-hack) these two bytes can be anything.
88 0x01
90 0x00 ;; (item-hack) no-op
91 0xBF ;; (CP A A) ensures Z
93 0xCA ;; (item-hack) jump if Z
94 target-low
95 target-high
96 0x01 ;; (item-hack) will never be reached.
98 ;; input first nybble
99 0x00
100 0xCB
101 0x37 ;; swap nybbles on A
103 0x57 ;; A -> D
105 0x37 ;; (item-hack) set carry flag no-op
106 0x18 ;; relative jump backwards
107 0xCD ;; literal -51 == TM05; go back to input section
108 0x01 ;; (item-hack) will never reach this instruction
110 ]
111 (repeat 8 [0x00 0x01]);; these can be anything
113 [;; jump to actual program
114 0x00
115 0x37 ;; (item-hack) set carry flag no-op
117 0x2E ;; 0x3A -> L
118 0x3A
121 0x00 ;; (item-hack) no-op
122 0x26 ;; 0xD5 -> L
123 0xD5
124 0x01 ;; (item-hack) set-carry BC
126 0x00 ;; (item-hack) these can be anything
127 0x01
129 0x00
130 0xE9 ;; jump to (HL)
131 ]])))
135 ;; Specs for Main Bootstrap Program
137 ;; Number-Input
138 ;; Number input works using all eight buttons to
139 ;; spell out an 8 bit number. The order of buttons is
140 ;; [:d :u :l :r :start :select :b :a] --> 11111111
141 ;; [ :l :start :a] --> 00101001
143 ;;; MODES
144 ;; There are five modes in total:
145 ;; MODE-SELECT
146 ;; SET-H
147 ;; SET-L
148 ;; WRITE
149 ;; JUMP
151 ;;; MODE-SELECT
152 ;; The bootstrap program starts in MODE-SELECT mode.
153 ;; MODE-SELECT transitions to one of three modes depending
154 ;; on which buttons are pressed:
155 ;; 0 : MODE-SELECT
156 ;; 0x67 : SET-H
157 ;; 0x6F : SET-L
158 ;; 0x47 : WRITE
159 ;; 0xE9 : JUMP
161 ;;; SET-H
162 ;; SET-H sets the high 8 bits of the target address to which
163 ;; data will be written / the program will jump. It expects
164 ;; the following:
165 ;;
166 ;; Byte 0 : New Value of H
167 ;; Byte 1 : 0x00
169 ;;; SET-L
170 ;; This mode sets the low 8 bits of the target address and has
171 ;; the same semantics as SET-H.
173 ;;; WRITE-BYTES
174 ;; WRITE-BYTES mode writes sequences of arbitray values to
175 ;; arbitray memory locations. It expects you to enter a
176 ;; header of one byte describing how many bytes to write.
178 ;; Byte 0 : Number of Bytes to Write
180 ;; Then, you enter the number of bytes specified in Byte 0
181 ;; and they are written to the start address in sequence.
182 ;; After the last byte is written control returns to
183 ;; MODE-SELECT mode. The Target address will be incremented by
184 ;; Number of Bytes to Write once you are done writing.
186 ;; Example: to write the sequence [1 2 3 4] starting at
187 ;; the target address enter:
188 ;; Byte 0 : 4 (will write four bytes)
189 ;; Byte 3 : 1 (write 1 to 0xC01F)
190 ;; Byte 4 : 2 (write 2 to 0xC020)
191 ;; Byte 5 : 3 (write 3 to 0xC021)
192 ;; Byte 6 : 4 (write 4 to 0xC022)
194 ;;; JUMP
195 ;; JUMP mode jumps program control to the target address.
197 ;;; EXAMPLE
198 ;; To write the infinite loop program [0x18 0xFE] to address
199 ;; 0xC00F and then jump to said program, enter the following
200 ;; starting from MODE-SELECT mode.
202 ;; Byte 0 : 0x67 [:a :b :l :u :select] ;; SET-H mode
203 ;; Byte 1 : 0xC0 [:d :u] ;; 0xC0 -> H
204 ;; Byte 2 : 0x00 [] ;; trailer
206 ;; Byte 3 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
207 ;; Byte 4 : 0x0F [:a :start :b :select] ;; 0x0F -> L
208 ;; Byte 5 : 0x00 [] ;; trailer
210 ;; Byte 6 : 0x47 [:a :b :u :select] ;; WRITE-MODE
211 ;; Byte 7 : 0x02 [:b] ;; write 2 bytes
212 ;; Byte 8 : 0x18 [:r :start] ;; assembly
213 ;; Byte 9 : 0xFE [:r :start :b :d :l :u :select] ;; assembly
215 ;; target address is now 0xC011 since we wrote 2 bytes.
216 ;; set it back to 0xC00F.
218 ;; Byte 10 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
219 ;; Byte 12 : 0x0F [:a :start :b :select] ;; 0x0F -> L
220 ;; Byte 13 : 0x00 [] ;; trailer
222 ;; Byte 14 : 0xE9 ;; JUMP-MODE
224 (defn ->signed-8-bit [n]
225 (if (< n 0)
226 (+ 256 n) n))
228 (defn frame-metronome []
229 (let [init [0xC5] ;; save value of BC
230 timing-loop
231 [0x01 ; \
232 0x43 ; |
233 0xFE ; | load 0xFF44 into BC without repeats
234 0x0C ; |
235 0x04 ; /
236 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
237 continue-if-144
238 [0xFE
239 144 ;; compare LY (in A) with 144
240 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
241 (->signed-8-bit
242 (+ -4 (- (count timing-loop))))]
243 spin-loop
244 [0x05 ;; dec B, which is 0xFF
245 0x20 ;; spin until B==0
246 0xFD]]
247 (concat init timing-loop continue-if-144 spin-loop)))
249 (defn frame-metronome* []
250 [0x3E ;; smallest version, but uses repeated nybbles
251 0x01
252 0xE0
253 0xFF])
255 (defn frame-metronome** []
256 [0x06 ;; load 0xFE into B
257 0xFE
258 0x04 ;; inc B, now B == FF
260 0x3E ;; RLM-debug
261 0x01 ;; 1->A
263 0x48 ;; B->C
264 0x02]) ;; A->(BC) set exclusive v-blank interrupt
266 (defn test-frame-metronome
267 "Ensure that frame-metronome ticks exactly once every frame."
268 ([] (test-frame-metronome 151))
269 ([steps]
270 (let [inc-E [0x1C 0x18
271 (->signed-8-bit
272 (+ -3
273 (-(count (frame-metronome)))))]
275 program (concat (frame-metronome) inc-E)
276 count-frames
277 (-> (tick (mid-game))
278 (IE! 0)
279 (DE! 0)
280 (set-memory-range pokemon-list-start program)
281 (PC! pokemon-list-start))
282 E-after-moves
283 (E (run-moves count-frames (repeat steps [])))]
284 ;;(println "E:" E-after-moves)
285 (assert (= steps E-after-moves))
286 (println "frame-count test passed.")
287 count-frames)))
289 (defn read-user-input []
290 [0x3E
291 0x20 ; prepare to measure d-pad
293 0x3F ; clear carry flag no-op to prevent repeated nybbles
295 0x01 ;\
296 0x01 ; |
297 0xFE ; | load 0xFF00 into BC without repeats
298 0x04 ; |
299 0x0D ;/
301 0x02
302 0x0A ;; get D-pad info
304 0xF5 ;; push AF
306 0x3E
307 0x10 ; prepare to measure buttons
309 0x3F ;; clear carry flag no-op to prevent repeated nybbbles
311 0x02
312 0x0A ;; get button info
314 0xE6 ;; select bottom bits of A
315 0x0F
317 0x47 ;; A->B
319 0xF1 ;; pop AF
321 0xE6
322 0x0F ;; select bottom bits of A
324 0xCB
325 0x37 ;; swap A nybbles
327 0xB0 ;; (or A B) -> A
329 0x2F ;; (NOT A) -> A
330 ])
332 (defn test-read-user-input []
333 (let [program
334 (concat
335 (frame-metronome) (read-user-input)
336 [0x5F ;; A-> E
337 0x76
338 0x18
339 (->signed-8-bit
340 (+ (- (count (read-user-input)))
341 (- 4)))])
342 read-input
343 (-> (tick (mid-game))
344 (IE! 0)
345 (set-memory-range pokemon-list-start program)
346 (PC! pokemon-list-start))]
347 (dorun
348 (for [i (range 0x100)]
349 (assert (= (E (step read-input (buttons i))) i))))
350 (println "tested all inputs.")
351 read-input))
353 (def symbol-index
354 (fn [symbol sequence]
355 (count (take-while
356 (partial not= symbol)
357 sequence))))
359 (defn bootstrap-state-machine
360 ([start-address]
361 ;; Register Use:
363 ;; ED non-volitale scratch
365 ;; A user-input (A MUST contain user-input for this to work!)
366 ;; HL target-address
367 ;; B bytes-to-write
368 ;; C non-volatile scratch
370 ;; Modes (with codes) are:
372 ;; single-action-modes:
373 ;; SET-TARGET-HIGH 0x67 ;; A->H
374 ;; SET-TARGET-LOW 0x6F ;; A->L
375 ;; JUMP 0xE9 ;; jump to (HL)
377 ;; multi-action-modes
378 ;; WRITE 0x47 ;; A->B
379 (let [
380 input
381 [0xC1 ;; pop BC so it's not volatile
383 0x5F ;; A->E
384 0xAF ;; test for output-mode (bytes-to-write > 0)
385 0xB8 ;; (cp A B)
386 0x7B ;; E->A
387 0x20 ;; skip to output section if
388 :to-output ;; we're not in input mode
390 :to-be-executed
392 ;; write mode to instruction-to-be-executed (pun)
393 0xEA
394 :to-be-executed-address
396 ;; protection region -- do not queue this op for
397 ;; execution if the last one was non-zero
398 0x79 ;; C->A
399 0xA7 ;; test A==0
400 0x28
401 0x04
402 0xAF ;; put a no op (0x00) in to-be-executed
403 0xEA ;;
404 :to-be-executed-address
406 0x7B ;; E->A
407 0x4F ;; A->C now C stores previous instruction
408 0x18 ;; return
409 :to-jump]
411 output
412 [:output-start ;; just a label
413 0x3F ;; ;; prevent repeated nybbles
414 0x54 ;;
415 0x5D ;; HL->DE \
416 ;; | This mess is here to do
417 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
418 ;; / any repeating nybbles
419 0x05 ;; DEC bytes-to-write (B)
421 0x23 ;; inc HL
422 ]
424 symbols
425 {:to-be-executed-address
426 (reverse
427 (disect-bytes-2
428 (+ start-address
429 (symbol-index :to-be-executed input))))
430 :to-be-executed 0x3F} ;; clear carry flag no-op
432 program** (flatten
433 (replace
434 symbols
435 (concat input output)))
437 resolve-internal-jumps
438 {:output-start []
439 :to-output
440 (->signed-8-bit
441 (dec
442 (- (symbol-index :output-start program**)
443 (symbol-index :to-output program**))))}
445 program*
446 (flatten (replace resolve-internal-jumps program**))
448 resolve-external-jumps
449 {:to-jump
450 (- (- (count program*)
451 (symbol-index :to-jump program*)) 1)}
452 program
453 (replace resolve-external-jumps program*)]
454 program)))
457 (defn main-bootstrap-program
458 ([] (main-bootstrap-program pokemon-list-start))
459 ([start-address]
460 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
461 header (concat (frame-metronome) (read-user-input))
462 state-machine-start-address
463 (+ start-address (count init) (count header))
464 state-machine
465 (bootstrap-state-machine state-machine-start-address)
467 return-to-header
468 (flatten
469 [0x18
470 (->signed-8-bit
471 (- (count init)
472 2 ;; this command length
473 3 ;; I have no idea why we need a 3 here
474 ;; need to investigate.
475 (count header)
476 (count state-machine)))])]
478 (concat init header state-machine return-to-header))))
482 (defn no-consecutive-repeats? [seq]
483 (not (contains? (set(map - seq (rest seq))) 0)))
485 (defn byte->nybbles [byte]
486 [(bit-shift-right byte 4) (bit-and byte 0x0F)])
488 (defn bootstrap-pattern
489 "Given an assembly sequence, generate the keypresses required to
490 create that sequence in memory using the pc-item-writer
491 program. The assembly must not have any consecutive repeating
492 nybbles."
493 [assembly]
494 (let [nybbles (flatten (map byte->nybbles assembly))
495 moves (map (comp buttons (partial - 15)) nybbles)
496 header (map buttons
497 (concat (repeat
498 23 ;; found by manual binary search
499 (- 15 (first nybbles)))
500 [(first nybbles)]))]
501 (assert (no-consecutive-repeats? nybbles))
502 (concat header moves)))
504 ;;;;;; TESTS ;;;;;;
506 (def set-H-mode 0x67)
507 (def set-L-mode 0x6F)
508 (def jump-mode 0xE9)
509 (def write-mode 0x47)
512 (defn bootstrap-base []
513 (let [program (main-bootstrap-program pokemon-list-start)]
514 ;; make sure program is valid output for item-writer
515 (-> (tick (mid-game))
516 (set-memory-range pokemon-list-start program)
517 (PC! pokemon-list-start)
518 (step [])
519 (step []))))
521 (defn test-set-H []
522 (letfn [(test-H [state n]
523 (let [after
524 (-> state
525 (step (buttons set-H-mode))
526 (step (buttons n))
527 (step []))]
528 ;;(println "desired H =" n "actual =" (H after))
529 (assert (= n (H after)))
530 after))]
531 (let [result (reduce test-H (bootstrap-base) (range 0x100))]
532 (println "set H test passed.")
533 result)))
535 (defn test-write-bytes []
536 (let [target-address 0xC00F
537 [target-high target-low] (disect-bytes-2 target-address)
538 assembly [0xF3 0x18 0xFE 0x12]
539 get-mem-region #(subvec (vec (memory %))
540 target-address (+ target-address 20))
541 before (bootstrap-base)
542 after
543 (-> before
544 (step []) ; make sure it can handle blanks
545 (step []) ; at the beginning.
546 (step [])
547 (step (buttons set-H-mode)) ; select set-H
548 (step (buttons target-high))
549 (step [])
550 (step (buttons set-L-mode))
551 (step (buttons target-low))
552 (step [])
553 (step (buttons write-mode))
554 (step (buttons 4)) ; write 4 bytes
555 (step (buttons (nth assembly 0)))
556 (step (buttons (nth assembly 1)))
557 (step (buttons (nth assembly 2)))
558 (step (buttons (nth assembly 3))))]
559 ;;(println "before :" (get-mem-region before))
560 ;;(println "after :" (get-mem-region after))
561 ;;(assert (= assembly (take 4 (get-mem-region after))))
562 (println "write-test-passed.")
563 after))
565 (defn test-jump []
566 (let [target-address 0xC00F
567 [target-high target-low] (disect-bytes-2 target-address)
568 post-jump
569 (-> (test-write-bytes)
570 (step (buttons set-H-mode)) ; select set-H
571 (step (buttons target-high))
572 (step [])
573 (step (buttons set-L-mode))
574 (step (buttons target-low))
575 (step [])
576 (step (buttons jump-mode))) ; Select JUMP mode.
577 program-counters
578 (capture-program-counter
579 post-jump
580 10000)]
581 (assert (contains? (set program-counters) target-address))
582 (println "jump test passed.")
583 post-jump))
585 (defn test-no-repeated-nybbles []
586 (bootstrap-pattern (main-bootstrap-program))
587 (println "no-repeated-nybbles"))
589 (defn run-all-tests []
590 (test-frame-metronome)
591 (test-read-user-input)
592 (test-set-H)
593 (test-write-bytes)
594 (test-jump)
595 (test-no-repeated-nybbles)
596 (println "\n all tests passed."))