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-down-button []

    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                 ;D31F

    86          (Integer/parseInt "00100000" 2) ; data section 

    87          

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

    89          0x1F   ;D321      -->       

    90          0xD3   ;D322      -->  D31F     

    91 

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

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

    94          0xFF   ;D325      -->  FF00     

    95          

    96          0x18   ;D326                    ; this is the place where

    97          0x01   ;D327                    ; we will store whether

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

    99 

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

   101          0x00   ;D32A                   

   102          0xFF   ;D32B

   103 

   104          0xCB   ;D32C                    ; Test whether "down"

   105          0x5F   ;D32D                    ; is pressed.

   106 

   107          0x28   ;D32E                    ; if down is pressed,

   108          0x03   ;D32F                    ; skip the next section 

   109                                          ; of code.

   110          ;; down-is-not-pressed

   111          0xC3   ;D330

   112          0x1D   ;D331                    ; return to beginning

   113          0xD3   ;D332

   114          

   115          ;; down-is-pressed 

   116          0xEA   ;D334                    ; write A to D328 if 

   117          0x28   ;D335                    ; "down" was pressed

   118          0xD3   ;D336

   119 

   120          0xC3   ;D330

   121          0x1D   ;D331                    ; return to beginning

   122          0xD3   ;D332

   123          ]

   124         

   125         []))))

   126 

   127 

   128 ;; specs for main bootstrap program

   129 ;; starts in "mode-select" mode

   130 ;;   Each button press takes place in a single frame.

   131 ;;   mode-select-mode takes one of the main buttons

   132 ;;   which selects one of up to eight modes

   133 ;;   mode 1 activated by the "A" button

   134 ;;   the next two button presses indicates the start

   135 ;;   memory location which to which the bootstrap

   136 ;;   program will write.

   137 ;;   This is done by using each of the eight buttons to

   138 ;;   spell out an 8 bit number.  The order of buttons is

   139 ;;   ["A" "B" "start" "select" "up" "right" "down" "left"],

   140 ;;   [:a :start :l]  -->  10100001

   141 

   142 ;;   the next button press determines how many bytes are to be

   143 ;;   written, starting at the start position.

   144 

   145 ;;   then, the actual bytes are entered and are written to the

   146 ;;   start address in sequence.

   147 

   148 

   149 (defn count-frames []

   150   (-> (tick (mid-game))

   151       (IE! 0) ; disable interrupts

   152       (inject-item-assembly

   153        ;; write 00010000 to 0xFF00 to select joypad

   154        [0x18   ;D31D                    ; jump over          

   155         0x02   ;D31E                    ; the next 2 bytes

   156         0x00   ;D31F                    ; frame-count

   157         0x00   ;D320                    ; v-blank-prev

   158         

   159         0xFA   ;D321

   160         0x41   ;D322                    ; load (FF41) into A

   161         0xFF   ;D323                    ; this contains mode flags

   162 

   163 

   164         

   165         ;; if we're in v-blank, the bit-1 is 0

   166         ;; and bit-2 is 1  Otherwise, it is not v-blank.

   167         0xCB   ;D324                     ; test bit-1 of A

   168         0x4F   ;D325                         

   169 

   170         0xC2   ;D326                     ; if bit-1 is not 0

   171         0x43   ;D327                     ; GOTO not-v-blank

   172         0xD3   ;D328

   173         

   174         0xCB   ;D329                     ; test bit-0 of A 

   175         0x47   ;D32A

   176 

   177         0xCA   ;D32B                     ; if bit-0 is not 1

   178         0x43   ;D32C                     ; GOTO not-v-blank

   179         0xD3   ;D32D

   180         

   181         ;; in v-blank mode

   182 

   183            ;; if v-blank-prev was 0,

   184            ;; increment frame-count

   185 

   186         0xFA   ;D32E                    ; load v-blank-prev to A

   187         0x20   ;D32F

   188         0xD3   ;D330

   189         

   190         0xCB   ;D331

   191         0x47   ;D332                    ; test bit-0 of A 

   192 

   193         0x20   ;D333                    ; skip next section

   194         0x07   ;D334                    ; if v-blank-prev was not zero 

   195         

   196            ;; v-blank was 0, increment frame-count

   197         0xFA   ;D335                    ; load frame-count into A

   198         0x1F   ;D336

   199         0xD3   ;D337                   

   200 

   201         0x3C   ;D338                    ; inc A

   202 

   203         0xEA   ;D339                    ; load A into frame-count

   204         0x1F   ;D33A

   205         0xD3   ;D33B

   206 

   207            ;; set v-blank? to 1

   208         0x3E   ;D33C                    ; load 1 into A

   209         0x01   ;D33D                    

   210 

   211         0xEA   ;D33E                    ; load A into v-blank-prev

   212         0x20   ;D33F

   213         0xD3   ;D340

   214 

   215         0x18   ;D341                    ; skip not-in-v-blank section

   216         0x05   ;D342

   217 

   218         ;; not in v-blank mode

   219            ;; set b-blank? to 0

   220         0x3E   ;D343                    ; load 0 into A        

   221         0x00   ;D344

   222 

   223         0xEA   ;D345                    ; load A into v-blank-prev

   224         0x20   ;D346

   225         0xD3   ;D347

   226         

   227 

   228         0xC3   ;D348                   ; return to beginning

   229         0x1D   ;D349

   230         0xD3   ;D34A

   231  

   232         

   233         

   234         ])))

   235 

   236 

   237 

   238 

   239 (defn run-a-bit []

   240   (-> (read-down-button)

   241       (info)

   242       (tick)  ;; skip over data section

   243       (info)  

   244       (view-register "Register A" A)

   245       (tick)  ;; load-data into A

   246       (view-register "Register A" A)

   247       (info)

   248       (view-memory 0xFF00)

   249       (tick) ;; load A into 0xFF00

   250       (view-memory 0xFF00)

   251       (info)

   252       (tick)

   253       (info)

   254       (tick)

   255       (info)

   256       (tick)

   257       (info)

   258       (tick)

   259       (info)

   260       (tick)

   261       (info)

   262       (tick)

   263       (print-inventory)))

   264 

   265 (defn test-read-pad []

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

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

   268   

   269 (defn trace [state]

   270   (loop [program-counters []

   271          opcodes []]

   272     (let [frame-boundary?

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

   274       (println (count opcodes))

   275       (if frame-boundary?

   276         [program-counters opcodes]

   277         (recur

   278          (conj program-counters

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

   280          (conj opcodes

   281                (aget (memory @current-state)

   282                      (PC @current-state))))))))

   283   

   284 (defn good-trace []

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

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

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

   288       (info) (tick) (info) (tick) (info)))
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 16 Mar 2012 00:43:28 -0500
parents	6fe33bb5ea22
children	a454730d92dd