Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/util.clj @ 175:5d9a7a0ca09a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
beginning test of latest assembly code. 240->70.
author Dylan Holmes <ocsenave@gmail.com>
date Wed, 21 Mar 2012 18:17:37 -0500
parents 5ce074824fac
children 95b2758dd517
rev   line source
rlm@145 1 (ns com.aurellem.gb.util
rlm@145 2 (:use (com.aurellem.gb gb-driver vbm))
rlm@145 3 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@145 4
rlm@145 5
rlm@145 6 (defn A [state]
rlm@145 7 (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
rlm@145 8
rlm@145 9 (defn B [state]
rlm@145 10 (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
rlm@145 11
rlm@145 12 (defn D [state]
rlm@145 13 (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
rlm@145 14
rlm@145 15 (defn H [state]
rlm@145 16 (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
rlm@145 17
rlm@145 18 (defn C [state]
rlm@145 19 (bit-and 0xFF (BC state)))
rlm@145 20 (defn F [state]
rlm@145 21 (bit-and 0xFF (AF state)))
rlm@145 22 (defn E [state]
rlm@145 23 (bit-and 0xFF (DE state)))
rlm@145 24 (defn L [state]
rlm@145 25 (bit-and 0xFF (HL state)))
rlm@145 26
rlm@145 27 (defn binary-str [num]
rlm@145 28 (format "%08d"
rlm@145 29 (Integer/parseInt
rlm@145 30 (Integer/toBinaryString num) 10)))
rlm@145 31
rlm@145 32 (defn view-register [state name reg-fn]
rlm@145 33 (println (format "%s: %s" name
rlm@145 34 (binary-str (reg-fn state))))
rlm@145 35 state)
rlm@145 36
rlm@174 37 (defn view-memory
rlm@174 38 ([^SaveState state mem]
rlm@174 39 (println (format "mem 0x%04X = %s" mem
rlm@174 40 (binary-str (aget (memory state) mem))))
rlm@174 41 state)
rlm@174 42 ([mem]
rlm@174 43 (view-memory @current-state mem)))
rlm@145 44
rlm@145 45 (defn print-listing [state begin end]
rlm@145 46 (dorun (map
rlm@145 47 (fn [opcode line]
rlm@145 48 (println (format "0x%04X: 0x%02X" line opcode)))
rlm@145 49 (subvec (vec (memory state)) begin end)
rlm@145 50 (range begin end)))
rlm@145 51 state)
rlm@145 52
rlm@174 53 (defn print-pc
rlm@174 54 ([^SaveState state]
rlm@174 55 (println (format "PC: 0x%04X" (PC state)))
rlm@174 56 state)
rlm@174 57 ([] (print-pc @current-state)))
rlm@145 58
rlm@174 59 (defn print-op
rlm@174 60 ([^SaveState state]
rlm@174 61 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
rlm@174 62 state)
rlm@174 63 ([] (print-op @current-state)))
rlm@145 64
rlm@145 65 (defn d-tick
rlm@145 66 ([state]
rlm@145 67 (-> state print-pc print-op tick)))
rlm@145 68
rlm@145 69 (defn print-interrupt
rlm@145 70 [^SaveState state]
rlm@145 71 (println (format "IE: %d" (IE state)))
rlm@145 72 state)
rlm@145 73
rlm@145 74 (defn set-memory
rlm@145 75 ([state location value]
rlm@145 76 (set-state! state)
rlm@145 77 (let [mem (memory state)]
rlm@145 78 (aset mem location value)
rlm@145 79 (write-memory! mem)
rlm@145 80 (update-state)))
rlm@145 81 ([location value]
rlm@145 82 (set-memory @current-state location value)))
rlm@145 83
rlm@145 84 (defn set-memory-range
rlm@145 85 ([state start values]
rlm@145 86 (set-state! state)
rlm@145 87 (let [mem (memory state)]
rlm@145 88
rlm@145 89 (dorun (map (fn [index val]
rlm@145 90 (aset mem index val))
rlm@145 91 (range start
rlm@145 92 (+ start (count values))) values))
rlm@145 93 (write-memory! mem)
rlm@145 94 (update-state)))
rlm@145 95 ([start values]
rlm@145 96 (set-memory-range
rlm@145 97 @current-state start values)))
rlm@145 98
rlm@145 99 (defn common-differences [& seqs]
rlm@145 100 (let [backbone (range (count (first seqs)))]
rlm@145 101 (filter
rlm@145 102 (comp (partial apply distinct?) second)
rlm@145 103 (zipmap backbone
rlm@145 104 (apply (partial map list) seqs)))))
rlm@145 105
rlm@145 106 (defn mid-game []
rlm@145 107 (read-state "mid-game"))
rlm@154 108
rlm@154 109
rlm@154 110