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   ([] (frame-metronome true))

    75   ([spin-loop?]

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

    77            timing-loop

    78            [0x01 ; \

    79             0x43 ;  |

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

    81             0x0C ;  |

    82             0x04 ; /

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

    84            continue-if-144

    85            [0xFE

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

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

    88             (->signed-8-bit

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

    90            spin-loop

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

    92             0x20 ;; spin until B==0

    93             0xFD]]

    94        (concat init timing-loop continue-if-144

    95                (if spin-loop?

    96                  spin-loop [])))))

    97 

    98 (defn test-frame-metronome

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

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

   101   ([steps]

   102      (let [inc-E [0x1C 0x18

   103                   (->signed-8-bit

   104                    (+ -3 (- (count (frame-metronome)))))]

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

   106            count-frames

   107            (-> (tick (mid-game))

   108                (IE! 0)

   109                (DE! 0)

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

   111                (PC! pokemon-list-start))

   112            E-after-moves

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

   114        (println "E:" E-after-moves) 

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

   116 

   117        (println "E =" E-after-moves "after" steps "steps")

   118        count-frames)))

   119 

   120 (defn read-user-input []

   121   [0x3E

   122    0x20 ; prepare to measure d-pad

   123 

   124    0x01 ;\

   125    0x01 ; |

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

   127    0x04 ; |

   128    0x0D ;/

   129    

   130    0x02 

   131    0x0A ;; get D-pad info

   132    

   133    0xF5 ;; push AF

   134       

   135    0x3E

   136    0x10 ; prepare to measure buttons

   137 

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

   139    

   140    0x02

   141    0x0A ;; get button info

   142    

   143    0xE6 ;; select bottom bits of A

   144    0x0F

   145 

   146    0x47 ;; A->B

   147 

   148    0xF1 ;; pop AF

   149 

   150    0xE6

   151    0x0F ;; select bottom bits of A

   152 

   153    0xCB

   154    0x37 ;; swap A nybbles

   155 

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

   157  

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

   159    

   160    ])

   161 

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

   163   (let [program

   164         (concat

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

   166          [0x5F ;; A-> E

   167           0x18

   168           (->signed-8-bit

   169            (+ (- (count (frame-metronome)))

   170               (- (count (read-user-input)))

   171               (- 3)))])

   172         read-input

   173         (-> (tick (mid-game))

   174             (IE! 0)

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

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

   177     (dorun

   178       (for [i (range 0x100)]

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

   180      (println "Tested all inputs.")

   181     read-input))

   182 

   183 (def symbol-index

   184   (fn [symbol sequence]

   185     (count (take-while

   186             (partial not= symbol)

   187             sequence))))

   188 

   189 (defn main-bootstrap-program

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

   191   ([start-address]

   192      ;; Register Use:

   193      

   194      ;; ED non-volitale scratch

   195      

   196      ;; A  user-input

   197      ;; HL target-address

   198      ;; B  bytes-to-write

   199      ;; C  non-volatile scratch

   200 

   201      ;; Modes (with codes) are:

   202 

   203      ;; single-action-modes:

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

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

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

   207 

   208      ;; multi-action-modes

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

   210 

   211      (let [[start-high start-low] (disect-bytes-2 start-address)

   212            jump-distance (+ (count (frame-metronome))

   213                             (count (read-user-input)))

   214 

   215            init

   216            [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B

   217 

   218            input

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

   220 

   221             0x5F  ;; A->E

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

   223             0xB8  ;; (cp A B)

   224             0x7B  ;; E->A

   225             0x20       ;; skip to output section if

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

   227             

   228             :to-be-executed

   229 

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

   231             0xEA

   232             :to-be-executed-address

   233 

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

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

   236             0x79 ;; C->A

   237             0xA7 ;; test A==0

   238             0x28

   239             0x04

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

   241             0xEA ;; 

   242             :to-be-executed-address

   243             

   244             0x7B ;; E->A

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

   246             0x18           ;; return

   247             :to-beginning-1]

   248            

   249            output

   250            [:output-start ;; just a label

   251             0x54 ;;

   252             0x5D ;; HL->DE  \

   253             ;;          | This mess is here to do

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

   255             ;;          | any repeating nybbles

   256             0x23 ;; inc HL  /

   257 

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

   259 

   260             0x18

   261             :to-beginning-2]

   262            

   263            symbols

   264            {:to-be-executed-address

   265             (reverse

   266              (disect-bytes-2

   267               (+ start-address jump-distance

   268                  (count init)

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

   270             :to-be-executed 0x00} ;; clear carry flag no-op

   271 

   272            program** (flatten

   273                       (replace

   274                        symbols

   275                        (concat init (frame-metronome)

   276                                (read-user-input)

   277                                input output)))

   278            resolve-internal-jumps

   279            {:output-start []

   280             :to-output

   281             (->signed-8-bit

   282              (dec

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

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

   285 

   286            program*

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

   288            

   289            resolve-external-jumps

   290            {:to-beginning-1

   291             (->signed-8-bit

   292              (+ (count init)

   293                 -2 (- (dec (symbol-index :to-beginning-1 program*)))))

   294             :to-beginning-2

   295             (->signed-8-bit

   296              (+ (count init)

   297                 -2 (- (dec (symbol-index :to-beginning-2 program*)))))}

   298 

   299            program

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

   301        program)))

   302         

   303     

   304 ;;;;;; TESTS ;;;;;;

   305 

   306 (def set-H-mode 0x67)

   307 (def set-L-mode 0x6F)

   308 (def jump-mode  0xE9)

   309 (def write-mode 0x47)

   310 

   311 

   312 (defn bootstrap-base []

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

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

   315     ;;(bootstrap-pattern program)

   316     (-> (tick (mid-game))

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

   318         (PC! pokemon-list-start)

   319         (step [])

   320         (step []))))

   321 

   322 (defn test-set-H []

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

   324             (let [after

   325                   (-> state

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

   327                       (step (buttons n))

   328                       (step []))]

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

   330               (assert (= n (H after)))

   331               after))]

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

   333       (println "tested all H values")

   334       result)))

   335 

   336 (defn test-write-bytes []

   337   (let [target-address 0xC00F

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

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

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

   341                                  target-address (+ target-address 20))

   342         before (bootstrap-base)

   343         after

   344         (-> before

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

   346             (step [])           ; at the beginning.

   347             (step [])                      

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

   349             (step (buttons target-high))

   350             (step [])

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

   352             (step (buttons target-low))

   353             (step [])

   354             (step (buttons write-mode))

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

   356             (step (buttons (nth assembly 0)))

   357             (step (buttons (nth assembly 1)))

   358             (step (buttons (nth assembly 2)))

   359             (step (buttons (nth assembly 3)))

   360             (step [])

   361             (step [])

   362             (step []))]

   363             (println "before :" (get-mem-region before))

   364             (println "after  :" (get-mem-region after))

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

   366     after))

   367 

   368 (defn test-jump []

   369   (let [target-address 0xC00F

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

   371         post-jump

   372         (-> (test-write-bytes)

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

   374             (step (buttons target-high))

   375             (step [])

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

   377             (step (buttons target-low))

   378             (step [])

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

   380         program-counters

   381         (capture-program-counter 

   382          post-jump

   383          10000)]

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

   385     (println "jump test passed")

   386     post-jump))

   387 

   388 

   389 (defn run-all-tests []

   390   (test-frame-metronome)

   391   (test-read-user-input)

   392   (test-set-H)

   393   (test-write-bytes)

   394   (test-jump))
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 13 Apr 2012 09:59:32 -0500
parents	eee219d1a259
children	41647cb85901