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

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
line wrap: on
line source
1 (ns com.aurellem.gb.util
2 (:use (com.aurellem.gb gb-driver vbm))
3 (:import [com.aurellem.gb.gb_driver SaveState]))
6 (defn A [state]
7 (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
9 (defn B [state]
10 (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
12 (defn D [state]
13 (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
15 (defn H [state]
16 (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
18 (defn C [state]
19 (bit-and 0xFF (BC state)))
20 (defn F [state]
21 (bit-and 0xFF (AF state)))
22 (defn E [state]
23 (bit-and 0xFF (DE state)))
24 (defn L [state]
25 (bit-and 0xFF (HL state)))
27 (defn binary-str [num]
28 (format "%08d"
29 (Integer/parseInt
30 (Integer/toBinaryString num) 10)))
32 (defn view-register [state name reg-fn]
33 (println (format "%s: %s" name
34 (binary-str (reg-fn state))))
35 state)
37 (defn view-memory
38 ([^SaveState state mem]
39 (println (format "mem 0x%04X = %s" mem
40 (binary-str (aget (memory state) mem))))
41 state)
42 ([mem]
43 (view-memory @current-state mem)))
45 (defn print-listing [state begin end]
46 (dorun (map
47 (fn [opcode line]
48 (println (format "0x%04X: 0x%02X" line opcode)))
49 (subvec (vec (memory state)) begin end)
50 (range begin end)))
51 state)
53 (defn print-pc
54 ([^SaveState state]
55 (println (format "PC: 0x%04X" (PC state)))
56 state)
57 ([] (print-pc @current-state)))
59 (defn print-op
60 ([^SaveState state]
61 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
62 state)
63 ([] (print-op @current-state)))
65 (defn d-tick
66 ([state]
67 (-> state print-pc print-op tick)))
69 (defn print-interrupt
70 [^SaveState state]
71 (println (format "IE: %d" (IE state)))
72 state)
74 (defn set-memory
75 ([state location value]
76 (set-state! state)
77 (let [mem (memory state)]
78 (aset mem location value)
79 (write-memory! mem)
80 (update-state)))
81 ([location value]
82 (set-memory @current-state location value)))
84 (defn set-memory-range
85 ([state start values]
86 (set-state! state)
87 (let [mem (memory state)]
89 (dorun (map (fn [index val]
90 (aset mem index val))
91 (range start
92 (+ start (count values))) values))
93 (write-memory! mem)
94 (update-state)))
95 ([start values]
96 (set-memory-range
97 @current-state start values)))
99 (defn common-differences [& seqs]
100 (let [backbone (range (count (first seqs)))]
101 (filter
102 (comp (partial apply distinct?) second)
103 (zipmap backbone
104 (apply (partial map list) seqs)))))
106 (defn mid-game []
107 (read-state "mid-game"))