Mercurial > vba-clojure
diff clojure/com/aurellem/gb/mem_util.clj @ 308:de172acc5a03
moved the memory manipulation functions out of world.practice and into a separate location, gb.mem-utils, to avoid cyclic load dependency. will adjust the dependent files shortly.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Sat, 31 Mar 2012 04:25:49 -0500 |
parents | |
children | 3d4f60b4a4af |
line wrap: on
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/clojure/com/aurellem/gb/mem_util.clj Sat Mar 31 04:25:49 2012 -0500 1.3 @@ -0,0 +1,192 @@ 1.4 +(ns com.aurellem.gb.mem-util 1.5 + (:use (com.aurellem.gb assembly characters gb-driver)) 1.6 + (:import [com.aurellem.gb.gb_driver SaveState])) 1.7 + 1.8 + 1.9 + 1.10 + 1.11 + 1.12 +(def hex-pc (comp hex PC)) 1.13 + 1.14 +(defn nstep [state n] 1.15 + (if (zero? n) state 1.16 + (recur (step state) (dec n)))) 1.17 + 1.18 + 1.19 +(defn view-memory* 1.20 + "View a region of indexable memory in the given state." 1.21 + [state start length] 1.22 + ((comp vec map) 1.23 + #((comp aget) (memory state) %) 1.24 + (range start (+ start length)))) 1.25 + 1.26 + 1.27 +(defn pc-trail 1.28 + "Track the PC for a number of ticks." 1.29 + [state ticks] 1.30 + (tick state) 1.31 + (set-state! state) 1.32 + (loop [pcs [(PC)] ] 1.33 + (if (> (count pcs) ticks) pcs 1.34 + (do 1.35 + (com.aurellem.gb.Gb/tick) 1.36 + (recur (conj pcs (PC))))))) 1.37 + 1.38 + 1.39 +(defn get-memory [state n] 1.40 + (aget (memory state) n)) 1.41 + 1.42 +(defn first-change 1.43 + "Watch the current memory location as it ticks, 1.44 +return the first state that differs at location mem." 1.45 + [state n] 1.46 + (tick state) 1.47 + (set-state! state) 1.48 + (let [init (aget (memory state) n)] 1.49 + (loop [] 1.50 + (if (= (aget (memory) n) init) 1.51 + (do 1.52 + (com.aurellem.gb.Gb/tick) 1.53 + (recur)))) 1.54 + (update-state))) 1.55 + 1.56 + 1.57 + 1.58 + 1.59 + 1.60 + 1.61 + 1.62 +(defn differences 1.63 + "Return the differences between the two lists as triples [index 1.64 +(list-1 index) (list-2 index)]." 1.65 +[list-1 list-2] 1.66 + (remove 1.67 + (fn [[a b c]] (= b c)) 1.68 + (map vector 1.69 + (range) 1.70 + list-1 1.71 + list-2))) 1.72 + 1.73 +(defn pc-diff 1.74 + "Return the differences between the program counter evolution 1.75 +between the two states (measured for 10000 ticks)." 1.76 + [state-1 state-2] 1.77 + (differences (map hex (pc-trail state-1 10000)) 1.78 + (map hex (pc-trail state-2 10000)))) 1.79 + 1.80 + 1.81 +(defn memory-diff [state-1 state-2] 1.82 + (remove 1.83 + (fn[[a b c]] (= b c)) 1.84 + (map (comp vec (partial map hex) list) 1.85 + (range) 1.86 + (vec (memory state-1)) 1.87 + (vec (memory state-2))) 1.88 + )) 1.89 + 1.90 + 1.91 +(defn spell-array 1.92 + "Interpret the array as a string of printable Pokemon-text characters." 1.93 + [array start n] 1.94 + (character-codes->str 1.95 + (take n (drop start 1.96 + (vec array))))) 1.97 + 1.98 +(defn spell-memory 1.99 + "Interpret the indexable memory of the state as a string of printable 1.100 +Pokemon-text characters. If no state is given, uses current-state." 1.101 + ([state mem n] 1.102 + (spell-array (memory state) mem n)) 1.103 + ([mem n] (spell-array @current-state mem n))) 1.104 + 1.105 + 1.106 +(defn sublist 1.107 + "Unshifts the list until the sublist is at the start." 1.108 + [list sub] 1.109 + (cond 1.110 + (empty? sub) list 1.111 + (empty? list) nil 1.112 + (= (take (count sub) list) sub) list 1.113 + :else (recur (rest list) sub))) 1.114 + 1.115 +(defn find-sublist 1.116 + "Returns the position of the first occurence of sublist." 1.117 + [list sub] 1.118 + (loop [n 0 a list] 1.119 + (cond 1.120 + (empty? a) nil 1.121 + (= (take (count sub) a) sub) n 1.122 + :else (recur (inc n) (rest a))))) 1.123 + 1.124 +(defn find-sublists 1.125 + "Returns a vector of the occurences of sublists." 1.126 + [list sub] 1.127 + (let [m (find-sublist list sub)] 1.128 + (if (nil? m) '() 1.129 + (cons m 1.130 + (map (partial + (inc m)) 1.131 + (find-sublists 1.132 + (drop (inc m) list) 1.133 + sub)))))) 1.134 + 1.135 + 1.136 + 1.137 +(defn search-memory 1.138 + "Search for the given codes in memory, returning short snippets of 1.139 +text around the results." 1.140 + ([codes k] 1.141 + (search-memory com.aurellem.gb.gb-driver/original-rom codes k)) 1.142 + ([array codes k] 1.143 + (map 1.144 + (fn [n] 1.145 + [(hex n) 1.146 + (take k (drop n rom))]) 1.147 + 1.148 + (find-sublists 1.149 + rom 1.150 + codes)))) 1.151 + 1.152 +(defn spelling-bee 1.153 + "Search for the given string in ROM, returning short snippets of 1.154 + text around the results." 1.155 + ([str k] 1.156 + (spelling-bee com.aurellem.gb.gb-driver/original-rom str k)) 1.157 + ([rom str k] 1.158 + (map 1.159 + (fn [[address snip]] 1.160 + [address (character-codes->str snip)]) 1.161 + (search-memory rom (str->character-codes str) k)))) 1.162 + 1.163 + 1.164 + 1.165 + 1.166 + 1.167 + 1.168 +(defn rewrite-memory 1.169 + "Alter the vector of memory. Treats strings as lists of character 1.170 +ops." 1.171 + ([mem start strs-or-ops] 1.172 + (let [x (first strs-or-ops)] 1.173 + (cond (empty? strs-or-ops) mem 1.174 + (string? x) 1.175 + 1.176 + (recur mem start 1.177 + (concat 1.178 + (str->character-codes x) 1.179 + (rest strs-or-ops))) 1.180 + :else 1.181 + (recur 1.182 + (assoc mem start x) 1.183 + (inc start) 1.184 + (rest strs-or-ops)))))) 1.185 + 1.186 + 1.187 +(defn rewrite-rom 1.188 + "Alter the rom at the given location. Takes a list of 1.189 +various strings/bytes as data." 1.190 + [start strs-or-bytes] 1.191 + ((partial rewrite-memory (vec (rom(root)))) 1.192 + start strs-or-bytes)) 1.193 + 1.194 +(defn restore-rom! [] (write-rom! original-rom)) 1.195 +