Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/rlm_assembly.clj @ 395:6ab872c5a7e7

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