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   (:import [com.aurellem.gb.gb_driver SaveState]))

     6 

     7 (defn pc-item-writer-program

     8   []

     9   (let [limit 201

    10         [target-high target-low] (disect-bytes-2 pokemon-list-start)]

    11     (flatten

    12      [[0x00  ;; (item-hack) set increment stack pointer no-op

    13        0x1E  ;; load limit into E

    14        limit

    15        0x3F  ;; (item-hack) set carry flag no-op

    16 

    17        ;; load 2 into C.

    18        0x0E   ;; C == 1 means input-first nybble

    19        0x04   ;; C == 0 means input-second nybble

    20 

    21        0x21 ;; load target into HL

    22        target-low

    23        target-high

    24        0x37 ;; (item-hack) set carry flag no-op

    25 

    26        0x00 ;; (item-hack) no-op

    27        0x37 ;; (item-hack) set carry flag no-op

    28        

    29        0x00 ;; (item-hack) no-op

    30        0xF3 ;; disable interrupts

    31        ;; Input Section

    32 

    33        0x3E ;; load 0x20 into A, to measure buttons

    34        0x10 

    35 

    36        0x00 ;; (item-hack) no-op

    37        0xE0 ;; load A into [FF00]

    38        0x00

    39 

    40        0xF0 ;; load 0xFF00 into A to get

    41        0x00 ;; button presses

    42        

    43        0xE6

    44        0x0F ;; select bottom four bits of A

    45        0x37 ;; (item-hack) set carry flag no-op

    46 

    47        0x00 ;; (item-hack) no-op

    48        0xB8 ;; see if input is different (CP A B)

    49 

    50        0x00 ;; (item-hack) (INC SP)

    51        0x28 ;; repeat above steps if input is not different

    52        ;; (jump relative backwards if B != A)

    53        0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)

    54 

    55        0x47 ;; load A into B

    56        

    57        0x0D ;; dec C

    58        0x37 ;; (item-hack) set-carry flag

    59        ;; branch based on C:

    60        0x20 ;; JR NZ

    61        23 ;; skip "input second nybble" and "jump to target" below

    62        

    63        ;; input second nybble

    64 

    65        0x0C ;; inc C

    66        0x0C ;; inc C

    67 

    68        0x00 ;; (item-hack) no-op

    69        0xE6 ;; select bottom bits

    70        0x0F

    71        0x37 ;; (item-hack) set-carry flag no-op

    72 

    73        0x00 ;; (item-hack) no-op

    74        0xB2 ;; (OR A D) -> A

    75 

    76        0x22 ;; (do (A -> (HL)) (INC HL))

    77 

    78        0x1D ;; (DEC E)

    79 

    80        0x00 ;; (item-hack) 

    81        0x20 ;; jump back to input section if not done

    82        0xDA ;; literal -36 == TM 18 (counter)

    83        0x01 ;; (item-hack) set BC to literal (no-op)

    84 

    85        ;; jump to target

    86        0x00  ;; (item-hack) these two bytes can be anything.

    87        0x01 

    88 

    89        0x00   ;; (item-hack) no-op

    90        0xBF   ;; (CP A A) ensures Z

    91        

    92        0xCA   ;; (item-hack) jump if Z

    93        target-low

    94        target-high

    95        0x01   ;; (item-hack) will never be reached.

    96        

    97        ;; input first nybble

    98        0x00

    99        0xCB

   100        0x37  ;; swap nybbles on A

   101 

   102        0x57  ;; A -> D

   103 

   104        0x37  ;; (item-hack) set carry flag no-op

   105        0x18  ;; relative jump backwards

   106        0xCD  ;; literal -51 == TM05; go back to input section

   107        0x01  ;; (item-hack) will never reach this instruction

   108 

   109        ]

   110       (repeat 8 [0x00 0x01]);; these can be anything

   111 

   112       [;; jump to actual program

   113        0x00

   114        0x37  ;; (item-hack) set carry flag no-op

   115 

   116        0x2E  ;; 0x3A -> L

   117        0x3A

   118 

   119 

   120        0x00  ;; (item-hack) no-op

   121        0x26  ;; 0xD5 -> L

   122        0xD5  

   123        0x01  ;; (item-hack) set-carry BC

   124 

   125        0x00  ;; (item-hack) these can be anything

   126        0x01  

   127 

   128        0x00

   129        0xE9 ;; jump to (HL)

   130        ]])))

   131 

   132 

   133 

   134 ;; Specs for Main Bootstrap Program

   135 

   136 ;; Number-Input

   137 ;; Number input works using all eight buttons to

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

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

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

   141 

   142 ;;; MODES

   143 ;; There are five modes in total:

   144 ;;   MODE-SELECT

   145 ;;   SET-H

   146 ;;   SET-L

   147 ;;   WRITE

   148 ;;   JUMP

   149 

   150 ;;; MODE-SELECT

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

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

   153 ;;   on which buttons are pressed:

   154 ;;       0   :  MODE-SELECT

   155 ;;    0x67   :  SET-H

   156 ;;    0x6F   :  SET-L

   157 ;;    0x47   :  WRITE

   158 ;;    0xE9   :  JUMP

   159 

   160 ;;; SET-H

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

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

   163 ;;   the following:

   164 ;;

   165 ;;    Byte 0 : New Value of H

   166 ;;    Byte 1 : 0x00

   167 

   168 ;;; SET-L

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

   170 ;;   the same semantics as SET-H.

   171 

   172 ;;; WRITE-BYTES

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

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

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

   176 

   177 ;;    Byte 0  : Number of Bytes to Write

   178 

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

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

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

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

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

   184 

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

   186 ;;   the target address enter:

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

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

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

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

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

   192 

   193 ;;; JUMP 

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

   195 

   196 ;;; EXAMPLE

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

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

   199 ;;   starting from MODE-SELECT mode.

   200 

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

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

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

   204 

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

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

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

   208 

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

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

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

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

   213 

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

   215 ;;    set it back to 0xC00F.

   216 

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

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

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

   220 

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

   222 

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

   224   (if (< n 0)

   225     (+ 256 n) n))

   226 

   227 (defn frame-metronome** []

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

   229         timing-loop

   230         [0x01 ; \

   231          0x43 ;  |

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

   233          0x0C ;  |

   234          0x04 ; /

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

   236         continue-if-144

   237         [0xFE

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

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

   240          (->signed-8-bit

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

   242         spin-loop

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

   244          0x20 ;; spin until B==0

   245          0xFD]]

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

   247 

   248 (defn frame-metronome* []

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

   250    0x01    

   251    0xE0

   252    0xFF])

   253 

   254 

   255 (defn frame-metronome []

   256   [0x06 ;; load 0xFE into B

   257    0xFE

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

   259    0x3E

   260    0x01 ;; 1->A

   261    

   262    0x48 ;; B->C

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

   264 

   265 (defn test-frame-metronome

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

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

   268   ([steps]

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

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

   271                    

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

   273            count-frames

   274            (-> (tick (mid-game))

   275                (IE! 0)

   276                (DE! 0)

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

   278                (PC! pokemon-list-start))

   279            E-after-moves

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

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

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

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

   284        count-frames)))

   285 

   286 (defn read-user-input []

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

   288    0xC5 ;; save value of BC

   289       

   290    0x3E

   291    0x20 ; prepare to measure d-pad

   292 

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

   294    

   295    0x01 ;\

   296    0x01 ; |

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

   298    0x04 ; |

   299    0x0D ;/

   300    

   301    0x02 

   302    0x0A ;; get D-pad info

   303    

   304    0xF5 ;; push AF

   305       

   306    0x3E

   307    0x10 ; prepare to measure buttons

   308 

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

   310    

   311    0x02

   312    0x0A ;; get button info

   313    

   314    0xE6 ;; select bottom bits of A

   315    0x0F

   316 

   317    0x47 ;; A->B

   318 

   319    0xF1 ;; pop AF

   320 

   321    0xE6

   322    0x0F ;; select bottom bits of A

   323 

   324    0xCB

   325    0x37 ;; swap A nybbles

   326 

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

   328  

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

   330    ])

   331 

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

   333   (let [program

   334         (concat

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

   336          [0x5F ;; A-> E

   337           0x76

   338           0x18

   339           (->signed-8-bit

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

   341               (- 4)))])

   342         read-input

   343         (-> (tick (mid-game))

   344             (IE! 0)

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

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

   347     (dorun

   348      (for [i (range 0x100)]

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

   350      (println "tested all inputs.")

   351     read-input))

   352 

   353 (def symbol-index

   354   (fn [symbol sequence]

   355     (count (take-while

   356             (partial not= symbol)

   357             sequence))))

   358 

   359 (defn main-bootstrap-program

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

   361   ([start-address]

   362      ;; Register Use:

   363      

   364      ;; ED non-volitale scratch

   365      

   366      ;; A  user-input

   367      ;; HL target-address

   368      ;; B  bytes-to-write

   369      ;; C  non-volatile scratch

   370 

   371      ;; Modes (with codes) are:

   372 

   373      ;; single-action-modes:

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

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

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

   377 

   378      ;; multi-action-modes

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

   380 

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

   382            

   383            input

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

   385 

   386             0x5F  ;; A->E

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

   388             0xB8  ;; (cp A B)

   389             0x7B  ;; E->A

   390             0x20       ;; skip to output section if

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

   392             

   393             :to-be-executed

   394 

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

   396             0xEA

   397             :to-be-executed-address

   398 

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

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

   401             0x79 ;; C->A

   402             0xA7 ;; test A==0

   403             0x28

   404             0x04

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

   406             0xEA ;; 

   407             :to-be-executed-address

   408             

   409             0x7B ;; E->A

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

   411             0x18           ;; return

   412             :to-halt]

   413            

   414            output

   415            [:output-start ;; just a label

   416             0x3F ;; ;; prevent repeated nybbles

   417             0x54 ;;

   418             0x5D ;; HL->DE  \

   419                  ;;          | This mess is here to do

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

   421                  ;;         /  any repeating nybbles

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

   423 

   424             0x23 ;; inc HL 

   425             

   426             0x76 ;; HALT, peasant!

   427             0x18

   428             :to-beginning] 

   429 

   430            symbols

   431            {:to-be-executed-address

   432             (reverse

   433              (disect-bytes-2

   434               (+ start-address

   435                  (count header)

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

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

   438 

   439            program** (flatten

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

   441            

   442            resolve-internal-jumps

   443            {:output-start []

   444             :to-output

   445             (->signed-8-bit

   446              (dec

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

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

   449 

   450            program*

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

   452            

   453            resolve-external-jumps

   454            {:to-halt

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

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

   457                

   458             :to-beginning

   459             (->signed-8-bit

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

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

   462 

   463            program

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

   465        program)))

   466 

   467 

   468 (defn no-consecutive-repeats? [seq]

   469   (not (contains? (set(map - seq (rest seq))) 0)))

   470 

   471 (defn byte->nybbles [byte]

   472   [(bit-shift-right byte 4) (bit-and byte 0x0F)])

   473 

   474 (defn bootstrap-pattern

   475   "Given an assembly sequence, generate the keypresses required to

   476    create that sequence in memory using the pc-item-writer

   477    program. The assembly must not have any consecutive repeating

   478    nybbles."

   479   [assembly]

   480   (let [nybbles (flatten (map byte->nybbles assembly))

   481         moves (map (comp buttons (partial - 15)) nybbles)

   482         header (map buttons

   483                     (concat (repeat

   484                              50

   485                              (- 15 (first nybbles)))

   486                             [(first nybbles)]))

   487         tail (map buttons

   488                   (take

   489                    (- 201 (count moves))

   490                    (interleave (repeat 100 (last nybbles))

   491                                (repeat 1000 (- 15 (last nybbles))))))]

   492     (assert (no-consecutive-repeats? nybbles))

   493     (concat header moves tail)))

   494     

   495 ;;;;;; TESTS ;;;;;;

   496 

   497 (def set-H-mode 0x67)

   498 (def set-L-mode 0x6F)

   499 (def jump-mode  0xE9)

   500 (def write-mode 0x47)

   501 

   502 

   503 (defn bootstrap-base []

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

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

   506     (-> (tick (mid-game))

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

   508         (PC! pokemon-list-start)

   509         (step [])

   510         (step []))))

   511 

   512 (defn test-set-H []

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

   514             (let [after

   515                   (-> state

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

   517                       (step (buttons n))

   518                       (step []))]

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

   520               (assert (= n (H after)))

   521               after))]

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

   523       (println "set H test passed.")

   524       result)))

   525 

   526 (defn test-write-bytes []

   527   (let [target-address 0xC00F

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

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

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

   531                                  target-address (+ target-address 20))

   532         before (bootstrap-base)

   533         after

   534         (-> before

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

   536             (step [])           ; at the beginning.

   537             (step [])                      

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

   539             (step (buttons target-high))

   540             (step [])

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

   542             (step (buttons target-low))

   543             (step [])

   544             (step (buttons write-mode))

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

   546             (step (buttons (nth assembly 0)))

   547             (step (buttons (nth assembly 1)))

   548             (step (buttons (nth assembly 2)))

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

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

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

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

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

   554     after))

   555 

   556 (defn test-jump []

   557   (let [target-address 0xC00F

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

   559         post-jump

   560         (-> (test-write-bytes)

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

   562             (step (buttons target-high))

   563             (step [])

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

   565             (step (buttons target-low))

   566             (step [])

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

   568         program-counters

   569         (capture-program-counter 

   570          post-jump

   571          10000)]

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

   573     (println "jump test passed.")

   574     post-jump))

   575 

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

   577   (bootstrap-pattern (main-bootstrap-program))

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

   579 

   580 (defn run-all-tests []

   581   (test-frame-metronome)

   582   (test-read-user-input)

   583   (test-set-H)

   584   (test-write-bytes)

   585   (test-jump)

   586   (test-no-repeated-nybbles)

   587   (println "\n all tests passed."))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 14 Apr 2012 03:22:10 -0500
parents	55a45f67e4a4
children	f2f1e0b8c1c7