Mercurial > vba-clojure

annotate clojure/com/aurellem/assembly.clj @ 110:f9dee79b2215

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
changed display for memory and registers to binary
author Robert McIntyre <rlm@mit.edu>
date Thu, 15 Mar 2012 14:44:19 -0500
parents c8b48102b17c
children 8be7ce890184
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@106 22 (PC! program-counter))))
rlm@107 23 ;;([program-counter]
rlm@107 24 ;; (fn [^SaveState state registers assembly-code]
rlm@107 25 ;; (inject-assembly state program-counter registers assembly-code)))
rlm@107 26 )
rlm@107 27
rlm@107 28
rlm@107 29 ;;(def inject-assembly-item
rlm@107 30 ;; (inject-assembly (inc item-list-start)))
rlm@105 31
rlm@105 32 (defn inject-item-assembly
rlm@105 33 ([^SaveState state assembly-code]
rlm@105 34 (inject-assembly state (inc item-list-start)
rlm@105 35 (registers state)
rlm@105 36 assembly-code))
rlm@105 37 ([assembly-code]
rlm@105 38 (inject-item-assembly @current-state assembly-code)))
rlm@105 39
rlm@105 40 (defn info
rlm@105 41 ([^SaveState state]
rlm@107 42 (println (format "PC: 0x%04X" (PC state)))
rlm@106 43 (println "Instruction:"
rlm@106 44 (format "0x%02X" (aget (memory state) (PC state))))
rlm@105 45 state))
rlm@105 46
rlm@107 47 (defn print-interrupt
rlm@107 48 [^SaveState state]
rlm@107 49 (println (format "IE: %d" (IE state)))
rlm@107 50 state)
rlm@107 51
rlm@105 52 (defn run-assembly
rlm@105 53 ([info-fn assembly n]
rlm@105 54 (let [final-state
rlm@105 55 (reduce (fn [state _]
rlm@105 56 (tick (info-fn state)))
rlm@107 57 (inject-item-assembly
rlm@107 58 (mid-game) assembly)
rlm@105 59 (range n))]
rlm@105 60 final-state))
rlm@105 61 ([assembly n]
rlm@105 62 (run-assembly info assembly n)))
rlm@107 63
rlm@107 64
rlm@107 65 (def buttons-port 0xFF00)
rlm@107 66
rlm@107 67
rlm@107 68 (defn A [state]
rlm@107 69 (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
rlm@107 70
rlm@110 71 (defn binary-str [num]
rlm@110 72 (format "%08d"
rlm@110 73 (Integer/parseInt
rlm@110 74 (Integer/toBinaryString num) 10)))
rlm@110 75
rlm@110 76 (defn view-register [state name reg-fn]
rlm@110 77 (println (format "%s: %s" name
rlm@110 78 (binary-str (reg-fn state))))
rlm@110 79 state)
rlm@110 80
rlm@110 81
rlm@107 82 (defn view-memory [state mem]
rlm@110 83 (println (format "mem 0x%04X = %s" mem
rlm@110 84 (binary-str (aget (memory state) mem))))
rlm@107 85 state)
rlm@107 86
rlm@107 87 (defn read-buttons []
rlm@110 88
rlm@110 89 (-> (tick (mid-game))
rlm@110 90 (IE! 0) ; disable interrupts
rlm@110 91 (inject-item-assembly
rlm@110 92 (concat
rlm@110 93 ;; write 00010000 to 0xFF00 to select joypad
rlm@110 94 [0x18 ;D31D ; jump over
rlm@110 95 0x01 ;D31E ; the next 8 bits
rlm@110 96 (Integer/parseInt "00010000" 2) ;D31F data section
rlm@110 97 0x00 ;D320 ; take a break
rlm@107 98
rlm@110 99 0xFA ;D321 ; put DC1F into A
rlm@110 100 0x1F ;D322 -->
rlm@110 101 0xD3 ;D323 --> D31F
rlm@107 102
rlm@110 103 0xEA ;D324 ; load (A), which is
rlm@110 104 0x00 ;D325 --> ; 00010000, into FF00
rlm@110 105 0xFF ;D326 --> FF00
rlm@110 106
rlm@110 107 0x00
rlm@110 108 ]
rlm@110 109
rlm@110 110 []))
rlm@110 111 (info)
rlm@110 112 (tick) ;; skip over data section
rlm@110 113 (info)
rlm@110 114 (tick) ;; no-op
rlm@110 115 (info)
rlm@110 116 (view-register "Register A" A)
rlm@110 117 (tick) ;; load-data into A
rlm@110 118 (view-register "Register A" A)
rlm@110 119 (info)
rlm@110 120 (view-memory 0xFF00)
rlm@110 121 (tick) ;; load A into 0xFF00
rlm@110 122 (view-memory 0xFF00)
rlm@110 123 ))
rlm@107 124
rlm@107 125
rlm@107 126 (defn trace [state]
rlm@107 127 (loop [program-counters []
rlm@107 128 opcodes []]
rlm@107 129 (let [frame-boundary?
rlm@107 130 (com.aurellem.gb.Gb/tick)]
rlm@107 131 (println (count opcodes))
rlm@107 132 (if frame-boundary?
rlm@107 133 [program-counters opcodes]
rlm@107 134 (recur
rlm@107 135 (conj program-counters
rlm@107 136 (first (registers @current-state)))
rlm@107 137 (conj opcodes
rlm@107 138 (aget (memory @current-state)
rlm@107 139 (PC @current-state))))))))
rlm@107 140
rlm@107 141
rlm@107 142 (defn good-trace []
rlm@107 143 (-> (mid-game) (tick) (IE! 0)
rlm@107 144 (set-inv-mem [0x00 0x00 0X00 0x00])
rlm@107 145 (PC! item-list-start)(print-interrupt)
rlm@107 146 (info) (tick) (info) (tick) (info)))