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 

    24 (defn inject-item-assembly

    25   ([^SaveState state assembly-code]

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

    27                       (registers state)

    28                       assembly-code))

    29   ([assembly-code]

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

    31 

    32 (defn info

    33   ([^SaveState state]

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

    35      (println "Instruction:"

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

    37      state))    

    38 

    39 (defn print-interrupt

    40   [^SaveState state]

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

    42   state)

    43 

    44 (defn run-assembly

    45   ([info-fn assembly n]

    46      (let [final-state

    47            (reduce (fn [state _]

    48                      (tick (info-fn state)))

    49                    (inject-item-assembly

    50                      (mid-game) assembly)

    51                    (range n))]

    52        final-state))

    53   ([assembly n]

    54      (run-assembly info assembly n)))

    55 

    56 (def buttons-port 0xFF00)

    57 

    58 (defn A [state]

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

    60 

    61 (defn binary-str [num]

    62   (format "%08d"

    63           (Integer/parseInt

    64            (Integer/toBinaryString num) 10)))

    65 

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

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

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

    69   state)

    70 

    71 

    72 (defn view-memory [state mem]

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

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

    75   state)

    76 

    77 (defn read-buttons []

    78   (-> (tick (mid-game))

    79       (IE! 0) ; disable interrupts

    80       (inject-item-assembly

    81        (concat

    82         ;; write 00010000 to 0xFF00 to select joypad

    83         [0x18   ;D31D                    ; jump over          

    84          0x01   ;D31E                    ; the next 8 bits

    85          (Integer/parseInt "00100000" 2) ;D31F data section 

    86          

    87          0xFA   ;D320                    ; load (D31F) into A

    88          0x1F   ;D321      -->       

    89          0xD3   ;D322      -->  D31F     

    90 

    91          0xEA   ;D323                    ; load (A), which is 

    92          0x00   ;D324      -->           ; 00010000, into FF00

    93          0xFF   ;D325      -->  FF00     

    94          

    95          0x18   ;D326                    ; this is the place where

    96          0x01   ;D327                    ; we will store whether

    97          0x00   ;D328                    ; "down" is pressed.

    98 

    99          0xFA   ;D329                    ; (FF00) -> A

   100          0x00   ;D32A                   

   101          0xFF   ;D32B

   102 

   103          0xCB   ;D32C                    ; Test whether "down"

   104          0x5F   ;D32D                    ; is pressed.

   105 

   106          0x28   ;D32E                    ; if down is pressed,

   107          0x03   ;D32F                    ; skip the next section 

   108                                          ; of code.

   109          ;; down-is-not-pressed

   110          0xC3   ;D330

   111          0x1D   ;D331                    ; return to beginning

   112          0xD3   ;D332

   113          

   114          ;; down-is-pressed 

   115          0xEA   ;D334                    ; write A to D328 if 

   116          0x28   ;D335                    ; "down" was pressed

   117          0xD3   ;D336

   118 

   119          0xC3   ;D330

   120          0x1D   ;D331                    ; return to beginning

   121          0xD3   ;D332

   122          ]

   123         

   124         []))))

   125 

   126 (defn run-a-bit []

   127   (-> (read-buttons)

   128       (info)

   129       (tick)  ;; skip over data section

   130       (info)  

   131       (view-register "Register A" A)

   132       (tick)  ;; load-data into A

   133       (view-register "Register A" A)

   134       (info)

   135       (view-memory 0xFF00)

   136       (tick) ;; load A into 0xFF00

   137       (view-memory 0xFF00)

   138       (info)

   139       (tick)

   140       (info)

   141       (tick)

   142       (info)

   143       (tick)

   144       (info)

   145       (tick)

   146       (info)

   147       (tick)

   148       (info)

   149       (tick)

   150       (print-inventory)))

   151 

   152 (defn test-read-pad []

   153   (= (view-memory (step (step (read-buttons) [:d])) 0xD328)

   154      (view-memory (step (step (read-buttons))) 0xD328)))

   155   

   156 (defn trace [state]

   157   (loop [program-counters []

   158          opcodes []]

   159     (let [frame-boundary?

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

   161       (println (count opcodes))

   162       (if frame-boundary?

   163         [program-counters opcodes]

   164         (recur

   165          (conj program-counters

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

   167          (conj opcodes

   168                (aget (memory @current-state)

   169                      (PC @current-state))))))))

   170   

   171 (defn good-trace []

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

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

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

   175       (info) (tick) (info) (tick) (info)))
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 15 Mar 2012 17:29:49 -0500
parents	8be7ce890184
children	0831da75d2c5