Mercurial > vba-clojure

     1 (ns com.aurellem.assembly

     2   (:use (com.aurellem gb-driver vbm title items))

     3   (:import [com.aurellem.gb_driver SaveState]))

     4 

     5 (defn mid-game []

     6   (read-state "mid-game"))

     7 

     8 (defn inject-assembly

     9   ([^SaveState state

    10    program-counter registers

    11    assembly-code]

    12   (let [scratch-memory (memory state)]

    13     ;; inject assembly code

    14     (dorun (map (fn [index val]

    15                   (aset scratch-memory index val))

    16                 (range program-counter

    17                        (+ program-counter (count assembly-code)))

    18                 assembly-code))

    19     (-> state

    20         (write-memory! scratch-memory)

    21         (write-registers! registers)

    22         (PC! program-counter))))

    23   ;;([program-counter]

    24   ;;   (fn [^SaveState state registers assembly-code]

    25   ;;     (inject-assembly state program-counter registers assembly-code)))

    26   )

    27 

    28 

    29 ;;(def inject-assembly-item

    30 ;;  (inject-assembly (inc item-list-start)))

    31 

    32 (defn inject-item-assembly

    33   ([^SaveState state assembly-code]

    34      (inject-assembly state (inc item-list-start)

    35                       (registers state)

    36                       assembly-code))

    37   ([assembly-code]

    38      (inject-item-assembly @current-state assembly-code)))

    39 

    40 (defn info

    41   ([^SaveState state]

    42      (println (format "PC: 0x%04X" (PC state)))

    43      (println "Instruction:"

    44               (format "0x%02X" (aget (memory state) (PC state))))

    45      state))    

    46 

    47 (defn print-interrupt

    48   [^SaveState state]

    49   (println (format "IE: %d" (IE state)))

    50   state)

    51 

    52 (defn run-assembly

    53   ([info-fn assembly n]

    54      (let [final-state

    55            (reduce (fn [state _]

    56                      (tick (info-fn state)))

    57                    (inject-item-assembly

    58                      (mid-game) assembly)

    59                    (range n))]

    60        final-state))

    61   ([assembly n]

    62      (run-assembly info assembly n)))

    63 

    64 

    65 (def buttons-port 0xFF00)

    66 

    67 

    68 (defn A [state]

    69   (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))

    70 

    71 (defn binary-str [num]

    72   (format "%08d"

    73           (Integer/parseInt

    74            (Integer/toBinaryString num) 10)))

    75 

    76 (defn view-register [state name reg-fn]

    77   (println (format "%s: %s" name

    78                    (binary-str (reg-fn state))))

    79   state)

    80 

    81 

    82 (defn view-memory [state mem]

    83   (println (format "mem 0x%04X = %s" mem

    84                    (binary-str (aget (memory state) mem))))

    85   state)

    86 

    87 (defn read-buttons []

    88   

    89   (-> (tick (mid-game))

    90       (IE! 0) ; disable interrupts

    91       (inject-item-assembly

    92        (concat

    93         ;; write 00010000 to 0xFF00 to select joypad

    94         [0x18   ;D31D                    ; jump over          

    95          0x01   ;D31E                    ; the next 8 bits

    96          (Integer/parseInt "00010000" 2) ;D31F data section 

    97          0x00   ;D320                    ; take a break

    98 

    99          0xFA   ;D321                    ; put DC1F into A

   100          0x1F   ;D322      -->       

   101          0xD3   ;D323      -->  D31F     

   102 

   103          0xEA   ;D324                    ; load (A), which is 

   104          0x00   ;D325      -->           ; 00010000, into FF00

   105          0xFF   ;D326      -->  FF00     

   106 

   107          0x00

   108          ]

   109         

   110         []))

   111       (info)

   112       (tick)  ;; skip over data section

   113       (info)  

   114       (tick)  ;; no-op

   115       (info)

   116       (view-register "Register A" A)

   117       (tick)  ;; load-data into A

   118       (view-register "Register A" A)

   119       (info)

   120       (view-memory 0xFF00)

   121       (tick) ;; load A into 0xFF00

   122       (view-memory 0xFF00)

   123       ))

   124           

   125          

   126 (defn trace [state]

   127   (loop [program-counters []

   128          opcodes []]

   129     (let [frame-boundary?

   130           (com.aurellem.gb.Gb/tick)]

   131       (println (count opcodes))

   132       (if frame-boundary?

   133         [program-counters opcodes]

   134         (recur

   135          (conj program-counters

   136                (first (registers @current-state)))

   137          (conj opcodes

   138                (aget (memory @current-state)

   139                      (PC @current-state))))))))

   140         

   141   

   142 (defn good-trace []

   143   (-> (mid-game) (tick) (IE! 0)

   144       (set-inv-mem [0x00 0x00 0X00 0x00])

   145       (PC! item-list-start)(print-interrupt)

   146       (info) (tick) (info) (tick) (info)))
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 15 Mar 2012 14:44:19 -0500
parents	c8b48102b17c
children	8be7ce890184