Mercurial > vba-clojure

annotate clojure/com/aurellem/assembly.clj @ 117:bcb5c41626b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving progress
author Robert McIntyre <rlm@mit.edu>
date Fri, 16 Mar 2012 17:50:35 -0500
parents e45031af5327
children be4ec0e60c16
rev   line source
rlm@105 1 (ns com.aurellem.assembly
rlm@105 2 (:use (com.aurellem gb-driver vbm title items))
rlm@105 3 (:import [com.aurellem.gb_driver SaveState]))
rlm@105 4
rlm@106 5 (defn mid-game []
rlm@106 6 (read-state "mid-game"))
rlm@105 7
rlm@105 8 (defn inject-assembly
rlm@107 9 ([^SaveState state
rlm@105 10 program-counter registers
rlm@105 11 assembly-code]
rlm@105 12 (let [scratch-memory (memory state)]
rlm@105 13 ;; inject assembly code
rlm@105 14 (dorun (map (fn [index val]
rlm@105 15 (aset scratch-memory index val))
rlm@105 16 (range program-counter
rlm@105 17 (+ program-counter (count assembly-code)))
rlm@105 18 assembly-code))
rlm@106 19 (-> state
rlm@106 20 (write-memory! scratch-memory)
rlm@106 21 (write-registers! registers)
rlm@112 22 (PC! program-counter)))))
rlm@105 23
rlm@105 24 (defn inject-item-assembly
rlm@105 25 ([^SaveState state assembly-code]
rlm@105 26 (inject-assembly state (inc item-list-start)
rlm@105 27 (registers state)
rlm@105 28 assembly-code))
rlm@105 29 ([assembly-code]
rlm@105 30 (inject-item-assembly @current-state assembly-code)))
rlm@105 31
rlm@105 32 (defn info
rlm@105 33 ([^SaveState state]
rlm@107 34 (println (format "PC: 0x%04X" (PC state)))
rlm@106 35 (println "Instruction:"
rlm@106 36 (format "0x%02X" (aget (memory state) (PC state))))
rlm@105 37 state))
rlm@105 38
rlm@107 39 (defn print-interrupt
rlm@107 40 [^SaveState state]
rlm@107 41 (println (format "IE: %d" (IE state)))
rlm@107 42 state)
rlm@107 43
rlm@105 44 (defn run-assembly
rlm@105 45 ([info-fn assembly n]
rlm@105 46 (let [final-state
rlm@105 47 (reduce (fn [state _]
rlm@105 48 (tick (info-fn state)))
rlm@107 49 (inject-item-assembly
rlm@107 50 (mid-game) assembly)
rlm@105 51 (range n))]
rlm@105 52 final-state))
rlm@105 53 ([assembly n]
rlm@105 54 (run-assembly info assembly n)))
rlm@107 55
rlm@107 56 (def buttons-port 0xFF00)
rlm@107 57
rlm@107 58 (defn A [state]
rlm@107 59 (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
rlm@107 60
rlm@110 61 (defn binary-str [num]
rlm@110 62 (format "%08d"
rlm@110 63 (Integer/parseInt
rlm@110 64 (Integer/toBinaryString num) 10)))
rlm@110 65
rlm@110 66 (defn view-register [state name reg-fn]
rlm@110 67 (println (format "%s: %s" name
rlm@110 68 (binary-str (reg-fn state))))
rlm@110 69 state)
rlm@110 70
rlm@110 71
rlm@107 72 (defn view-memory [state mem]
rlm@110 73 (println (format "mem 0x%04X = %s" mem
rlm@110 74 (binary-str (aget (memory state) mem))))
rlm@107 75 state)
rlm@107 76
rlm@113 77 (defn read-down-button []
rlm@110 78 (-> (tick (mid-game))
rlm@110 79 (IE! 0) ; disable interrupts
rlm@110 80 (inject-item-assembly
rlm@110 81 (concat
rlm@110 82 ;; write 00010000 to 0xFF00 to select joypad
rlm@110 83 [0x18 ;D31D ; jump over
rlm@110 84 0x01 ;D31E ; the next 8 bits
rlm@113 85 ;D31F
rlm@113 86 (Integer/parseInt "00100000" 2) ; data section
rlm@111 87
rlm@111 88 0xFA ;D320 ; load (D31F) into A
rlm@111 89 0x1F ;D321 -->
rlm@111 90 0xD3 ;D322 --> D31F
rlm@107 91
rlm@111 92 0xEA ;D323 ; load (A), which is
rlm@111 93 0x00 ;D324 --> ; 00010000, into FF00
rlm@111 94 0xFF ;D325 --> FF00
rlm@111 95
rlm@111 96 0x18 ;D326 ; this is the place where
rlm@111 97 0x01 ;D327 ; we will store whether
rlm@111 98 0x00 ;D328 ; "down" is pressed.
rlm@107 99
rlm@111 100 0xFA ;D329 ; (FF00) -> A
rlm@111 101 0x00 ;D32A
rlm@111 102 0xFF ;D32B
rlm@110 103
rlm@111 104 0xCB ;D32C ; Test whether "down"
rlm@111 105 0x5F ;D32D ; is pressed.
rlm@111 106
rlm@111 107 0x28 ;D32E ; if down is pressed,
rlm@111 108 0x03 ;D32F ; skip the next section
rlm@111 109 ; of code.
rlm@111 110 ;; down-is-not-pressed
rlm@111 111 0xC3 ;D330
rlm@111 112 0x1D ;D331 ; return to beginning
rlm@111 113 0xD3 ;D332
rlm@111 114
rlm@111 115 ;; down-is-pressed
rlm@111 116 0xEA ;D334 ; write A to D328 if
rlm@111 117 0x28 ;D335 ; "down" was pressed
rlm@111 118 0xD3 ;D336
rlm@111 119
rlm@111 120 0xC3 ;D330
rlm@111 121 0x1D ;D331 ; return to beginning
rlm@111 122 0xD3 ;D332
rlm@110 123 ]
rlm@110 124
rlm@111 125 []))))
rlm@111 126
rlm@113 127
rlm@113 128
rlm@113 129
rlm@113 130 (defn count-frames []
rlm@113 131 (-> (tick (mid-game))
rlm@113 132 (IE! 0) ; disable interrupts
rlm@113 133 (inject-item-assembly
rlm@113 134 [0x18 ;D31D ; jump over
rlm@113 135 0x02 ;D31E ; the next 2 bytes
rlm@113 136 0x00 ;D31F ; frame-count
rlm@113 137 0x00 ;D320 ; v-blank-prev
rlm@113 138
rlm@113 139 0xFA ;D321
rlm@113 140 0x41 ;D322 ; load (FF41) into A
rlm@113 141 0xFF ;D323 ; this contains mode flags
rlm@113 142
rlm@113 143 ;; if we're in v-blank, the bit-1 is 0
rlm@113 144 ;; and bit-2 is 1 Otherwise, it is not v-blank.
rlm@113 145 0xCB ;D324 ; test bit-1 of A
rlm@113 146 0x4F ;D325
rlm@113 147
rlm@113 148 0xC2 ;D326 ; if bit-1 is not 0
rlm@115 149 0x44 ;D327 ; GOTO not-v-blank
rlm@113 150 0xD3 ;D328
rlm@113 151
rlm@113 152 0xCB ;D329 ; test bit-0 of A
rlm@113 153 0x47 ;D32A
rlm@113 154
rlm@113 155 0xCA ;D32B ; if bit-0 is not 1
rlm@115 156 0x44 ;D32C ; GOTO not-v-blank
rlm@113 157 0xD3 ;D32D
rlm@113 158
rlm@114 159 ;;; in v-blank mode
rlm@113 160
rlm@113 161 ;; if v-blank-prev was 0,
rlm@113 162 ;; increment frame-count
rlm@113 163
rlm@113 164 0xFA ;D32E ; load v-blank-prev to A
rlm@113 165 0x20 ;D32F
rlm@113 166 0xD3 ;D330
rlm@113 167
rlm@113 168 0xCB ;D331
rlm@113 169 0x47 ;D332 ; test bit-0 of A
rlm@113 170
rlm@113 171 0x20 ;D333 ; skip next section
rlm@113 172 0x07 ;D334 ; if v-blank-prev was not zero
rlm@113 173
rlm@113 174 ;; v-blank was 0, increment frame-count
rlm@113 175 0xFA ;D335 ; load frame-count into A
rlm@113 176 0x1F ;D336
rlm@113 177 0xD3 ;D337
rlm@113 178
rlm@113 179 0x3C ;D338 ; inc A
rlm@113 180
rlm@113 181 0xEA ;D339 ; load A into frame-count
rlm@113 182 0x1F ;D33A
rlm@113 183 0xD3 ;D33B
rlm@113 184
rlm@114 185 ;; set v-blank-prev to 1
rlm@113 186 0x3E ;D33C ; load 1 into A
rlm@113 187 0x01 ;D33D
rlm@113 188
rlm@113 189 0xEA ;D33E ; load A into v-blank-prev
rlm@113 190 0x20 ;D33F
rlm@113 191 0xD3 ;D340
rlm@113 192
rlm@115 193 0xC3 ;D341 ; return to beginning
rlm@115 194 0x1D ;D342
rlm@115 195 0xD3 ;D343
rlm@113 196
rlm@114 197 ;;; not in v-blank mode
rlm@114 198 ;; set v-blank-prev to 0
rlm@115 199 0x3E ;D344 ; load 0 into A
rlm@115 200 0x00 ;D345
rlm@113 201
rlm@115 202 0xEA ;D346 ; load A into v-blank-prev
rlm@115 203 0x20 ;D347
rlm@115 204 0xD3 ;D348
rlm@115 205
rlm@115 206 0xC3 ;D349 ; return to beginning
rlm@115 207 0x1D ;D34A
rlm@115 208 0xD3 ;D34B
rlm@113 209
rlm@113 210 ])))
rlm@113 211
rlm@114 212 (defn step-count-frames []
rlm@113 213 (-> (read-down-button)
rlm@110 214 (info)
rlm@110 215 (tick) ;; skip over data section
rlm@110 216 (info)
rlm@110 217 (view-register "Register A" A)
rlm@110 218 (tick) ;; load-data into A
rlm@110 219 (view-register "Register A" A)
rlm@110 220 (info)
rlm@110 221 (view-memory 0xFF00)
rlm@110 222 (tick) ;; load A into 0xFF00
rlm@110 223 (view-memory 0xFF00)
rlm@111 224 (info)
rlm@111 225 (tick)
rlm@111 226 (info)
rlm@111 227 (tick)
rlm@111 228 (info)
rlm@111 229 (tick)
rlm@111 230 (info)
rlm@111 231 (tick)
rlm@111 232 (info)
rlm@111 233 (tick)
rlm@111 234 (info)
rlm@111 235 (tick)
rlm@111 236 (print-inventory)))
rlm@111 237
rlm@115 238 ;;(defn test-read-down []
rlm@115 239 ;; (= (view-memory (step (step (read-buttons) [:d])) 0xD328)
rlm@115 240 ;; (view-memory (step (step (read-buttons))) 0xD328)))
rlm@115 241
rlm@115 242 (defn test-count-frames []
rlm@115 243 (= 255 (aget (memory ((apply comp (repeat 255 step))
rlm@115 244 (count-frames)))
rlm@115 245 0xD31F)))
rlm@115 246
rlm@115 247
rlm@107 248 (defn trace [state]
rlm@107 249 (loop [program-counters []
rlm@107 250 opcodes []]
rlm@107 251 (let [frame-boundary?
rlm@107 252 (com.aurellem.gb.Gb/tick)]
rlm@107 253 (println (count opcodes))
rlm@107 254 (if frame-boundary?
rlm@107 255 [program-counters opcodes]
rlm@107 256 (recur
rlm@107 257 (conj program-counters
rlm@107 258 (first (registers @current-state)))
rlm@107 259 (conj opcodes
rlm@107 260 (aget (memory @current-state)
rlm@107 261 (PC @current-state))))))))
rlm@107 262
rlm@107 263 (defn good-trace []
rlm@107 264 (-> (mid-game) (tick) (IE! 0)
rlm@107 265 (set-inv-mem [0x00 0x00 0X00 0x00])
rlm@107 266 (PC! item-list-start)(print-interrupt)
rlm@112 267 (info) (tick) (info) (tick) (info)))
rlm@114 268
rlm@115 269 ;; specs for main bootstrap program
rlm@115 270 ;; starts in "mode-select" mode
rlm@115 271 ;; Each button press takes place in a single frame.
rlm@115 272 ;; mode-select-mode takes one of the main buttons
rlm@115 273 ;; which selects one of up to eight modes
rlm@115 274 ;; mode 1 activated by the "A" button
rlm@115 275 ;; the next two button presses indicates the start
rlm@115 276 ;; memory location which to which the bootstrap
rlm@115 277 ;; program will write.
rlm@115 278 ;; This is done by using each of the eight buttons to
rlm@115 279 ;; spell out an 8 bit number. The order of buttons is
rlm@116 280 ;; [:d :u :l :r :start :select :b :a]
rlm@116 281 ;; [:a :start :l] --> 00101001
rlm@114 282
rlm@115 283 ;; the next button press determines how many bytes are to be
rlm@115 284 ;; written, starting at the start position.
rlm@114 285
rlm@115 286 ;; then, the actual bytes are entered and are written to the
rlm@115 287 ;; start address in sequence.
rlm@114 288
rlm@114 289
rlm@114 290
rlm@115 291 (defn input-number []
rlm@115 292 (-> (tick (mid-game))
rlm@115 293 (IE! 0) ; disable interrupts
rlm@115 294 (inject-item-assembly
rlm@115 295 [0x18 ;D31D ; jump over
rlm@115 296 0x02 ;D31E ; the next 2 bytes
rlm@115 297 0x00 ;D31F ; frame-count
rlm@115 298 0x00 ;D320 ; v-blank-prev
rlm@115 299
rlm@115 300 0xFA ;D321
rlm@115 301 0x41 ;D322 ; load (FF41) into A
rlm@115 302 0xFF ;D323 ; this contains mode flags
rlm@115 303
rlm@115 304 ;; if we're in v-blank, the bit-1 is 0
rlm@115 305 ;; and bit-2 is 1 Otherwise, it is not v-blank.
rlm@115 306 0xCB ;D324 ; test bit-1 of A
rlm@115 307 0x4F ;D325
rlm@114 308
rlm@115 309 0xC2 ;D326 ; if bit-1 is not 0
rlm@115 310 0x44 ;D327 ; GOTO not-v-blank
rlm@115 311 0xD3 ;D328
rlm@115 312
rlm@115 313 0xCB ;D329 ; test bit-0 of A
rlm@115 314 0x47 ;D32A
rlm@114 315
rlm@115 316 0xCA ;D32B ; if bit-0 is not 1
rlm@115 317 0x44 ;D32C ; GOTO not-v-blank
rlm@115 318 0xD3 ;D32D
rlm@115 319
rlm@115 320 ;;; in v-blank mode
rlm@114 321
rlm@115 322 ;; if v-blank-prev was 0,
rlm@115 323 ;; increment frame-count
rlm@115 324
rlm@115 325 0xFA ;D32E ; load v-blank-prev to A
rlm@115 326 0x20 ;D32F
rlm@115 327 0xD3 ;D330
rlm@115 328
rlm@115 329 0xCB ;D331
rlm@115 330 0x47 ;D332 ; test bit-0 of A
rlm@115 331
rlm@115 332 0x20 ;D333 ; skip next section
rlm@115 333 0x07 ;D334 ; if v-blank-prev was not zero
rlm@115 334
rlm@115 335 ;; v-blank was 0, increment frame-count
rlm@115 336 0xFA ;D335 ; load frame-count into A
rlm@115 337 0x1F ;D336
rlm@115 338 0xD3 ;D337
rlm@115 339
rlm@115 340 0x3C ;D338 ; inc A
rlm@115 341
rlm@115 342 0xEA ;D339 ; load A into frame-count
rlm@115 343 0x1F ;D33A
rlm@115 344 0xD3 ;D33B
rlm@115 345
rlm@115 346 ;; set v-blank-prev to 1
rlm@115 347 0x3E ;D33C ; load 1 into A
rlm@115 348 0x01 ;D33D
rlm@115 349
rlm@115 350 0xEA ;D33E ; load A into v-blank-prev
rlm@115 351 0x20 ;D33F
rlm@115 352 0xD3 ;D340
rlm@115 353
rlm@115 354 0xC3 ;D341 ; GOTO input handling code
rlm@115 355 0x4E ;D342
rlm@115 356 0xD3 ;D343
rlm@115 357
rlm@115 358 ;;; not in v-blank mode
rlm@115 359 ;; set v-blank-prev to 0
rlm@115 360 0x3E ;D344 ; load 0 into A
rlm@115 361 0x00 ;D345
rlm@115 362
rlm@115 363 0xEA ;D346 ; load A into v-blank-prev
rlm@115 364 0x20 ;D347
rlm@115 365 0xD3 ;D348
rlm@115 366
rlm@115 367 0xC3 ;D349 ; return to beginning
rlm@115 368 0x1D ;D34A
rlm@115 369 0xD3 ;D34B
rlm@115 370
rlm@115 371 0x00 ;D34C ; these are here
rlm@115 372 0x00 ;D34D ; for glue
rlm@115 373
rlm@115 374
rlm@115 375 ;;; calculate input number based on button presses
rlm@115 376 0x18 ;D34E ; skip next 3 bytes
rlm@115 377 0x03 ;D34F
rlm@115 378 ;D350
rlm@115 379 (Integer/parseInt "00100000" 2) ; select directional pad
rlm@115 380 ;D351
rlm@115 381 (Integer/parseInt "00010000" 2) ; select buttons
rlm@115 382 0x00 ;D352 ; input-number
rlm@115 383
rlm@115 384 ;; select directional pad, store low bits in B
rlm@115 385
rlm@115 386 0xFA ;D353 ; load (D350) into A
rlm@115 387 0x50 ;D354 -->
rlm@115 388 0xD3 ;D355 --> D31F
rlm@115 389
rlm@115 390 0xEA ;D356 ; load (A), which is
rlm@115 391 0x00 ;D357 --> ; 00010000, into FF00
rlm@115 392 0xFF ;D358 --> FF00
rlm@115 393
rlm@115 394 0x06 ;D359
rlm@115 395 ;D35A
rlm@116 396 (Integer/parseInt "11110000" 2) ; "11110000" -> B
rlm@115 397 0xFA ;D35B ; (FF00) -> A
rlm@115 398 0x00 ;D35C
rlm@115 399 0xFF ;D35D
rlm@115 400
rlm@115 401 0xCB ;D35E ; swap nybbles on A
rlm@115 402 0x37 ;D35F
rlm@115 403 0xA0 ;D360 ; (AND A B) -> A
rlm@115 404 0x47 ;D361 ; A -> B
rlm@115 405
rlm@115 406 ;; select buttons store bottom bits in C
rlm@115 407
rlm@115 408 0xFA ; ; load (D351) into A
rlm@115 409 0x51 ; -->
rlm@115 410 0xD3 ; --> D31F
rlm@115 411
rlm@115 412 0xEA ; ; load (A), which is
rlm@115 413 0x00 ; --> ; 00001000, into FF00
rlm@115 414 0xFF ; --> FF00
rlm@115 415
rlm@115 416 0x0E ;
rlm@116 417 (Integer/parseInt "00001111" 2) ; "00001111" -> C
rlm@115 418
rlm@115 419 0xFA ; ; (FF00) -> A
rlm@115 420 0x00 ;
rlm@115 421 0xFF ;
rlm@115 422
rlm@115 423 0xA1 ; ; (AND A C) -> A
rlm@115 424 0x4F ; ; A -> C
rlm@115 425
rlm@115 426
rlm@115 427 ;; combine the B and C registers into the input number
rlm@115 428 0x79 ; ; C -> A
rlm@115 429 0xB0 ; ; (OR A B) -> A
rlm@115 430 0x2F ; ; negate A
rlm@115 431
rlm@115 432 0xEA ; ; store A into input-number
rlm@115 433 0x52 ;
rlm@115 434 0xD3 ;
rlm@115 435
rlm@115 436 0xC3 ; ; return to beginning
rlm@115 437 0x1D ;
rlm@115 438 0xD3 ;
rlm@115 439 ])))
rlm@115 440
rlm@115 441 (defn print-listing [state begin end]
rlm@115 442 (dorun (map
rlm@115 443 (fn [opcode line]
rlm@115 444 (println (format "0x%04X: 0x%02X" line opcode)))
rlm@115 445 (subvec (vec (memory state)) begin end)
rlm@117 446 (range begin end)))
rlm@117 447 state)
rlm@115 448
rlm@117 449 (defn test-input-number
rlm@117 450 "Input freestyle buttons and observe the effects at the repl."
rlm@117 451 []
rlm@117 452 (set-state! (input-number))
rlm@117 453 (dotimes [_ 90000] (step (view-memory @current-state 0xD352))))
rlm@115 454
rlm@115 455
rlm@115 456
rlm@115 457