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 

    10 ;; Specs for Main Bootstrap Program

    11 

    12 ;; Number-Input

    13 ;; Number input works using all eight buttons to

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

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

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

    17 

    18 ;;; MODES

    19 ;; There are five modes in total:

    20 ;;   MODE-SELECT

    21 ;;   SET-H

    22 ;;   SET-L

    23 ;;   WRITE

    24 ;;   JUMP

    25 

    26 ;;; MODE-SELECT

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

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

    29 ;;   on which buttons are pressed:

    30 ;;       0   :  MODE-SELECT

    31 ;;    0x67   :  SET-H

    32 ;;    0x6F   :  SET-L

    33 ;;    0x47   :  WRITE

    34 ;;    0xE9   :  JUMP

    35 

    36 ;;; SET-H

    37 ;;   SET-H sets the high 8 bits of the target address to which

    38 ;;   data will be written / the program will jump.  It expects

    39 ;;   the following:

    40 ;;

    41 ;;    Byte 0 : New Value of H

    42 ;;    Byte 1 : 0x00

    43 

    44 ;;; SET-L

    45 ;;   This mode sets the low 8 bits of the target address and has

    46 ;;   the same semantics as SET-H.

    47 

    48 ;;; WRITE-BYTES

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

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

    51 ;;   header of one byte describing how many bytes to write.

    52 

    53 ;;    Byte 0  : Number of Bytes to Write

    54 

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

    56 ;;   and they are written to the start address in sequence.

    57 ;;   After the last byte is written control returns to

    58 ;;   MODE-SELECT mode. The Target address will be incremented by

    59 ;;   Number of Bytes to Write once you are done writing.

    60 

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

    62 ;;   the target address enter:

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

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

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

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

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

    68 

    69 ;;; JUMP 

    70 ;;   JUMP mode jumps program control to the target address.

    71 

    72 ;;; EXAMPLE

    73 ;;   To write the infinite loop program [0x18 0xFE] to address

    74 ;;   0xC00F and then jump to said program, enter the following

    75 ;;   starting from MODE-SELECT mode.

    76 

    77 ;;    Byte 0  : 0x67 [:a :b :l :u :select]        ;; SET-H mode

    78 ;;    Byte 1  : 0xC0 [:d :u]                      ;; 0xC0 -> H

    79 ;;    Byte 2  : 0x00 []                           ;; trailer

    80 

    81 ;;    Byte 3  : 0x6F [:a :start :b :l :u :select] ;; SET-L mode

    82 ;;    Byte 4  : 0x0F [:a :start :b :select]       ;; 0x0F -> L

    83 ;;    Byte 5  : 0x00 []                           ;; trailer

    84 

    85 ;;    Byte 6  : 0x47 [:a :b :u :select]           ;; WRITE-MODE

    86 ;;    Byte 7  : 0x02 [:b]                         ;; write 2 bytes

    87 ;;    Byte 8  : 0x18 [:r :start]                  ;; assembly

    88 ;;    Byte 9  : 0xFE [:r :start :b :d :l :u :select] ;; assembly

    89 

    90 ;;    target address is now 0xC011 since we wrote 2 bytes.

    91 ;;    set it back to 0xC00F.

    92 

    93 ;;    Byte 10 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode

    94 ;;    Byte 12 : 0x0F [:a :start :b :select]       ;; 0x0F -> L

    95 ;;    Byte 13 : 0x00 []                           ;; trailer

    96 

    97 ;;    Byte 14 : 0xE9                              ;; JUMP-MODE

    98 

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

   100   (if (< n 0)

   101     (+ 256 n) n))

   102 

   103 (defn frame-metronome** []

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

   105         timing-loop

   106         [0x01 ; \

   107          0x43 ;  |

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

   109          0x0C ;  |

   110          0x04 ; /

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

   112         continue-if-144

   113         [0xFE

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

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

   116          (->signed-8-bit

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

   118         spin-loop

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

   120          0x20 ;; spin until B==0

   121          0xFD]]

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

   123 

   124 (defn frame-metronome* []

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

   126    0x01    

   127    0xE0

   128    0xFF])

   129 

   130 

   131 (defn frame-metronome []

   132   [0x06 ;; load 0xFE into B

   133    0xFE

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

   135    0x3E

   136    0x01 ;; 1->A

   137    

   138    0x48 ;; B->C

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

   140 

   141 (defn test-frame-metronome

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

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

   144   ([steps]

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

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

   147                    

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

   149            count-frames

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

   151                (IE! 0)

   152                (DE! 0)

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

   154                (PC! pokemon-list-start))

   155            E-after-moves

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

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

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

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

   160        count-frames)))

   161 

   162 (defn read-user-input []

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

   164    0xC5 ;; save value of BC

   165       

   166    0x3E

   167    0x20 ; prepare to measure d-pad

   168 

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

   170    

   171    0x01 ;\

   172    0x01 ; |

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

   174    0x04 ; |

   175    0x0D ;/

   176    

   177    0x02 

   178    0x0A ;; get D-pad info

   179    

   180    0xF5 ;; push AF

   181       

   182    0x3E

   183    0x10 ; prepare to measure buttons

   184 

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

   186    

   187    0x02

   188    0x0A ;; get button info

   189    

   190    0xE6 ;; select bottom bits of A

   191    0x0F

   192 

   193    0x47 ;; A->B

   194 

   195    0xF1 ;; pop AF

   196 

   197    0xE6

   198    0x0F ;; select bottom bits of A

   199 

   200    0xCB

   201    0x37 ;; swap A nybbles

   202 

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

   204  

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

   206    ])

   207 

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

   209   (let [program

   210         (concat

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

   212          [0x5F ;; A-> E

   213           0x76

   214           0x18

   215           (->signed-8-bit

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

   217               (- 4)))])

   218         read-input

   219         (-> (tick (mid-game))

   220             (IE! 0)

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

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

   223     (dorun

   224      (for [i (range 0x100)]

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

   226      (println "tested all inputs.")

   227     read-input))

   228 

   229 (def symbol-index

   230   (fn [symbol sequence]

   231     (count (take-while

   232             (partial not= symbol)

   233             sequence))))

   234 

   235 (defn main-bootstrap-program

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

   237   ([start-address]

   238      ;; Register Use:

   239      

   240      ;; ED non-volitale scratch

   241      

   242      ;; A  user-input

   243      ;; HL target-address

   244      ;; B  bytes-to-write

   245      ;; C  non-volatile scratch

   246 

   247      ;; Modes (with codes) are:

   248 

   249      ;; single-action-modes:

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

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

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

   253 

   254      ;; multi-action-modes

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

   256 

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

   258            

   259            input

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

   261 

   262             0x5F  ;; A->E

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

   264             0xB8  ;; (cp A B)

   265             0x7B  ;; E->A

   266             0x20       ;; skip to output section if

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

   268             

   269             :to-be-executed

   270 

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

   272             0xEA

   273             :to-be-executed-address

   274 

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

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

   277             0x79 ;; C->A

   278             0xA7 ;; test A==0

   279             0x28

   280             0x04

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

   282             0xEA ;; 

   283             :to-be-executed-address

   284             

   285             0x7B ;; E->A

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

   287             0x18           ;; return

   288             :to-halt]

   289            

   290            output

   291            [:output-start ;; just a label

   292             0x3F ;; ;; prevent repeated nybbles

   293             0x54 ;;

   294             0x5D ;; HL->DE  \

   295                  ;;          | This mess is here to do

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

   297                  ;;         /  any repeating nybbles

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

   299 

   300             0x23 ;; inc HL 

   301             

   302             0x76 ;; HALT, peasant!

   303             0x18

   304             :to-beginning] 

   305 

   306            symbols

   307            {:to-be-executed-address

   308             (reverse

   309              (disect-bytes-2

   310               (+ start-address

   311                  (count header)

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

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

   314 

   315            program** (flatten

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

   317            

   318            resolve-internal-jumps

   319            {:output-start []

   320             :to-output

   321             (->signed-8-bit

   322              (dec

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

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

   325 

   326            program*

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

   328            

   329            resolve-external-jumps

   330            {:to-halt

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

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

   333                

   334             :to-beginning

   335             (->signed-8-bit

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

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

   338 

   339            program

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

   341        program)))

   342         

   343     

   344 ;;;;;; TESTS ;;;;;;

   345 

   346 (def set-H-mode 0x67)

   347 (def set-L-mode 0x6F)

   348 (def jump-mode  0xE9)

   349 (def write-mode 0x47)

   350 

   351 

   352 (defn bootstrap-base []

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

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

   355     (-> (tick (mid-game))

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

   357         (PC! pokemon-list-start)

   358         (step [])

   359         (step []))))

   360 

   361 (defn test-set-H []

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

   363             (let [after

   364                   (-> state

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

   366                       (step (buttons n))

   367                       (step []))]

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

   369               (assert (= n (H after)))

   370               after))]

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

   372       (println "set H test passed.")

   373       result)))

   374 

   375 (defn test-write-bytes []

   376   (let [target-address 0xC00F

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

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

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

   380                                  target-address (+ target-address 20))

   381         before (bootstrap-base)

   382         after

   383         (-> before

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

   385             (step [])           ; at the beginning.

   386             (step [])                      

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

   388             (step (buttons target-high))

   389             (step [])

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

   391             (step (buttons target-low))

   392             (step [])

   393             (step (buttons write-mode))

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

   395             (step (buttons (nth assembly 0)))

   396             (step (buttons (nth assembly 1)))

   397             (step (buttons (nth assembly 2)))

   398             (step (buttons (nth assembly 3))))]

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

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

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

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

   403     after))

   404 

   405 (defn test-jump []

   406   (let [target-address 0xC00F

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

   408         post-jump

   409         (-> (test-write-bytes)

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

   411             (step (buttons target-high))

   412             (step [])

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

   414             (step (buttons target-low))

   415             (step [])

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

   417         program-counters

   418         (capture-program-counter 

   419          post-jump

   420          10000)]

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

   422     (println "jump test passed.")

   423     post-jump))

   424 

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

   426   (bootstrap-pattern (main-bootstrap-program))

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

   428 

   429 (defn run-all-tests []

   430   (test-frame-metronome)

   431   (test-read-user-input)

   432   (test-set-H)

   433   (test-write-bytes)

   434   (test-jump)

   435   (test-no-repeated-nybbles)

   436   (println "\n all tests passed."))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 14 Apr 2012 01:32:22 -0500
parents	bca0abd39db5
children	0162dd315814