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 test-frame-metronome

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

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

    97   ([steps]

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

    99                   (->signed-8-bit

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

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

   102            count-frames

   103            (-> (tick (mid-game))

   104                (IE! 0)

   105                (DE! 0)

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

   107                (PC! pokemon-list-start))

   108            E-after-moves

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

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

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

   112 

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

   114        count-frames)))

   115 

   116 (defn read-user-input []

   117   [0x3E

   118    0x20 ; prepare to measure d-pad

   119 

   120    0x01 ;\

   121    0x01 ; |

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

   123    0x04 ; |

   124    0x0D ;/

   125    

   126    0x02 

   127    0x0A ;; get D-pad info

   128    

   129    0xF5 ;; push AF

   130       

   131    0x3E

   132    0x10 ; prepare to measure buttons

   133 

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

   135    

   136    0x02

   137    0x0A ;; get button info

   138    

   139    0xE6 ;; select bottom bits of A

   140    0x0F

   141 

   142    0x47 ;; A->B

   143 

   144    0xF1 ;; pop AF

   145 

   146    0xE6

   147    0x0F ;; select bottom bits of A

   148 

   149    0xCB

   150    0x37 ;; swap A nybbles

   151 

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

   153  

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

   155    

   156    ])

   157 

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

   159   (let [program

   160         (concat

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

   162          [0x5F ;; A-> E

   163           0x18

   164           (->signed-8-bit

   165            (+ (- (count (frame-metronome)))

   166               (- (count (read-user-input)))

   167               (- 3)))])

   168         read-input

   169         (-> (tick (mid-game))

   170             (IE! 0)

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

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

   173     (dorun

   174       (for [i (range 0x100)]

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

   176      (println "Tested all inputs.")

   177     read-input))

   178 

   179 (def symbol-index

   180   (fn [symbol sequence]

   181     (count (take-while

   182             (partial not= symbol)

   183             sequence))))

   184 

   185 

   186 (defn main-bootstrap-program [start-address]

   187   ;; Register Use:

   188   

   189   ;; ED non-volitale scratch

   190   

   191   ;; A  user-input

   192   ;; HL target-address

   193   ;; B  bytes-to-write

   194   ;; C  non-volatile scratch

   195 

   196   ;; Modes (with codes) are:

   197 

   198   ;; single-action-modes:

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

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

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

   202 

   203   ;; multi-action-modes

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

   205 

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

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

   208                          (count (read-user-input)))

   209 

   210         init

   211         [0xAF 0x4F 0x57 0x47] ;; 0->A; 0->C; 0->D; 0->B

   212 

   213         input

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

   215 

   216          0x5F  ;; A->E

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

   218          0x00  ;; (cp A B)

   219          0x7B  ;; E->A

   220          0x20       ;; skip to output section if

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

   222        

   223          :to-be-executed

   224 

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

   226          0xEA

   227          :to-be-executed-address

   228 

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

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

   231          0x79 ;; C->A

   232          0xA7 ;; test A==0

   233          0x28

   234          0x04

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

   236          0xEA ;; 

   237          :to-be-executed-address

   238          

   239          0x7B ;; E->A

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

   241          0x18           ;; return

   242          :to-beginning-1]

   243         

   244         ;; output

   245         ;; [:output-start ;; just a label

   246         ;;  0x54 ;;

   247         ;;  0x5D ;; HL->DE  \

   248         ;;       ;;          |

   249         ;;  0x79 ;; C->A     | this mess is all to do 

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

   251         ;;       ;;          | any repeating nybbles

   252         ;;  0x23 ;; inc HL  /

   253 

   254 

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

   256         ;;  0x20 ;; if there are no more bytes to write,

   257         ;;  0x04

   258         ;; 

   259                   

   260         ;;  0x18

   261         ;;  :to-beginning-2]

   262 

   263         output

   264         [:output-start ;; just a label

   265          0x00 ;;

   266          0x00 ;; HL->DE  \

   267               ;;          |

   268          0x00 ;; C->A     | this mess is all to do 

   269          0x00 ;; A->(DE)  | 0x22 (LDI (HL), A) without

   270               ;;          | any repeating nybbles

   271          0x00 ;; inc HL  /

   272 

   273 

   274          0x00 ;; DEC bytes-to-write (B)

   275          0x00 ;; if there are no more bytes to write,

   276          0x00

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

   278          0x00

   279          0x00

   280          0x00

   281                   

   282          0x00

   283          0x00]

   284         

   285 

   286         

   287         symbols

   288         {:to-be-executed-address

   289          (reverse

   290           (disect-bytes-2

   291            (+ start-address jump-distance

   292               (count init)

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

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

   295 

   296         program** (flatten

   297                   (replace

   298                    symbols

   299                    (concat init (frame-metronome)

   300                            (read-user-input)

   301                            input output)))

   302         resolve-internal-jumps

   303         {:output-start []

   304          :to-output

   305          (->signed-8-bit

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

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

   308 

   309         program*

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

   311         

   312         resolve-external-jumps

   313         {:to-beginning-1

   314          (->signed-8-bit

   315           (+ (count init)

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

   317          :to-beginning-2

   318          (->signed-8-bit

   319           (+ (count init)

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

   321 

   322         program

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

   324     program))

   325         

   326     

   327 ;;;;;; TESTS ;;;;;;

   328 

   329 (defn bootstrap-base []

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

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

   332     ;;(bootstrap-pattern program)

   333     (-> (tick (mid-game))

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

   335         (PC! pokemon-list-start)

   336         (step [])

   337         (step []))))

   338      

   339 

   340 (defn test-set-H []

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

   342             (let [after

   343                   (-> state

   344                       (step (buttons 0x67))

   345                       (step (buttons n))

   346                       (step []))]

   347               (println "desired H =" n "actual =" (H after))

   348               (assert (= n (H after)))

   349               after))]

   350     (println "tested all H values")

   351     (reduce test-H (bootstrap-base) (range 0x100))))

   352 

   353 

   354 

   355 

   356 

   357 (defn test-write-bytes-mode []

   358   (let [target-address 0xC00F

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

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

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

   362                                  target-address (+ target-address 20))

   363         before (bootstrap-base)

   364         after

   365         (-> before

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

   367             (step [])           ; at the beginning.

   368             (step [])                      

   369             (step [:start])     ; select WRITE-BYTES mode

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

   371             (step (buttons target-high))

   372             (step (buttons target-low))

   373             (step (buttons (nth assembly 0)))

   374             (step (buttons (nth assembly 1)))

   375             (step (buttons (nth assembly 2)))

   376             (step (buttons (nth assembly 3)))

   377             (step [])

   378             (step [])

   379             (step []))]

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

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

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

   383     after))

   384 

   385 (defn test-jump-mode []

   386   (let [target-address 0xC00F

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

   388         post-jump

   389         (-> (test-write-bytes-mode)

   390             (step [])

   391             (step [])

   392             (step [])

   393             (step (buttons 0xFF))           ; Select JUMP mode.

   394             (step (buttons target-high))

   395             (step (buttons target-low)))

   396         program-counters

   397         (capture-program-counter 

   398          post-jump

   399          10000)]

   400     (println program-counters)

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

   402     post-jump))
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 13 Apr 2012 07:30:11 -0500
parents	ddb3c6299619
children	0262094d0914