view clojure/com/aurellem/gb/mem_util.clj @ 402:eee219d1a259

all tests passed.
author Robert McIntyre <rlm@mit.edu>
date Fri, 13 Apr 2012 09:47:34 -0500
parents 5639312a393f
children
line wrap: on
line source
1 (ns com.aurellem.gb.mem-util
2 (:use (com.aurellem.gb assembly characters gb-driver))
3 (:import [com.aurellem.gb.gb_driver SaveState]))
9 (def hex-pc (comp hex PC))
11 (defn nstep [state n]
12 (if (zero? n) state
13 (recur (step state) (dec n))))
16 (defn view-memory*
17 "View a region of indexable memory in the given state."
18 [state start length]
19 ((comp vec map)
20 #((comp aget) (memory state) %)
21 (range start (+ start length))))
24 (defn pc-trail
25 "Track the PC for a number of ticks."
26 [state ticks]
27 (tick state)
28 (set-state! state)
29 (loop [pcs [(PC)] ]
30 (if (> (count pcs) ticks) pcs
31 (do
32 (com.aurellem.gb.Gb/tick)
33 (recur (conj pcs (PC)))))))
36 (defn get-memory [state n]
37 (aget (memory state) n))
39 (defn first-change
40 "Watch the current memory location as it ticks,
41 return the first state that differs at location mem."
42 [state n]
43 (tick state)
44 (set-state! state)
45 (let [init (aget (memory state) n)]
46 (loop []
47 (if (= (aget (memory) n) init)
48 (do
49 (com.aurellem.gb.Gb/tick)
50 (recur))))
51 (update-state)))
59 (defn differences
60 "Return the differences between the two lists as triples [index
61 (list-1 index) (list-2 index)]."
62 [list-1 list-2]
63 (remove
64 (fn [[a b c]] (= b c))
65 (map vector
66 (range)
67 list-1
68 list-2)))
70 (defn pc-diff
71 "Return the differences between the program counter evolution
72 between the two states (measured for 10000 ticks)."
73 [state-1 state-2]
74 (differences (map hex (pc-trail state-1 10000))
75 (map hex (pc-trail state-2 10000))))
78 (defn memory-diff [state-1 state-2]
79 (remove
80 (fn[[a b c]] (= b c))
81 (map (comp vec (partial map hex) list)
82 (range)
83 (vec (memory state-1))
84 (vec (memory state-2)))
85 ))
88 (defn spell-array
89 "Interpret the array as a string of printable Pokemon-text characters."
90 [array start n]
91 (character-codes->str
92 (take n (drop start
93 (vec array)))))
95 (defn spell-memory
96 "Interpret the indexable memory of the state as a string of printable
97 Pokemon-text characters. If no state is given, uses current-state."
98 ([state mem n]
99 (spell-array (memory state) mem n))
100 ([mem n] (spell-array @current-state mem n)))
103 (defn sublist
104 "Unshifts the list until the sublist is at the start."
105 [list sub]
106 (cond
107 (empty? sub) list
108 (empty? list) nil
109 (= (take (count sub) list) sub) list
110 :else (recur (rest list) sub)))
112 (defn find-sublist
113 "Returns the position of the first occurence of sublist."
114 [list sub]
115 (loop [n 0 a list]
116 (cond
117 (empty? a) nil
118 (= (take (count sub) a) sub) n
119 :else (recur (inc n) (rest a)))))
121 (defn find-sublists
122 "Returns a vector of the occurences of sublists."
123 [list sub]
124 (let [m (find-sublist list sub)]
125 (if (nil? m) '()
126 (cons m
127 (map (partial + (inc m))
128 (find-sublists
129 (drop (inc m) list)
130 sub))))))
134 (defn search-memory
135 "Search for the given codes in memory, returning short snippets of
136 text around the results."
137 ([codes k]
138 (search-memory com.aurellem.gb.gb-driver/original-rom codes k))
139 ([array codes k]
140 (map
141 (fn [n]
142 [(hex n)
143 (take k (drop n array))])
145 (find-sublists
146 array
147 codes))))
149 (defn spelling-bee
150 "Search for the given string in ROM, returning short snippets of
151 text around the results."
152 ([str k]
153 (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))
154 ([rom str k]
155 (map
156 (fn [[address snip]]
157 [address (character-codes->str snip)])
158 (search-memory rom (str->character-codes str) k))))
165 (defn rewrite-memory
166 "Alter the vector of memory. Treats strings as lists of character
167 ops."
168 ([mem start strs-or-ops]
169 (let [x (first strs-or-ops)]
170 (cond (empty? strs-or-ops) mem
171 (string? x)
173 (recur mem start
174 (concat
175 (str->character-codes x)
176 (rest strs-or-ops)))
177 :else
178 (recur
179 (assoc mem start x)
180 (inc start)
181 (rest strs-or-ops))))))
184 (defn rewrite-rom
185 "Alter the rom at the given location. Takes a list of
186 various strings/bytes as data."
187 [start strs-or-bytes]
188 ((partial rewrite-memory (vec (rom(root))))
189 start strs-or-bytes))
191 (defn restore-rom! [] (write-rom! original-rom))
194 (defn endian-flip
195 "Flip the bytes of the two-byte number."
196 [n]
197 (assert (< n 0xFFFF))
198 (+ (* 0x100 (rem n 0x100))
199 (int (/ n 0x100))))
202 (defn offset->ptr
203 "Convert an offset into a little-endian pointer."
204 [n]
205 (->
206 n
207 (rem 0x10000) ;; take last four bytes
208 (rem 0x4000) ;; get relative offset from the start of the bank
209 (+ 0x4000)
210 endian-flip))
212 (defn offset->bank
213 "Get the bank of the offset."
214 [n]
215 (int (/ n 0x4000)))
217 (defn ptr->offset
218 "Convert a two-byte little-endian pointer into an offset."
219 [bank ptr]
220 (->
221 ptr
222 endian-flip
223 (- 0x4000)
224 (+ (* 0x4000 bank))
225 ))
227 (defn same-bank-offset
228 "Convert a ptr into an absolute offset by using the bank of the reference."
229 [reference ptr]
230 (ptr->offset
231 (offset->bank reference)
232 ptr))