Mercurial > vba-clojure

     1 (ns com.aurellem.gb.rlm-assembly

     2   "Version of main bootstrap program that is valid output for the

     3    item-writer program."

     4   (:use (com.aurellem.gb gb-driver assembly util vbm constants))

     5   (:use (com.aurellem.run bootstrap-1))

     6   (:import [com.aurellem.gb.gb_driver SaveState]))

     7 

     8 

     9 ;; MODE-SELECT

    10 ;; SET-LENGTH

    11 ;; SET-TARGET

    12 ;; WRITE

    13 ;; JUMP

    14 

    15 ;; Specs for Main Bootstrap Program

    16 

    17 ;; Number-Input

    18 ;; Number input works using all eight buttons to

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

    20 ;;   [:d :u :l :r :start :select :b :a]  -->  11111111

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

    22 

    23 ;;; MODE-SELECT

    24 ;;   The bootstrap program starts in MODE-SELECT mode.

    25 ;;   MODE-SELECT transitions to one of three modes depending

    26 ;;   on which buttons are pressed:

    27 ;;       0   (no-buttons)  :  MODE-SELECT

    28 ;;       8   [:start]      :  WRITE-BYTES

    29 ;;    0xFF   (all-buttons) :  JUMP

    30 

    31 ;;; WRITE-BYTES

    32 

    33 ;;   WRITE-BYTES mode writes sequences of arbitray values to

    34 ;;   arbitray memory locations. It expects you to enter a

    35 ;;   header of three bytes describing what to write:

    36 

    37 ;;    Byte 0  : Number of Bytes to Write

    38 ;;    Byte 1  : Start Address High Byte

    39 ;;    Byte 1  : Start Address Low  Byte

    40 

    41 ;;   Then, you enter the number of bytes specified in Byte 0

    42 ;;   they are written to the start address in

    43 ;;   sequence. After the last byte is written control

    44 ;;   returns to MODE-SELECT mode.

    45 

    46 ;;   Example: to write the sequence [1 2 3 4] starting at

    47 ;;   address 0xC01F enter

    48 ;;    Byte 0  : 4 (will write four bytes)

    49 ;;    Byte 1  : 0xC0  (high byte of 0xC01F)

    50 ;;    Byte 2  : 0x1F  (low  byte of 0xC01F)

    51 ;;    Byte 3  : 1 (write 1 to 0xC01F)

    52 ;;    Byte 4  : 2 (write 2 to 0xC020)

    53 ;;    Byte 5  : 3 (write 3 to 0xC021)

    54 ;;    Byte 6  : 4 (write 4 to 0xC022)

    55 

    56 ;;; JUMP 

    57 ;;   JUMP mode jumps program control to any arbitray

    58 ;;   location. It expects you to enter two bytes which

    59 ;;   correspond to the high and low bytes of the memory

    60 ;;   address to which you want to jump.

    61 ;;    Byte 0  : Jump Address High Byte

    62 ;;    Byte 1  : Jump Address Low  Byte

    63 

    64 ;;   Example: to jump to address 0x1234 enter

    65 ;;    Byte 0  : 0x12 (high byte of 0x1234)

    66 ;;    Byte 1  : 0x34 (low  byte of 0x1234)

    67 

    68 

    69 (defn ->signed-8-bit [n]

    70   (if (< n 0)

    71     (+ 256 n) n))

    72 

    73 (defn frame-metronome** []

    74   (let [init [0xC5] ;; save value of BC

    75         timing-loop

    76         [0x01 ; \

    77          0x43 ;  |

    78          0xFE ;  |  load 0xFF44 into BC without repeats

    79          0x0C ;  |

    80          0x04 ; /

    81          0x0A] ;; (BC) -> A, now A = LY (vertical line coord)

    82         continue-if-144

    83         [0xFE

    84          144     ;; compare LY (in A) with 144

    85          0x20    ;; jump back to beginning if LY != 144 (not-v-blank)

    86          (->signed-8-bit

    87           (+ -4 (- (count timing-loop))))]

    88         spin-loop

    89         [0x05 ;; dec B, which is 0xFF

    90          0x20 ;; spin until B==0

    91          0xFD]]

    92     (concat init timing-loop continue-if-144 spin-loop)))

    93 

    94 (defn frame-metronome* []

    95   [0x3E   ;; smallest version, but uses repeated nybbles

    96    0x01    

    97    0xE0

    98    0xFF])

    99 

   100 

   101 (defn frame-metronome []

   102   [0x06 ;; load 0xFE into B

   103    0xFE

   104    0x04 ;; inc B, now B == FF

   105    0x3E

   106    0x01 ;; 1->A

   107    

   108    0x48 ;; B->C

   109    0x02]) ;; A->(BC) set exclusive v-blank interrupt

   110 

   111 (defn test-frame-metronome

   112   "Ensure that frame-metronome ticks exactly once every frame."

   113   ([] (test-frame-metronome 151))

   114   ([steps]

   115      (let [inc-E [0x1C 0x76 0x18 

   116                   (->signed-8-bit -4)]

   117                    

   118            program (concat (frame-metronome) inc-E)

   119            count-frames

   120            (-> (tick (mid-game))

   121                (IE! 0)

   122                (DE! 0)

   123                (set-memory-range pokemon-list-start program)

   124                (PC! pokemon-list-start))

   125            E-after-moves

   126            (E (run-moves count-frames (repeat steps [])))]

   127        ;;(println "E:" E-after-moves) 

   128        (assert (= steps E-after-moves))

   129        (println "frame-count test passed.")

   130        count-frames)))

   131 

   132 (defn read-user-input []

   133   [0xAF 0x4F 0x47 ;; 0->A; 0->C; 0->B

   134    0xC5 ;; save value of BC

   135       

   136    0x3E

   137    0x20 ; prepare to measure d-pad

   138 

   139    0x3F ; clear carry flag no-op to prevent repeated nybbles

   140    

   141    0x01 ;\

   142    0x01 ; |

   143    0xFE ; |  load 0xFF00 into BC without repeats

   144    0x04 ; |

   145    0x0D ;/

   146    

   147    0x02 

   148    0x0A ;; get D-pad info

   149    

   150    0xF5 ;; push AF

   151       

   152    0x3E

   153    0x10 ; prepare to measure buttons

   154 

   155    0x3F ;; clear carry flag no-op to prevent repeated nybbbles

   156    

   157    0x02

   158    0x0A ;; get button info

   159    

   160    0xE6 ;; select bottom bits of A

   161    0x0F

   162 

   163    0x47 ;; A->B

   164 

   165    0xF1 ;; pop AF

   166 

   167    0xE6

   168    0x0F ;; select bottom bits of A

   169 

   170    0xCB

   171    0x37 ;; swap A nybbles

   172 

   173    0xB0 ;; (or A B) -> A

   174  

   175    0x2F ;; (NOT A) -> A

   176    ])

   177 

   178 (defn test-read-user-input []

   179   (let [program

   180         (concat

   181          (frame-metronome) (read-user-input)

   182          [0x5F ;; A-> E

   183           0x76

   184           0x18

   185           (->signed-8-bit

   186            (+ (- (count (read-user-input)))

   187               (- 4)))])

   188         read-input

   189         (-> (tick (mid-game))

   190             (IE! 0)

   191             (set-memory-range pokemon-list-start program)

   192             (PC! pokemon-list-start))]

   193     (dorun

   194      (for [i (range 0x100)]

   195        (assert (= (E (step read-input (buttons i))) i))))

   196      (println "tested all inputs.")

   197     read-input))

   198 

   199 (def symbol-index

   200   (fn [symbol sequence]

   201     (count (take-while

   202             (partial not= symbol)

   203             sequence))))

   204 

   205 (defn main-bootstrap-program

   206   ([] (main-bootstrap-program pokemon-list-start))

   207   ([start-address]

   208      ;; Register Use:

   209      

   210      ;; ED non-volitale scratch

   211      

   212      ;; A  user-input

   213      ;; HL target-address

   214      ;; B  bytes-to-write

   215      ;; C  non-volatile scratch

   216 

   217      ;; Modes (with codes) are:

   218 

   219      ;; single-action-modes:

   220      ;; SET-TARGET-HIGH     0x67 ;; A->H

   221      ;; SET-TARGET-LOW      0x6F ;; A->L

   222      ;; JUMP                0xE9 ;; jump to (HL)

   223 

   224      ;; multi-action-modes

   225      ;; WRITE               0x47 ;; A->B

   226 

   227      (let [header (concat (frame-metronome) (read-user-input))

   228            

   229            input

   230            [0xC1  ;; pop BC so it's not volatile

   231 

   232             0x5F  ;; A->E

   233             0xAF  ;; test for output-mode (bytes-to-write > 0)

   234             0xB8  ;; (cp A B)

   235             0x7B  ;; E->A

   236             0x20       ;; skip to output section if

   237             :to-output ;; we're not in input mode 

   238             

   239             :to-be-executed

   240 

   241             ;; write mode to instruction-to-be-executed (pun)

   242             0xEA

   243             :to-be-executed-address

   244 

   245             ;; protection region -- do not queue this op for

   246             ;; execution if the last one was non-zero

   247             0x79 ;; C->A

   248             0xA7 ;; test A==0

   249             0x28

   250             0x04

   251             0xAF ;; put a no op (0x00) in to-be-executed

   252             0xEA ;; 

   253             :to-be-executed-address

   254             

   255             0x7B ;; E->A

   256             0x4F ;; A->C now C stores previous instruction

   257             0x18           ;; return

   258             :to-halt]

   259            

   260            output

   261            [:output-start ;; just a label

   262             0x3F ;; ;; prevent repeated nybbles

   263             0x54 ;;

   264             0x5D ;; HL->DE  \

   265                  ;;          | This mess is here to do

   266             0x12 ;; A->(DE)  | 0x22 (LDI (HL), A) without

   267                  ;;         /  any repeating nybbles

   268             0x05 ;; DEC bytes-to-write (B)

   269 

   270             0x23 ;; inc HL 

   271             

   272             0x76 ;; HALT, peasant!

   273             0x18

   274             :to-beginning] 

   275 

   276            symbols

   277            {:to-be-executed-address

   278             (reverse

   279              (disect-bytes-2

   280               (+ start-address

   281                  (count header)

   282                  (symbol-index :to-be-executed input))))

   283             :to-be-executed 0x3F} ;; clear carry flag no-op

   284 

   285            program** (flatten

   286                       (replace symbols (concat header input output)))

   287            

   288            resolve-internal-jumps

   289            {:output-start []

   290             :to-output

   291             (->signed-8-bit

   292              (dec

   293               (- (symbol-index :output-start program**)

   294                  (symbol-index :to-output program**))))}

   295 

   296            program*

   297            (flatten (replace resolve-internal-jumps program**))

   298            

   299            resolve-external-jumps

   300            {:to-halt

   301             (- (- (symbol-index :to-beginning program*)

   302                   (symbol-index :to-halt program*)) 3)

   303                

   304             :to-beginning

   305             (->signed-8-bit

   306              (+ 2 (count (frame-metronome))

   307                 (- (symbol-index :to-beginning program*))))}

   308 

   309            program

   310            (replace resolve-external-jumps program*)]

   311        program)))

   312         

   313     

   314 ;;;;;; TESTS ;;;;;;

   315 

   316 (def set-H-mode 0x67)

   317 (def set-L-mode 0x6F)

   318 (def jump-mode  0xE9)

   319 (def write-mode 0x47)

   320 

   321 

   322 (defn bootstrap-base []

   323   (let [program (main-bootstrap-program pokemon-list-start)]

   324     ;; make sure program is valid output for item-writer

   325     (-> (tick (mid-game))

   326         (set-memory-range pokemon-list-start program)

   327         (PC! pokemon-list-start)

   328         (step [])

   329         (step []))))

   330 

   331 (defn test-set-H []

   332   (letfn [(test-H [state n]

   333             (let [after

   334                   (-> state

   335                       (step (buttons set-H-mode))

   336                       (step (buttons n))

   337                       (step []))]

   338               ;;(println "desired H =" n "actual =" (H after))

   339               (assert (= n (H after)))

   340               after))]

   341     (let [result (reduce test-H (bootstrap-base) (range 0x100))]

   342       (println "set H test passed.")

   343       result)))

   344 

   345 (defn test-write-bytes []

   346   (let [target-address 0xC00F

   347         [target-high target-low] (disect-bytes-2 target-address)

   348         assembly [0xF3 0x18 0xFE 0x12]

   349         get-mem-region  #(subvec (vec (memory %))

   350                                  target-address (+ target-address 20))

   351         before (bootstrap-base)

   352         after

   353         (-> before

   354             (step [])           ; make sure it can handle blanks

   355             (step [])           ; at the beginning.

   356             (step [])                      

   357             (step (buttons set-H-mode))     ; select set-H

   358             (step (buttons target-high))

   359             (step [])

   360             (step (buttons set-L-mode))

   361             (step (buttons target-low))

   362             (step [])

   363             (step (buttons write-mode))

   364             (step (buttons 4))  ; write 4 bytes

   365             (step (buttons (nth assembly 0)))

   366             (step (buttons (nth assembly 1)))

   367             (step (buttons (nth assembly 2)))

   368             (step (buttons (nth assembly 3)))

   369             (step [])

   370             (step [])

   371             (step []))]

   372     ;;(println "before :" (get-mem-region before))

   373     ;;(println "after  :" (get-mem-region after))

   374     ;;(assert (= assembly (take 4 (get-mem-region after))))

   375     (println "write-test-passed.")

   376     after))

   377 

   378 (defn test-jump []

   379   (let [target-address 0xC00F

   380         [target-high target-low] (disect-bytes-2 target-address)

   381         post-jump

   382         (-> (test-write-bytes)

   383             (step (buttons set-H-mode))     ; select set-H

   384             (step (buttons target-high))

   385             (step [])

   386             (step (buttons set-L-mode))

   387             (step (buttons target-low))

   388             (step [])

   389             (step (buttons jump-mode)))           ; Select JUMP mode.

   390         program-counters

   391         (capture-program-counter 

   392          post-jump

   393          10000)]

   394     (assert (contains? (set program-counters) target-address))

   395     (println "jump test passed.")

   396     post-jump))

   397 

   398 (defn test-no-repeated-nybbles []

   399   (bootstrap-pattern (main-bootstrap-program))

   400   (println "no-repeated-nybbles"))

   401 

   402 (defn run-all-tests []

   403   (test-frame-metronome)

   404   (test-read-user-input)

   405   (test-set-H)

   406   (test-write-bytes)

   407   (test-jump)

   408   (test-no-repeated-nybbles)

   409   (println "\n all tests passed."))
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 13 Apr 2012 11:32:52 -0500
parents	41647cb85901
children	55a45f67e4a4