ocsenave@308: (ns com.aurellem.gb.mem-util ocsenave@308: (:use (com.aurellem.gb assembly characters gb-driver)) ocsenave@308: (:import [com.aurellem.gb.gb_driver SaveState])) ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: (def hex-pc (comp hex PC)) ocsenave@308: ocsenave@308: (defn nstep [state n] ocsenave@308: (if (zero? n) state ocsenave@308: (recur (step state) (dec n)))) ocsenave@308: ocsenave@308: ocsenave@308: (defn view-memory* ocsenave@308: "View a region of indexable memory in the given state." ocsenave@308: [state start length] ocsenave@308: ((comp vec map) ocsenave@308: #((comp aget) (memory state) %) ocsenave@308: (range start (+ start length)))) ocsenave@308: ocsenave@308: ocsenave@308: (defn pc-trail ocsenave@308: "Track the PC for a number of ticks." ocsenave@308: [state ticks] ocsenave@308: (tick state) ocsenave@308: (set-state! state) ocsenave@308: (loop [pcs [(PC)] ] ocsenave@308: (if (> (count pcs) ticks) pcs ocsenave@308: (do ocsenave@308: (com.aurellem.gb.Gb/tick) ocsenave@308: (recur (conj pcs (PC))))))) ocsenave@308: ocsenave@308: ocsenave@308: (defn get-memory [state n] ocsenave@308: (aget (memory state) n)) ocsenave@308: ocsenave@308: (defn first-change ocsenave@308: "Watch the current memory location as it ticks, ocsenave@308: return the first state that differs at location mem." ocsenave@308: [state n] ocsenave@308: (tick state) ocsenave@308: (set-state! state) ocsenave@308: (let [init (aget (memory state) n)] ocsenave@308: (loop [] ocsenave@308: (if (= (aget (memory) n) init) ocsenave@308: (do ocsenave@308: (com.aurellem.gb.Gb/tick) ocsenave@308: (recur)))) ocsenave@308: (update-state))) ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: (defn differences ocsenave@308: "Return the differences between the two lists as triples [index ocsenave@308: (list-1 index) (list-2 index)]." ocsenave@308: [list-1 list-2] ocsenave@308: (remove ocsenave@308: (fn [[a b c]] (= b c)) ocsenave@308: (map vector ocsenave@308: (range) ocsenave@308: list-1 ocsenave@308: list-2))) ocsenave@308: ocsenave@308: (defn pc-diff ocsenave@308: "Return the differences between the program counter evolution ocsenave@308: between the two states (measured for 10000 ticks)." ocsenave@308: [state-1 state-2] ocsenave@308: (differences (map hex (pc-trail state-1 10000)) ocsenave@308: (map hex (pc-trail state-2 10000)))) ocsenave@308: ocsenave@308: ocsenave@308: (defn memory-diff [state-1 state-2] ocsenave@308: (remove ocsenave@308: (fn[[a b c]] (= b c)) ocsenave@308: (map (comp vec (partial map hex) list) ocsenave@308: (range) ocsenave@308: (vec (memory state-1)) ocsenave@308: (vec (memory state-2))) ocsenave@308: )) ocsenave@308: ocsenave@308: ocsenave@308: (defn spell-array ocsenave@308: "Interpret the array as a string of printable Pokemon-text characters." ocsenave@308: [array start n] ocsenave@308: (character-codes->str ocsenave@308: (take n (drop start ocsenave@308: (vec array))))) ocsenave@308: ocsenave@308: (defn spell-memory ocsenave@308: "Interpret the indexable memory of the state as a string of printable ocsenave@308: Pokemon-text characters. If no state is given, uses current-state." ocsenave@308: ([state mem n] ocsenave@308: (spell-array (memory state) mem n)) ocsenave@308: ([mem n] (spell-array @current-state mem n))) ocsenave@308: ocsenave@308: ocsenave@308: (defn sublist ocsenave@308: "Unshifts the list until the sublist is at the start." ocsenave@308: [list sub] ocsenave@308: (cond ocsenave@308: (empty? sub) list ocsenave@308: (empty? list) nil ocsenave@308: (= (take (count sub) list) sub) list ocsenave@308: :else (recur (rest list) sub))) ocsenave@308: ocsenave@308: (defn find-sublist ocsenave@308: "Returns the position of the first occurence of sublist." ocsenave@308: [list sub] ocsenave@308: (loop [n 0 a list] ocsenave@308: (cond ocsenave@308: (empty? a) nil ocsenave@308: (= (take (count sub) a) sub) n ocsenave@308: :else (recur (inc n) (rest a))))) ocsenave@308: ocsenave@308: (defn find-sublists ocsenave@308: "Returns a vector of the occurences of sublists." ocsenave@308: [list sub] ocsenave@308: (let [m (find-sublist list sub)] ocsenave@308: (if (nil? m) '() ocsenave@308: (cons m ocsenave@308: (map (partial + (inc m)) ocsenave@308: (find-sublists ocsenave@308: (drop (inc m) list) ocsenave@308: sub)))))) ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: (defn search-memory ocsenave@308: "Search for the given codes in memory, returning short snippets of ocsenave@308: text around the results." ocsenave@308: ([codes k] ocsenave@308: (search-memory com.aurellem.gb.gb-driver/original-rom codes k)) ocsenave@308: ([array codes k] ocsenave@308: (map ocsenave@308: (fn [n] ocsenave@308: [(hex n) ocsenave@310: (take k (drop n array))]) ocsenave@308: ocsenave@308: (find-sublists ocsenave@310: array ocsenave@308: codes)))) ocsenave@308: ocsenave@308: (defn spelling-bee ocsenave@308: "Search for the given string in ROM, returning short snippets of ocsenave@308: text around the results." ocsenave@308: ([str k] ocsenave@308: (spelling-bee com.aurellem.gb.gb-driver/original-rom str k)) ocsenave@308: ([rom str k] ocsenave@308: (map ocsenave@308: (fn [[address snip]] ocsenave@308: [address (character-codes->str snip)]) ocsenave@308: (search-memory rom (str->character-codes str) k)))) ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: ocsenave@308: (defn rewrite-memory ocsenave@308: "Alter the vector of memory. Treats strings as lists of character ocsenave@308: ops." ocsenave@308: ([mem start strs-or-ops] ocsenave@308: (let [x (first strs-or-ops)] ocsenave@308: (cond (empty? strs-or-ops) mem ocsenave@308: (string? x) ocsenave@308: ocsenave@308: (recur mem start ocsenave@308: (concat ocsenave@308: (str->character-codes x) ocsenave@308: (rest strs-or-ops))) ocsenave@308: :else ocsenave@308: (recur ocsenave@308: (assoc mem start x) ocsenave@308: (inc start) ocsenave@308: (rest strs-or-ops)))))) ocsenave@308: ocsenave@308: ocsenave@308: (defn rewrite-rom ocsenave@308: "Alter the rom at the given location. Takes a list of ocsenave@308: various strings/bytes as data." ocsenave@308: [start strs-or-bytes] ocsenave@308: ((partial rewrite-memory (vec (rom(root)))) ocsenave@308: start strs-or-bytes)) ocsenave@308: ocsenave@308: (defn restore-rom! [] (write-rom! original-rom)) ocsenave@308: ocsenave@346: ocsenave@346: (defn endian-flip ocsenave@346: "Flip the bytes of the two-byte number." ocsenave@346: [n] ocsenave@346: (assert (< n 0xFFFF)) ocsenave@346: (+ (* 0x100 (rem n 0x100)) ocsenave@346: (int (/ n 0x100)))) ocsenave@346: ocsenave@346: ocsenave@346: (defn offset->ptr ocsenave@346: "Convert an offset into a little-endian pointer." ocsenave@346: [n] ocsenave@346: (-> ocsenave@346: n ocsenave@346: (rem 0x10000) ;; take last four bytes ocsenave@346: (rem 0x4000) ;; get relative offset from the start of the bank ocsenave@346: (+ 0x4000) ocsenave@346: endian-flip)) ocsenave@346: ocsenave@346: (defn offset->bank ocsenave@346: "Get the bank of the offset." ocsenave@346: [n] ocsenave@346: (int (/ n 0x4000))) ocsenave@346: ocsenave@346: (defn ptr->offset ocsenave@346: "Convert a two-byte little-endian pointer into an offset." ocsenave@346: [bank ptr] ocsenave@346: (-> ocsenave@346: ptr ocsenave@346: endian-flip ocsenave@346: (- 0x4000) ocsenave@346: (+ (* 0x4000 bank)) ocsenave@346: )) ocsenave@346: ocsenave@346: (defn same-bank-offset ocsenave@346: "Convert a ptr into an absolute offset by using the bank of the reference." ocsenave@346: [reference ptr] ocsenave@346: (ptr->offset ocsenave@346: (offset->bank reference) ocsenave@346: ptr))