Mercurial > vba-clojure

annotate clojure/com/aurellem/assembly.clj @ 112:6fe33bb5ea22

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 Thu, 15 Mar 2012 17:29:49 -0500
parents 8be7ce890184
children 0831da75d2c5
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@107 77 (defn read-buttons []
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@111 85 (Integer/parseInt "00100000" 2) ;D31F data section
rlm@111 86
rlm@111 87 0xFA ;D320 ; load (D31F) into A
rlm@111 88 0x1F ;D321 -->
rlm@111 89 0xD3 ;D322 --> D31F
rlm@107 90
rlm@111 91 0xEA ;D323 ; load (A), which is
rlm@111 92 0x00 ;D324 --> ; 00010000, into FF00
rlm@111 93 0xFF ;D325 --> FF00
rlm@111 94
rlm@111 95 0x18 ;D326 ; this is the place where
rlm@111 96 0x01 ;D327 ; we will store whether
rlm@111 97 0x00 ;D328 ; "down" is pressed.
rlm@107 98
rlm@111 99 0xFA ;D329 ; (FF00) -> A
rlm@111 100 0x00 ;D32A
rlm@111 101 0xFF ;D32B
rlm@110 102
rlm@111 103 0xCB ;D32C ; Test whether "down"
rlm@111 104 0x5F ;D32D ; is pressed.
rlm@111 105
rlm@111 106 0x28 ;D32E ; if down is pressed,
rlm@111 107 0x03 ;D32F ; skip the next section
rlm@111 108 ; of code.
rlm@111 109 ;; down-is-not-pressed
rlm@111 110 0xC3 ;D330
rlm@111 111 0x1D ;D331 ; return to beginning
rlm@111 112 0xD3 ;D332
rlm@111 113
rlm@111 114 ;; down-is-pressed
rlm@111 115 0xEA ;D334 ; write A to D328 if
rlm@111 116 0x28 ;D335 ; "down" was pressed
rlm@111 117 0xD3 ;D336
rlm@111 118
rlm@111 119 0xC3 ;D330
rlm@111 120 0x1D ;D331 ; return to beginning
rlm@111 121 0xD3 ;D332
rlm@110 122 ]
rlm@110 123
rlm@111 124 []))))
rlm@111 125
rlm@111 126 (defn run-a-bit []
rlm@111 127 (-> (read-buttons)
rlm@110 128 (info)
rlm@110 129 (tick) ;; skip over data section
rlm@110 130 (info)
rlm@110 131 (view-register "Register A" A)
rlm@110 132 (tick) ;; load-data into A
rlm@110 133 (view-register "Register A" A)
rlm@110 134 (info)
rlm@110 135 (view-memory 0xFF00)
rlm@110 136 (tick) ;; load A into 0xFF00
rlm@110 137 (view-memory 0xFF00)
rlm@111 138 (info)
rlm@111 139 (tick)
rlm@111 140 (info)
rlm@111 141 (tick)
rlm@111 142 (info)
rlm@111 143 (tick)
rlm@111 144 (info)
rlm@111 145 (tick)
rlm@111 146 (info)
rlm@111 147 (tick)
rlm@111 148 (info)
rlm@111 149 (tick)
rlm@111 150 (print-inventory)))
rlm@111 151
rlm@112 152 (defn test-read-pad []
rlm@112 153 (= (view-memory (step (step (read-buttons) [:d])) 0xD328)
rlm@112 154 (view-memory (step (step (read-buttons))) 0xD328)))
rlm@111 155
rlm@107 156 (defn trace [state]
rlm@107 157 (loop [program-counters []
rlm@107 158 opcodes []]
rlm@107 159 (let [frame-boundary?
rlm@107 160 (com.aurellem.gb.Gb/tick)]
rlm@107 161 (println (count opcodes))
rlm@107 162 (if frame-boundary?
rlm@107 163 [program-counters opcodes]
rlm@107 164 (recur
rlm@107 165 (conj program-counters
rlm@107 166 (first (registers @current-state)))
rlm@107 167 (conj opcodes
rlm@107 168 (aget (memory @current-state)
rlm@107 169 (PC @current-state))))))))
rlm@107 170
rlm@107 171 (defn good-trace []
rlm@107 172 (-> (mid-game) (tick) (IE! 0)
rlm@107 173 (set-inv-mem [0x00 0x00 0X00 0x00])
rlm@107 174 (PC! item-list-start)(print-interrupt)
rlm@112 175 (info) (tick) (info) (tick) (info)))