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 (defn view-register [state name reg-fn]

    68   (println (format "%s : 0x%02X" name (reg-fn state)))

    69   state)

    70 

    71 (defn A [state]

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

    73 

    74 (defn view-memory [state mem]

    75   (println (format "mem 0x%04X = 0x%02X" mem (aget (memory state) mem)))

    76   state)

    77 

    78 (defn read-buttons []

    79   (let [button-pressed (tick (step (mid-game) [:d]))]

    80     (-> button-pressed

    81         (IE! 0)

    82         (inject-item-assembly

    83          (concat

    84           ;; write 00010000 to 0xFF00 to select joypad

    85           [0x18   ;D31D                 ; jump over          

    86            0x01   ;D31E                 ; the next 8 bits

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

    88            0x00   ;D320                 ; take a break

    89            0xFA   ;D321                 ; put DC15 into A

    90            0x1F   ;D322      --]       

    91            0xD3   ;D323      --]  DC1F  ; data section

    92            0x01   ;D324                 ; load 0xFF00 into BC

    93            0x00   ;D325

    94            0xFF   ;D326

    95            0x02   ;D327                 ; load (DC1F) into FF00

    96                                         ; to select directional

    97                                         ; buttons

    98 

    99            ]

   100 

   101           []))

   102         (info)

   103         (tick)  ;; skip over data section

   104         (info)  

   105         (tick)  ;; no-op

   106         (info)

   107         (view-register "Register A" A)

   108         (tick)  ;; load-data into A

   109         (view-register "Register A" A)

   110         (info)

   111         (view-register "Register BC" BC)

   112         (tick) ;; load A into 0xFF00

   113         (view-register "Register BC" BC)

   114         )))

   115           

   116          

   117 (defn trace [state]

   118   (loop [program-counters []

   119          opcodes []]

   120     (let [frame-boundary?

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

   122       (println (count opcodes))

   123       (if frame-boundary?

   124         [program-counters opcodes]

   125         (recur

   126          (conj program-counters

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

   128          (conj opcodes

   129                (aget (memory @current-state)

   130                      (PC @current-state))))))))

   131         

   132   

   133 (defn good-trace []

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

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

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

   137       (info) (tick) (info) (tick) (info)))
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 15 Mar 2012 03:24:05 -0500
parents	3a60bb14a64a
children	d3c0b990e163