Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/rlm_assembly.clj @ 386:d8cbbf2a3133

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
changed scratch ragisters from BC to DE.
author Robert McIntyre <rlm@mit.edu>
date Thu, 12 Apr 2012 06:27:03 -0500
parents 3f3cfc89be91
children 47d44bb54d32
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@377 8 ;; Specs for Main Bootstrap Program
rlm@377 9
rlm@377 10 ;; Number-Input
rlm@377 11 ;; Number input works using all eight buttons to
rlm@377 12 ;; spell out an 8 bit number. The order of buttons is
rlm@377 13 ;; [:d :u :l :r :start :select :b :a] --> 11111111
rlm@377 14 ;; [ :l :start :a] --> 00101001
rlm@377 15
rlm@377 16 ;;; MODE-SELECT
rlm@377 17 ;; The bootstrap program starts in MODE-SELECT mode.
rlm@377 18 ;; MODE-SELECT transitions to one of three modes depending
rlm@377 19 ;; on which buttons are pressed:
rlm@377 20 ;; 0 (no-buttons) : MODE-SELECT
rlm@377 21 ;; 8 [:start] : WRITE-BYTES
rlm@377 22 ;; 0xFF (all-buttons) : JUMP
rlm@377 23
rlm@377 24 ;;; WRITE-BYTES
rlm@377 25
rlm@377 26 ;; WRITE-BYTES mode writes sequences of arbitray values to
rlm@377 27 ;; arbitray memory locations. It expects you to enter a
rlm@377 28 ;; header of three bytes describing what to write:
rlm@377 29
rlm@377 30 ;; Byte 0 : Number of Bytes to Write
rlm@377 31 ;; Byte 1 : Start Address High Byte
rlm@377 32 ;; Byte 1 : Start Address Low Byte
rlm@377 33
rlm@377 34 ;; Then, you enter the number of bytes specified in Byte 0
rlm@377 35 ;; they are written to the start address in
rlm@377 36 ;; sequence. After the last byte is written control
rlm@377 37 ;; returns to MODE-SELECT mode.
rlm@377 38
rlm@377 39 ;; Example: to write the sequence [1 2 3 4] starting at
rlm@377 40 ;; address 0xC01F enter
rlm@377 41 ;; Byte 0 : 4 (will write four bytes)
rlm@377 42 ;; Byte 1 : 0xC0 (high byte of 0xC01F)
rlm@377 43 ;; Byte 2 : 0x1F (low byte of 0xC01F)
rlm@377 44 ;; Byte 3 : 1 (write 1 to 0xC01F)
rlm@377 45 ;; Byte 4 : 2 (write 2 to 0xC020)
rlm@377 46 ;; Byte 5 : 3 (write 3 to 0xC021)
rlm@377 47 ;; Byte 6 : 4 (write 4 to 0xC022)
rlm@377 48
rlm@377 49 ;;; JUMP
rlm@377 50 ;; JUMP mode jumps program control to any arbitray
rlm@377 51 ;; location. It expects you to enter two bytes which
rlm@377 52 ;; correspond to the high and low bytes of the memory
rlm@377 53 ;; address to which you want to jump.
rlm@377 54 ;; Byte 0 : Jump Address High Byte
rlm@377 55 ;; Byte 1 : Jump Address Low Byte
rlm@377 56
rlm@377 57 ;; Example: to jump to address 0x1234 enter
rlm@377 58 ;; Byte 0 : 0x12 (high byte of 0x1234)
rlm@377 59 ;; Byte 1 : 0x34 (low byte of 0x1234)
rlm@377 60
rlm@377 61
rlm@378 62 (defn ->signed-8-bit [n]
rlm@378 63 (if (< n 0)
rlm@378 64 (+ 256 n) n))
rlm@378 65
rlm@378 66 (defn frame-metronome []
rlm@381 67 (let [timing-loop
rlm@386 68 [;;0x01 ; \
rlm@386 69 ;;0x43 ; |
rlm@386 70 ;;0xFE ; | load 0xFF44 into BC without repeats
rlm@386 71 ;;0x0C ; |
rlm@386 72 ;;0x04 ; /
rlm@386 73 ;;0x0A ;; (BC) -> A, now A = LY (vertical line coord)
rlm@386 74
rlm@386 75 0x11 ; \
rlm@386 76 0x43 ; |
rlm@386 77 0xFE ; | load 0xFF44 into DE without repeats
rlm@386 78 0x1C ; |
rlm@386 79 0x14 ; /
rlm@386 80 0x1A ;; (DE) -> A, now A = LY (vertical line coord)
rlm@386 81 ]
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@386 89 [;;0x05 ;; dec B, which is 0xFF
rlm@386 90 0x15 ;; dec D, which is 0xFF
rlm@382 91 0x20 ;; spin until B==0
rlm@381 92 0xFD]]
rlm@381 93 (concat timing-loop continue-if-144 spin-loop)))
rlm@378 94
rlm@379 95 (defn test-frame-metronome
rlm@379 96 "Ensure that frame-metronome ticks exactly once every frame."
rlm@379 97 ([] (test-frame-metronome 151))
rlm@379 98 ([steps]
rlm@386 99 (let [inc-B [0x04 0x18
rlm@379 100 (->signed-8-bit
rlm@379 101 (+ -3 (- (count (frame-metronome)))))]
rlm@386 102 program (concat (frame-metronome) inc-B)
rlm@379 103 count-frames
rlm@379 104 (-> (tick (mid-game))
rlm@379 105 (IE! 0)
rlm@386 106 (BC! 0)
rlm@379 107 (set-memory-range pokemon-list-start program)
rlm@379 108 (PC! pokemon-list-start))
rlm@386 109 B-after-moves (B (run-moves count-frames (repeat steps [])))]
rlm@386 110 (println "B:" B-after-moves)
rlm@386 111 (assert (= steps B-after-moves))
rlm@379 112
rlm@386 113 (println "B =" B-after-moves "after" steps "steps")
rlm@379 114 count-frames)))
rlm@379 115
rlm@384 116 (defn read-user-input []
rlm@386 117 [;;0x01 ;\
rlm@386 118 ;;0x01 ;|
rlm@386 119 ;;0xFE ;| load 0xFF00 into BC without repeats
rlm@386 120 ;;0x04 ;|
rlm@386 121 ;;0x0D ;/
rlm@384 122
rlm@386 123 0x11 ; \
rlm@386 124 0x01 ; |
rlm@386 125 0xFE ; | load 0xFF44 into DE without repeats
rlm@386 126 0x14 ; |
rlm@386 127 0x1D ; /
rlm@386 128
rlm@384 129 0x3E
rlm@384 130 (Integer/parseInt "00100000" 2) ; prepare to measure d-pad
rlm@384 131
rlm@386 132 0x12
rlm@386 133 0x1A ;; get D-pad info
rlm@385 134
rlm@385 135 0xF5 ;; push AF
rlm@385 136
rlm@385 137 0x3E
rlm@385 138 (Integer/parseInt "00010000" 2) ; prepare to measure buttons
rlm@385 139
rlm@386 140 0x12
rlm@386 141 0x1A ;; get button info
rlm@384 142
rlm@385 143
rlm@384 144 0xE6 ;; select bottom bits of A
rlm@384 145 0x0F
rlm@384 146
rlm@385 147 0x47 ;; A->B
rlm@385 148
rlm@385 149 0xF1 ;; pop AF
rlm@385 150
rlm@385 151 0xE6
rlm@385 152 0x0F ;; select bottom bits of A
rlm@385 153
rlm@384 154 0xCB
rlm@384 155 0x37 ;; swap A nybbles
rlm@384 156
rlm@385 157 0xB0 ;; (AND A B) -> A
rlm@384 158
rlm@384 159 0x2F ;; (NOT A) -> A
rlm@384 160 ])
rlm@384 161
rlm@384 162 (defn test-read-user-input []
rlm@384 163 (let [program
rlm@384 164 (concat
rlm@384 165 (frame-metronome) (read-user-input)
rlm@386 166 [0x47 ;; A->B
rlm@384 167 0x18
rlm@384 168 (->signed-8-bit
rlm@384 169 (+ (- (count (frame-metronome)))
rlm@384 170 (- (count (read-user-input)))
rlm@384 171 (- 3)))])
rlm@384 172 read-input
rlm@384 173 (-> (tick (mid-game))
rlm@384 174 (IE! 0)
rlm@384 175 (set-memory-range pokemon-list-start program)
rlm@384 176 (PC! pokemon-list-start))]
rlm@384 177 (dorun
rlm@385 178 (for [i (range 0x100)]
rlm@386 179 (assert (= (B (step read-input (buttons i))) i))))
rlm@385 180 (println "Tested all inputs.")
rlm@384 181 read-input))
rlm@384 182
rlm@385 183 (def mode-select-mode (Integer/parseInt "00000000" 2))
rlm@385 184 (def write-mode (Integer/parseInt "00000001" 2))
rlm@385 185 (def jump-mode (Integer/parseInt "10000000" 2))
rlm@385 186
rlm@385 187 (def input-high-addr-jump (Integer/parseInt "10000010" 2))
rlm@385 188 (def input-high-addr-write (Integer/parseInt "00000010" 2))
rlm@385 189 (def input-low-addr-jump (Integer/parseInt "10000100" 2))
rlm@385 190 (def input-low-addr-write (Integer/parseInt "00000100" 2))
rlm@385 191
rlm@385 192 (def input-write-num-mode (Integer/parseInt "00001000" 2))
rlm@385 193 (def do-write-mode (Integer/parseInt "00010000" 2))
rlm@385 194
rlm@385 195
rlm@385 196
rlm@385 197
rlm@385 198
rlm@385 199
rlm@384 200
rlm@377 201 (defn main-bootstrap-program [start-address]
rlm@378 202 (let [[start-high start-low] (disect-bytes-2 start-address)
rlm@385 203 jump-distance (+ (count (frame-metronome)
rlm@385 204 (read-user-input)))
rlm@385 205
rlm@385 206 init
rlm@385 207 [0x1E 0xFF 0x1C] ;; 0-> E without repeats
rlm@385 208
rlm@385 209
rlm@385 210 ;; HL -> BC
rlm@385 211 ;; HL = here
rlm@385 212 ;; add E to HL
rlm@385 213 ;; jp HL
rlm@385 214
rlm@385 215 mode-dispatch
rlm@385 216 [0x44
rlm@385 217
rlm@385 218
rlm@385 219
rlm@385 220 ;;(here) jr metronome
rlm@385 221
rlm@385 222 ;;stuff
rlm@385 223 ;;modify E
rlm@385 224 ;;jr metronome
rlm@385 225
rlm@385 226 ;;stuff
rlm@385 227 ;;jr metronome
rlm@385 228
rlm@385 229
rlm@385 230
rlm@385 231
rlm@385 232
rlm@385 233
rlm@385 234
rlm@385 235 mode-dispatch
rlm@385 236 [0xCB
rlm@385 237 0x43 ;; test bit 0
rlm@385 238
rlm@385 239 0xCB
rlm@385 240 0x4B ;; test bit 1
rlm@385 241
rlm@385 242 0xCB
rlm@385 243 0x53 ;; test bit 2
rlm@385 244
rlm@385 245 0xCB
rlm@385 246 0x5B ;; test bit 3
rlm@385 247
rlm@385 248 0xCB
rlm@385 249 0x63 ;; test bit 4
rlm@385 250
rlm@385 251 0xCB
rlm@385 252 0x6B ;; test bit 5
rlm@385 253
rlm@385 254 ];;default
rlm@385 255
rlm@385 256
rlm@385 257 mode-select
rlm@385 258 [0x5F] ;; A->E
rlm@385 259
rlm@385 260 ;; delayed inputs
rlm@385 261 input-high 0x67 ;; A->H
rlm@385 262 input-low 0x6F ;; A->L
rlm@385 263 input-num 0x57 ;; A->D
rlm@385 264
rlm@385 265 ;; final-actions
rlm@385 266 jump 0xE9 ;; jp (HL)
rlm@385 267 write 0x22 ;; A->(HL); inc HL
rlm@385 268 input-mode 0x00 ;; no-op
rlm@385 269
rlm@385 270
rlm@385 271
rlm@385 272 input-high
rlm@385 273 [0x67 ;; A->H
rlm@385 274 0x1E ;; change mode
rlm@385 275 input-low-mode]
rlm@385 276
rlm@385 277
rlm@385 278
rlm@385 279
rlm@385 280 mode-dispatch
rlm@385 281
rlm@385 282
rlm@385 283
rlm@385 284
rlm@385 285
rlm@385 286
rlm@385 287
rlm@378 288 ))
rlm@378 289
rlm@378 290
rlm@378 291
rlm@378 292
rlm@378 293
rlm@378 294
rlm@378 295
rlm@378 296
rlm@378 297
rlm@377 298
rlm@377 299 ;;;;;; TESTS ;;;;;;
rlm@377 300
rlm@377 301 (defn bootstrap-base []
rlm@377 302 (let [program (main-bootstrap-program pokemon-list-start)]
rlm@377 303 ;; make sure program is valid output for item-writer
rlm@377 304 (bootstrap-pattern program)
rlm@377 305 (-> (tick (mid-game))
rlm@377 306 (set-memory-range pokemon-list-start program)
rlm@377 307 (PC! pokemon-list-start))))
rlm@377 308
rlm@377 309 (defn test-write-bytes-mode []
rlm@377 310 (let [target-address 0xC00F
rlm@377 311 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 312 assembly [0xF3 0x18 0xFE 0x12]
rlm@377 313 get-mem-region #(subvec (vec (memory %))
rlm@377 314 target-address (+ target-address 20))
rlm@377 315 before (bootstrap-base)
rlm@377 316 after
rlm@377 317 (-> before
rlm@377 318 (step []) ; make sure it can handle blanks
rlm@377 319 (step []) ; at the beginning.
rlm@377 320 (step [])
rlm@377 321 (step [:start]) ; select WRITE-BYTES mode
rlm@377 322 (step (buttons 4)) ; write 4 bytes
rlm@377 323 (step (buttons target-high))
rlm@377 324 (step (buttons target-low))
rlm@377 325 (step (buttons (nth assembly 0)))
rlm@377 326 (step (buttons (nth assembly 1)))
rlm@377 327 (step (buttons (nth assembly 2)))
rlm@377 328 (step (buttons (nth assembly 3)))
rlm@377 329 (step [])
rlm@377 330 (step [])
rlm@377 331 (step []))]
rlm@377 332 (println "before :" (get-mem-region before))
rlm@377 333 (println "after :" (get-mem-region after))
rlm@377 334 (assert (= assembly (take 4 (get-mem-region after))))
rlm@377 335 after))
rlm@377 336
rlm@377 337 (defn test-jump-mode []
rlm@377 338 (let [target-address 0xC00F
rlm@377 339 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 340 post-jump
rlm@377 341 (-> (test-write-bytes-mode)
rlm@377 342 (step [])
rlm@377 343 (step [])
rlm@377 344 (step [])
rlm@377 345 (step (buttons 0xFF)) ; Select JUMP mode.
rlm@377 346 (step (buttons target-high))
rlm@377 347 (step (buttons target-low)))
rlm@377 348 program-counters
rlm@377 349 (capture-program-counter
rlm@377 350 post-jump
rlm@377 351 10000)]
rlm@377 352 (println program-counters)
rlm@377 353 (assert (contains? (set program-counters) target-address))
rlm@377 354 post-jump))