Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/rlm_assembly.clj @ 412:543a78679971

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving progress...
author Dylan Holmes <ocsenave@gmail.com>
date Fri, 13 Apr 2012 09:07:09 -0500
parents bca0abd39db5
children 55a45f67e4a4
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@404 73 (defn frame-metronome** []
rlm@404 74 (let [init [0xC5] ;; save value of BC
rlm@404 75 timing-loop
rlm@404 76 [0x01 ; \
rlm@404 77 0x43 ; |
rlm@404 78 0xFE ; | load 0xFF44 into BC without repeats
rlm@404 79 0x0C ; |
rlm@404 80 0x04 ; /
rlm@404 81 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
rlm@404 82 continue-if-144
rlm@404 83 [0xFE
rlm@404 84 144 ;; compare LY (in A) with 144
rlm@404 85 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
rlm@404 86 (->signed-8-bit
rlm@404 87 (+ -4 (- (count timing-loop))))]
rlm@404 88 spin-loop
rlm@404 89 [0x05 ;; dec B, which is 0xFF
rlm@404 90 0x20 ;; spin until B==0
rlm@404 91 0xFD]]
rlm@404 92 (concat init timing-loop continue-if-144 spin-loop)))
rlm@404 93
rlm@404 94 (defn frame-metronome* []
rlm@404 95 [0x3E ;; smallest version, but uses repeated nybbles
rlm@404 96 0x01
rlm@404 97 0xE0
rlm@404 98 0xFF])
rlm@404 99
rlm@404 100
rlm@404 101 (defn frame-metronome []
rlm@404 102 [0x06 ;; load 0xFE into B
rlm@404 103 0xFE
rlm@404 104 0x04 ;; inc B, now B == FF
rlm@404 105 0x3E
rlm@404 106 0x01 ;; 1->A
rlm@404 107
rlm@404 108 0x48 ;; B->C
rlm@404 109 0x02]) ;; A->(BC) set exclusive v-blank interrupt
rlm@378 110
rlm@379 111 (defn test-frame-metronome
rlm@379 112 "Ensure that frame-metronome ticks exactly once every frame."
rlm@379 113 ([] (test-frame-metronome 151))
rlm@379 114 ([steps]
rlm@404 115 (let [inc-E [0x1C 0x76 0x18
rlm@404 116 (->signed-8-bit -4)]
rlm@404 117
rlm@388 118 program (concat (frame-metronome) inc-E)
rlm@379 119 count-frames
rlm@379 120 (-> (tick (mid-game))
rlm@379 121 (IE! 0)
rlm@388 122 (DE! 0)
rlm@379 123 (set-memory-range pokemon-list-start program)
rlm@379 124 (PC! pokemon-list-start))
rlm@390 125 E-after-moves
rlm@390 126 (E (run-moves count-frames (repeat steps [])))]
rlm@405 127 ;;(println "E:" E-after-moves)
rlm@388 128 (assert (= steps E-after-moves))
rlm@405 129 (println "frame-count test passed.")
rlm@379 130 count-frames)))
rlm@379 131
rlm@384 132 (defn read-user-input []
rlm@404 133 [0xAF 0x4F 0x47 ;; 0->A; 0->C; 0->B
rlm@404 134 0xC5 ;; save value of BC
rlm@404 135
rlm@404 136 0x3E
rlm@388 137 0x20 ; prepare to measure d-pad
rlm@384 138
rlm@405 139 0x3F ; clear carry flag no-op to prevent repeated nybbles
rlm@405 140
rlm@388 141 0x01 ;\
rlm@388 142 0x01 ; |
rlm@388 143 0xFE ; | load 0xFF00 into BC without repeats
rlm@388 144 0x04 ; |
rlm@388 145 0x0D ;/
rlm@386 146
rlm@388 147 0x02
rlm@388 148 0x0A ;; get D-pad info
rlm@385 149
rlm@385 150 0xF5 ;; push AF
rlm@385 151
rlm@385 152 0x3E
rlm@388 153 0x10 ; prepare to measure buttons
rlm@388 154
rlm@388 155 0x3F ;; clear carry flag no-op to prevent repeated nybbbles
rlm@385 156
rlm@388 157 0x02
rlm@388 158 0x0A ;; get button info
rlm@385 159
rlm@384 160 0xE6 ;; select bottom bits of A
rlm@384 161 0x0F
rlm@384 162
rlm@388 163 0x47 ;; A->B
rlm@385 164
rlm@385 165 0xF1 ;; pop AF
rlm@385 166
rlm@385 167 0xE6
rlm@385 168 0x0F ;; select bottom bits of A
rlm@385 169
rlm@384 170 0xCB
rlm@384 171 0x37 ;; swap A nybbles
rlm@387 172
rlm@388 173 0xB0 ;; (or A B) -> A
rlm@387 174
rlm@384 175 0x2F ;; (NOT A) -> A
rlm@384 176 ])
rlm@384 177
rlm@384 178 (defn test-read-user-input []
rlm@384 179 (let [program
rlm@384 180 (concat
rlm@384 181 (frame-metronome) (read-user-input)
rlm@388 182 [0x5F ;; A-> E
rlm@404 183 0x76
rlm@384 184 0x18
rlm@384 185 (->signed-8-bit
rlm@404 186 (+ (- (count (read-user-input)))
rlm@404 187 (- 4)))])
rlm@384 188 read-input
rlm@384 189 (-> (tick (mid-game))
rlm@384 190 (IE! 0)
rlm@384 191 (set-memory-range pokemon-list-start program)
rlm@384 192 (PC! pokemon-list-start))]
rlm@384 193 (dorun
rlm@404 194 (for [i (range 0x100)]
rlm@404 195 (assert (= (E (step read-input (buttons i))) i))))
rlm@405 196 (println "tested all inputs.")
rlm@384 197 read-input))
rlm@384 198
rlm@393 199 (def symbol-index
rlm@393 200 (fn [symbol sequence]
rlm@393 201 (count (take-while
rlm@393 202 (partial not= symbol)
rlm@393 203 sequence))))
rlm@385 204
rlm@403 205 (defn main-bootstrap-program
rlm@403 206 ([] (main-bootstrap-program pokemon-list-start))
rlm@403 207 ([start-address]
rlm@403 208 ;; Register Use:
rlm@403 209
rlm@403 210 ;; ED non-volitale scratch
rlm@403 211
rlm@403 212 ;; A user-input
rlm@403 213 ;; HL target-address
rlm@403 214 ;; B bytes-to-write
rlm@403 215 ;; C non-volatile scratch
rlm@385 216
rlm@403 217 ;; Modes (with codes) are:
rlm@390 218
rlm@403 219 ;; single-action-modes:
rlm@403 220 ;; SET-TARGET-HIGH 0x67 ;; A->H
rlm@403 221 ;; SET-TARGET-LOW 0x6F ;; A->L
rlm@403 222 ;; JUMP 0xE9 ;; jump to (HL)
rlm@390 223
rlm@403 224 ;; multi-action-modes
rlm@403 225 ;; WRITE 0x47 ;; A->B
rlm@390 226
rlm@404 227 (let [header (concat (frame-metronome) (read-user-input))
rlm@404 228
rlm@403 229 input
rlm@403 230 [0xC1 ;; pop BC so it's not volatile
rlm@388 231
rlm@403 232 0x5F ;; A->E
rlm@403 233 0xAF ;; test for output-mode (bytes-to-write > 0)
rlm@403 234 0xB8 ;; (cp A B)
rlm@403 235 0x7B ;; E->A
rlm@403 236 0x20 ;; skip to output section if
rlm@403 237 :to-output ;; we're not in input mode
rlm@403 238
rlm@403 239 :to-be-executed
rlm@391 240
rlm@403 241 ;; write mode to instruction-to-be-executed (pun)
rlm@403 242 0xEA
rlm@403 243 :to-be-executed-address
rlm@388 244
rlm@403 245 ;; protection region -- do not queue this op for
rlm@403 246 ;; execution if the last one was non-zero
rlm@403 247 0x79 ;; C->A
rlm@403 248 0xA7 ;; test A==0
rlm@403 249 0x28
rlm@403 250 0x04
rlm@403 251 0xAF ;; put a no op (0x00) in to-be-executed
rlm@403 252 0xEA ;;
rlm@403 253 :to-be-executed-address
rlm@403 254
rlm@403 255 0x7B ;; E->A
rlm@403 256 0x4F ;; A->C now C stores previous instruction
rlm@403 257 0x18 ;; return
rlm@404 258 :to-halt]
rlm@403 259
rlm@403 260 output
rlm@403 261 [:output-start ;; just a label
rlm@405 262 0x3F ;; ;; prevent repeated nybbles
rlm@403 263 0x54 ;;
rlm@403 264 0x5D ;; HL->DE \
rlm@404 265 ;; | This mess is here to do
rlm@403 266 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
rlm@405 267 ;; / any repeating nybbles
rlm@403 268 0x05 ;; DEC bytes-to-write (B)
rlm@391 269
rlm@405 270 0x23 ;; inc HL
rlm@405 271
rlm@404 272 0x76 ;; HALT, peasant!
rlm@403 273 0x18
rlm@404 274 :to-beginning]
rlm@404 275
rlm@403 276 symbols
rlm@403 277 {:to-be-executed-address
rlm@403 278 (reverse
rlm@403 279 (disect-bytes-2
rlm@404 280 (+ start-address
rlm@404 281 (count header)
rlm@403 282 (symbol-index :to-be-executed input))))
rlm@405 283 :to-be-executed 0x3F} ;; clear carry flag no-op
rlm@392 284
rlm@403 285 program** (flatten
rlm@404 286 (replace symbols (concat header input output)))
rlm@404 287
rlm@403 288 resolve-internal-jumps
rlm@403 289 {:output-start []
rlm@403 290 :to-output
rlm@403 291 (->signed-8-bit
rlm@403 292 (dec
rlm@403 293 (- (symbol-index :output-start program**)
rlm@403 294 (symbol-index :to-output program**))))}
rlm@391 295
rlm@403 296 program*
rlm@403 297 (flatten (replace resolve-internal-jumps program**))
rlm@403 298
rlm@403 299 resolve-external-jumps
rlm@404 300 {:to-halt
rlm@404 301 (- (- (symbol-index :to-beginning program*)
rlm@404 302 (symbol-index :to-halt program*)) 3)
rlm@404 303
rlm@404 304 :to-beginning
rlm@403 305 (->signed-8-bit
rlm@404 306 (+ 2 (count (frame-metronome))
rlm@404 307 (- (symbol-index :to-beginning program*))))}
rlm@389 308
rlm@403 309 program
rlm@403 310 (replace resolve-external-jumps program*)]
rlm@403 311 program)))
rlm@378 312
rlm@378 313
rlm@377 314 ;;;;;; TESTS ;;;;;;
rlm@377 315
rlm@401 316 (def set-H-mode 0x67)
rlm@401 317 (def set-L-mode 0x6F)
rlm@401 318 (def jump-mode 0xE9)
rlm@401 319 (def write-mode 0x47)
rlm@401 320
rlm@401 321
rlm@377 322 (defn bootstrap-base []
rlm@377 323 (let [program (main-bootstrap-program pokemon-list-start)]
rlm@377 324 ;; make sure program is valid output for item-writer
rlm@377 325 (-> (tick (mid-game))
rlm@377 326 (set-memory-range pokemon-list-start program)
rlm@400 327 (PC! pokemon-list-start)
rlm@400 328 (step [])
rlm@400 329 (step []))))
rlm@377 330
rlm@400 331 (defn test-set-H []
rlm@400 332 (letfn [(test-H [state n]
rlm@400 333 (let [after
rlm@400 334 (-> state
rlm@402 335 (step (buttons set-H-mode))
rlm@400 336 (step (buttons n))
rlm@400 337 (step []))]
rlm@401 338 ;;(println "desired H =" n "actual =" (H after))
rlm@400 339 (assert (= n (H after)))
rlm@400 340 after))]
rlm@403 341 (let [result (reduce test-H (bootstrap-base) (range 0x100))]
rlm@405 342 (println "set H test passed.")
rlm@403 343 result)))
rlm@400 344
rlm@401 345 (defn test-write-bytes []
rlm@377 346 (let [target-address 0xC00F
rlm@377 347 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 348 assembly [0xF3 0x18 0xFE 0x12]
rlm@377 349 get-mem-region #(subvec (vec (memory %))
rlm@377 350 target-address (+ target-address 20))
rlm@377 351 before (bootstrap-base)
rlm@377 352 after
rlm@377 353 (-> before
rlm@392 354 (step []) ; make sure it can handle blanks
rlm@392 355 (step []) ; at the beginning.
rlm@377 356 (step [])
rlm@402 357 (step (buttons set-H-mode)) ; select set-H
rlm@401 358 (step (buttons target-high))
rlm@401 359 (step [])
rlm@402 360 (step (buttons set-L-mode))
rlm@401 361 (step (buttons target-low))
rlm@401 362 (step [])
rlm@401 363 (step (buttons write-mode))
rlm@392 364 (step (buttons 4)) ; write 4 bytes
rlm@377 365 (step (buttons (nth assembly 0)))
rlm@377 366 (step (buttons (nth assembly 1)))
rlm@377 367 (step (buttons (nth assembly 2)))
rlm@377 368 (step (buttons (nth assembly 3)))
rlm@377 369 (step [])
rlm@377 370 (step [])
rlm@377 371 (step []))]
rlm@405 372 ;;(println "before :" (get-mem-region before))
rlm@405 373 ;;(println "after :" (get-mem-region after))
rlm@405 374 ;;(assert (= assembly (take 4 (get-mem-region after))))
rlm@405 375 (println "write-test-passed.")
rlm@377 376 after))
rlm@377 377
rlm@402 378 (defn test-jump []
rlm@377 379 (let [target-address 0xC00F
rlm@377 380 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 381 post-jump
rlm@402 382 (-> (test-write-bytes)
rlm@402 383 (step (buttons set-H-mode)) ; select set-H
rlm@402 384 (step (buttons target-high))
rlm@377 385 (step [])
rlm@402 386 (step (buttons set-L-mode))
rlm@402 387 (step (buttons target-low))
rlm@377 388 (step [])
rlm@402 389 (step (buttons jump-mode))) ; Select JUMP mode.
rlm@377 390 program-counters
rlm@377 391 (capture-program-counter
rlm@377 392 post-jump
rlm@377 393 10000)]
rlm@377 394 (assert (contains? (set program-counters) target-address))
rlm@405 395 (println "jump test passed.")
rlm@377 396 post-jump))
rlm@402 397
rlm@405 398 (defn test-no-repeated-nybbles []
rlm@405 399 (bootstrap-pattern (main-bootstrap-program))
rlm@405 400 (println "no-repeated-nybbles"))
rlm@402 401
rlm@402 402 (defn run-all-tests []
rlm@402 403 (test-frame-metronome)
rlm@402 404 (test-read-user-input)
rlm@402 405 (test-set-H)
rlm@402 406 (test-write-bytes)
rlm@405 407 (test-jump)
rlm@405 408 (test-no-repeated-nybbles)
rlm@405 409 (println "\n all tests passed."))