Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/mem_util.clj @ 338:92f0011925d2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
created 40-byte program to bootstrap main bootstrap program
author Robert McIntyre <rlm@mit.edu>
date Sat, 07 Apr 2012 12:31:12 -0500
parents 3d4f60b4a4af
children 5639312a393f
rev   line source
ocsenave@308 1 (ns com.aurellem.gb.mem-util
ocsenave@308 2 (:use (com.aurellem.gb assembly characters gb-driver))
ocsenave@308 3 (:import [com.aurellem.gb.gb_driver SaveState]))
ocsenave@308 4
ocsenave@308 5
ocsenave@308 6
ocsenave@308 7
ocsenave@308 8
ocsenave@308 9 (def hex-pc (comp hex PC))
ocsenave@308 10
ocsenave@308 11 (defn nstep [state n]
ocsenave@308 12 (if (zero? n) state
ocsenave@308 13 (recur (step state) (dec n))))
ocsenave@308 14
ocsenave@308 15
ocsenave@308 16 (defn view-memory*
ocsenave@308 17 "View a region of indexable memory in the given state."
ocsenave@308 18 [state start length]
ocsenave@308 19 ((comp vec map)
ocsenave@308 20 #((comp aget) (memory state) %)
ocsenave@308 21 (range start (+ start length))))
ocsenave@308 22
ocsenave@308 23
ocsenave@308 24 (defn pc-trail
ocsenave@308 25 "Track the PC for a number of ticks."
ocsenave@308 26 [state ticks]
ocsenave@308 27 (tick state)
ocsenave@308 28 (set-state! state)
ocsenave@308 29 (loop [pcs [(PC)] ]
ocsenave@308 30 (if (> (count pcs) ticks) pcs
ocsenave@308 31 (do
ocsenave@308 32 (com.aurellem.gb.Gb/tick)
ocsenave@308 33 (recur (conj pcs (PC)))))))
ocsenave@308 34
ocsenave@308 35
ocsenave@308 36 (defn get-memory [state n]
ocsenave@308 37 (aget (memory state) n))
ocsenave@308 38
ocsenave@308 39 (defn first-change
ocsenave@308 40 "Watch the current memory location as it ticks,
ocsenave@308 41 return the first state that differs at location mem."
ocsenave@308 42 [state n]
ocsenave@308 43 (tick state)
ocsenave@308 44 (set-state! state)
ocsenave@308 45 (let [init (aget (memory state) n)]
ocsenave@308 46 (loop []
ocsenave@308 47 (if (= (aget (memory) n) init)
ocsenave@308 48 (do
ocsenave@308 49 (com.aurellem.gb.Gb/tick)
ocsenave@308 50 (recur))))
ocsenave@308 51 (update-state)))
ocsenave@308 52
ocsenave@308 53
ocsenave@308 54
ocsenave@308 55
ocsenave@308 56
ocsenave@308 57
ocsenave@308 58
ocsenave@308 59 (defn differences
ocsenave@308 60 "Return the differences between the two lists as triples [index
ocsenave@308 61 (list-1 index) (list-2 index)]."
ocsenave@308 62 [list-1 list-2]
ocsenave@308 63 (remove
ocsenave@308 64 (fn [[a b c]] (= b c))
ocsenave@308 65 (map vector
ocsenave@308 66 (range)
ocsenave@308 67 list-1
ocsenave@308 68 list-2)))
ocsenave@308 69
ocsenave@308 70 (defn pc-diff
ocsenave@308 71 "Return the differences between the program counter evolution
ocsenave@308 72 between the two states (measured for 10000 ticks)."
ocsenave@308 73 [state-1 state-2]
ocsenave@308 74 (differences (map hex (pc-trail state-1 10000))
ocsenave@308 75 (map hex (pc-trail state-2 10000))))
ocsenave@308 76
ocsenave@308 77
ocsenave@308 78 (defn memory-diff [state-1 state-2]
ocsenave@308 79 (remove
ocsenave@308 80 (fn[[a b c]] (= b c))
ocsenave@308 81 (map (comp vec (partial map hex) list)
ocsenave@308 82 (range)
ocsenave@308 83 (vec (memory state-1))
ocsenave@308 84 (vec (memory state-2)))
ocsenave@308 85 ))
ocsenave@308 86
ocsenave@308 87
ocsenave@308 88 (defn spell-array
ocsenave@308 89 "Interpret the array as a string of printable Pokemon-text characters."
ocsenave@308 90 [array start n]
ocsenave@308 91 (character-codes->str
ocsenave@308 92 (take n (drop start
ocsenave@308 93 (vec array)))))
ocsenave@308 94
ocsenave@308 95 (defn spell-memory
ocsenave@308 96 "Interpret the indexable memory of the state as a string of printable
ocsenave@308 97 Pokemon-text characters. If no state is given, uses current-state."
ocsenave@308 98 ([state mem n]
ocsenave@308 99 (spell-array (memory state) mem n))
ocsenave@308 100 ([mem n] (spell-array @current-state mem n)))
ocsenave@308 101
ocsenave@308 102
ocsenave@308 103 (defn sublist
ocsenave@308 104 "Unshifts the list until the sublist is at the start."
ocsenave@308 105 [list sub]
ocsenave@308 106 (cond
ocsenave@308 107 (empty? sub) list
ocsenave@308 108 (empty? list) nil
ocsenave@308 109 (= (take (count sub) list) sub) list
ocsenave@308 110 :else (recur (rest list) sub)))
ocsenave@308 111
ocsenave@308 112 (defn find-sublist
ocsenave@308 113 "Returns the position of the first occurence of sublist."
ocsenave@308 114 [list sub]
ocsenave@308 115 (loop [n 0 a list]
ocsenave@308 116 (cond
ocsenave@308 117 (empty? a) nil
ocsenave@308 118 (= (take (count sub) a) sub) n
ocsenave@308 119 :else (recur (inc n) (rest a)))))
ocsenave@308 120
ocsenave@308 121 (defn find-sublists
ocsenave@308 122 "Returns a vector of the occurences of sublists."
ocsenave@308 123 [list sub]
ocsenave@308 124 (let [m (find-sublist list sub)]
ocsenave@308 125 (if (nil? m) '()
ocsenave@308 126 (cons m
ocsenave@308 127 (map (partial + (inc m))
ocsenave@308 128 (find-sublists
ocsenave@308 129 (drop (inc m) list)
ocsenave@308 130 sub))))))
ocsenave@308 131
ocsenave@308 132
ocsenave@308 133
ocsenave@308 134 (defn search-memory
ocsenave@308 135 "Search for the given codes in memory, returning short snippets of
ocsenave@308 136 text around the results."
ocsenave@308 137 ([codes k]
ocsenave@308 138 (search-memory com.aurellem.gb.gb-driver/original-rom codes k))
ocsenave@308 139 ([array codes k]
ocsenave@308 140 (map
ocsenave@308 141 (fn [n]
ocsenave@308 142 [(hex n)
ocsenave@310 143 (take k (drop n array))])
ocsenave@308 144
ocsenave@308 145 (find-sublists
ocsenave@310 146 array
ocsenave@308 147 codes))))
ocsenave@308 148
ocsenave@308 149 (defn spelling-bee
ocsenave@308 150 "Search for the given string in ROM, returning short snippets of
ocsenave@308 151 text around the results."
ocsenave@308 152 ([str k]
ocsenave@308 153 (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))
ocsenave@308 154 ([rom str k]
ocsenave@308 155 (map
ocsenave@308 156 (fn [[address snip]]
ocsenave@308 157 [address (character-codes->str snip)])
ocsenave@308 158 (search-memory rom (str->character-codes str) k))))
ocsenave@308 159
ocsenave@308 160
ocsenave@308 161
ocsenave@308 162
ocsenave@308 163
ocsenave@308 164
ocsenave@308 165 (defn rewrite-memory
ocsenave@308 166 "Alter the vector of memory. Treats strings as lists of character
ocsenave@308 167 ops."
ocsenave@308 168 ([mem start strs-or-ops]
ocsenave@308 169 (let [x (first strs-or-ops)]
ocsenave@308 170 (cond (empty? strs-or-ops) mem
ocsenave@308 171 (string? x)
ocsenave@308 172
ocsenave@308 173 (recur mem start
ocsenave@308 174 (concat
ocsenave@308 175 (str->character-codes x)
ocsenave@308 176 (rest strs-or-ops)))
ocsenave@308 177 :else
ocsenave@308 178 (recur
ocsenave@308 179 (assoc mem start x)
ocsenave@308 180 (inc start)
ocsenave@308 181 (rest strs-or-ops))))))
ocsenave@308 182
ocsenave@308 183
ocsenave@308 184 (defn rewrite-rom
ocsenave@308 185 "Alter the rom at the given location. Takes a list of
ocsenave@308 186 various strings/bytes as data."
ocsenave@308 187 [start strs-or-bytes]
ocsenave@308 188 ((partial rewrite-memory (vec (rom(root))))
ocsenave@308 189 start strs-or-bytes))
ocsenave@308 190
ocsenave@308 191 (defn restore-rom! [] (write-rom! original-rom))
ocsenave@308 192