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 

   129 

   130 (defn count-frames []

   131   (-> (tick (mid-game))

   132       (IE! 0) ; disable interrupts

   133       (inject-item-assembly

   134        [0x18   ;D31D                    ; jump over          

   135         0x02   ;D31E                    ; the next 2 bytes

   136         0x00   ;D31F                    ; frame-count

   137         0x00   ;D320                    ; v-blank-prev

   138         

   139         0xFA   ;D321

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

   141         0xFF   ;D323                    ; this contains mode flags

   142         

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

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

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

   146         0x4F   ;D325                         

   147 

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

   149         0x44   ;D327                     ; GOTO not-v-blank

   150         0xD3   ;D328

   151         

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

   153         0x47   ;D32A

   154 

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

   156         0x44   ;D32C                     ; GOTO not-v-blank

   157         0xD3   ;D32D

   158         

   159         ;;; in v-blank mode

   160 

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

   162            ;; increment frame-count

   163 

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

   165         0x20   ;D32F

   166         0xD3   ;D330

   167         

   168         0xCB   ;D331

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

   170 

   171         0x20   ;D333                    ; skip next section

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

   173         

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

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

   176         0x1F   ;D336

   177         0xD3   ;D337                   

   178 

   179         0x3C   ;D338                    ; inc A

   180 

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

   182         0x1F   ;D33A

   183         0xD3   ;D33B

   184 

   185            ;; set v-blank-prev to 1

   186         0x3E   ;D33C                    ; load 1 into A

   187         0x01   ;D33D                    

   188 

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

   190         0x20   ;D33F

   191         0xD3   ;D340

   192 

   193         0xC3   ;D341                   ; return to beginning

   194         0x1D   ;D342

   195         0xD3   ;D343

   196 

   197         ;;; not in v-blank mode

   198            ;; set v-blank-prev to 0

   199         0x3E   ;D344                    ; load 0 into A        

   200         0x00   ;D345

   201 

   202         0xEA   ;D346                    ; load A into v-blank-prev

   203         0x20   ;D347

   204         0xD3   ;D348

   205 

   206         0xC3   ;D349                   ; return to beginning

   207         0x1D   ;D34A

   208         0xD3   ;D34B

   209         

   210         ])))

   211 

   212 (defn step-count-frames []

   213   (-> (read-down-button)

   214       (info)

   215       (tick)  ;; skip over data section

   216       (info)  

   217       (view-register "Register A" A)

   218       (tick)  ;; load-data into A

   219       (view-register "Register A" A)

   220       (info)

   221       (view-memory 0xFF00)

   222       (tick) ;; load A into 0xFF00

   223       (view-memory 0xFF00)

   224       (info)

   225       (tick)

   226       (info)

   227       (tick)

   228       (info)

   229       (tick)

   230       (info)

   231       (tick)

   232       (info)

   233       (tick)

   234       (info)

   235       (tick)

   236       (print-inventory)))

   237 

   238 ;;(defn test-read-down []

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

   240 ;;     (view-memory (step (step (read-buttons))) 0xD328)))

   241 

   242 (defn test-count-frames []

   243   (= 255 (aget (memory ((apply comp (repeat 255 step))

   244                         (count-frames)))

   245                0xD31F)))

   246 

   247    

   248 (defn trace [state]

   249   (loop [program-counters []

   250          opcodes []]

   251     (let [frame-boundary?

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

   253       (println (count opcodes))

   254       (if frame-boundary?

   255         [program-counters opcodes]

   256         (recur

   257          (conj program-counters

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

   259          (conj opcodes

   260                (aget (memory @current-state)

   261                      (PC @current-state))))))))

   262   

   263 (defn good-trace []

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

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

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

   267       (info) (tick) (info) (tick) (info)))

   268 

   269 ;; specs for main bootstrap program

   270 ;; starts in "mode-select" mode

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

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

   273 ;;   which selects one of up to eight modes

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

   275 ;;   the next two button presses indicates the start

   276 ;;   memory location which to which the bootstrap

   277 ;;   program will write.

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

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

   280 ;;   [:d :u :l :r :start :select :b :a]

   281 ;;   [:a :start :l]  -->  00101001

   282 

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

   284 ;;   written, starting at the start position.

   285 

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

   287 ;;   start address in sequence.

   288 

   289 

   290 

   291 (defn input-number []

   292   (-> (tick (mid-game))

   293       (IE! 0) ; disable interrupts

   294       (inject-item-assembly

   295        [0x18   ;D31D                    ; jump over          

   296         0x02   ;D31E                    ; the next 2 bytes

   297         0x00   ;D31F                    ; frame-count

   298         0x00   ;D320                    ; v-blank-prev

   299         

   300         0xFA   ;D321

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

   302         0xFF   ;D323                    ; this contains mode flags

   303         

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

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

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

   307         0x4F   ;D325                         

   308 

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

   310         0x44   ;D327                     ; GOTO not-v-blank

   311         0xD3   ;D328

   312         

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

   314         0x47   ;D32A

   315 

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

   317         0x44   ;D32C                     ; GOTO not-v-blank

   318         0xD3   ;D32D

   319         

   320         ;;; in v-blank mode

   321 

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

   323            ;; increment frame-count

   324 

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

   326         0x20   ;D32F

   327         0xD3   ;D330

   328         

   329         0xCB   ;D331

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

   331 

   332         0x20   ;D333                    ; skip next section

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

   334         

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

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

   337         0x1F   ;D336

   338         0xD3   ;D337                   

   339 

   340         0x3C   ;D338                    ; inc A

   341 

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

   343         0x1F   ;D33A

   344         0xD3   ;D33B

   345 

   346            ;; set v-blank-prev to 1

   347         0x3E   ;D33C                    ; load 1 into A

   348         0x01   ;D33D                    

   349 

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

   351         0x20   ;D33F

   352         0xD3   ;D340

   353 

   354         0xC3   ;D341                   ; GOTO input handling code

   355         0x4E   ;D342

   356         0xD3   ;D343

   357 

   358         ;;; not in v-blank mode

   359            ;; set v-blank-prev to 0

   360         0x3E   ;D344                    ; load 0 into A        

   361         0x00   ;D345

   362 

   363         0xEA   ;D346                    ; load A into v-blank-prev

   364         0x20   ;D347

   365         0xD3   ;D348

   366 

   367         0xC3   ;D349                   ; return to beginning

   368         0x1D   ;D34A

   369         0xD3   ;D34B

   370 

   371         0x00   ;D34C                   ; these are here 

   372         0x00   ;D34D                   ; for glue

   373        

   374         

   375         ;;; calculate input number based on button presses

   376         0x18   ;D34E                    ;  skip next 3 bytes

   377         0x03   ;D34F

   378                ;D350

   379         (Integer/parseInt "00100000" 2) ;  select directional pad

   380                ;D351

   381         (Integer/parseInt "00010000" 2) ;  select buttons

   382         0x00   ;D352                    ;  input-number

   383 

   384         ;; select directional pad, store low bits in B

   385         

   386         0xFA   ;D353                    ; load (D350) into A

   387         0x50   ;D354      -->       

   388         0xD3   ;D355      -->  D31F     

   389         

   390         0xEA   ;D356                    ; load (A), which is 

   391         0x00   ;D357      -->           ; 00010000, into FF00

   392         0xFF   ;D358      -->  FF00     

   393 

   394         0x06   ;D359

   395                ;D35A

   396         (Integer/parseInt "11110000" 2) ; "11110000" -> B 

   397         0xFA   ;D35B                    ; (FF00) -> A

   398         0x00   ;D35C                   

   399         0xFF   ;D35D

   400 

   401         0xCB   ;D35E                    ; swap nybbles on A

   402         0x37   ;D35F

   403         0xA0   ;D360                    ; (AND A B) -> A

   404         0x47   ;D361                    ; A -> B

   405 

   406         ;; select buttons store bottom bits in C

   407         

   408         0xFA   ;                        ; load (D351) into A

   409         0x51   ;          -->       

   410         0xD3   ;          -->  D31F     

   411         

   412         0xEA   ;                        ; load (A), which is 

   413         0x00   ;          -->           ; 00001000, into FF00

   414         0xFF   ;          -->  FF00     

   415 

   416         0x0E   ;    

   417         (Integer/parseInt "00001111" 2) ; "00001111" -> C 

   418 

   419         0xFA   ;                        ; (FF00) -> A

   420         0x00   ;                       

   421         0xFF   ;    

   422        

   423         0xA1   ;                        ; (AND A C) -> A

   424         0x4F   ;                        ; A -> C

   425 

   426 

   427         ;; combine the B and C registers into the input number

   428         0x79   ;                        ; C -> A

   429         0xB0   ;                        ; (OR A B) -> A

   430         0x2F   ;                        ; negate A

   431 

   432         0xEA   ;                        ; store A into input-number

   433         0x52   ;

   434         0xD3   ;

   435 

   436         0xC3   ;                        ; return to beginning

   437         0x1D   ;    

   438         0xD3   ;    

   439         ])))

   440 

   441 

   442 

   443 

   444 (defn print-listing [state begin end]

   445   (dorun (map 

   446           (fn [opcode line]

   447             (println (format "0x%04X:  0x%02X" line opcode)))

   448           (subvec  (vec (memory state)) begin end)

   449           (range begin end))))

   450   

   451                     

   452 

   453 

   454 

   455 

   456 

   457
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 16 Mar 2012 17:03:05 -0500
parents	39fb0cbab25e
children	bcb5c41626b4