Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/rlm_assembly.clj @ 409:55a45f67e4a4

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