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 (defn frame-metronome** []

   255   [0x06 ;; load 0xFE into B

   256    0xFE

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

   258 

   259    0x3E ;;  RLM-debug

   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 0x18 

   270                   (->signed-8-bit

   271                    (+ -3

   272                       (-(count (frame-metronome)))))]

   273                    

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

   275            count-frames

   276            (-> (tick (mid-game))

   277                (IE! 0)

   278                (DE! 0)

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

   280                (PC! pokemon-list-start))

   281            E-after-moves

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

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

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

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

   286        count-frames)))

   287 

   288 (defn read-user-input []

   289   [0x3E

   290    0x20 ; prepare to measure d-pad

   291 

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

   293    

   294    0x01 ;\

   295    0x01 ; |

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

   297    0x04 ; |

   298    0x0D ;/

   299    

   300    0x02 

   301    0x0A ;; get D-pad info

   302    

   303    0xF5 ;; push AF

   304       

   305    0x3E

   306    0x10 ; prepare to measure buttons

   307 

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

   309    

   310    0x02

   311    0x0A ;; get button info

   312    

   313    0xE6 ;; select bottom bits of A

   314    0x0F

   315 

   316    0x47 ;; A->B

   317 

   318    0xF1 ;; pop AF

   319 

   320    0xE6

   321    0x0F ;; select bottom bits of A

   322 

   323    0xCB

   324    0x37 ;; swap A nybbles

   325 

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

   327  

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

   329    ])

   330 

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

   332   (let [program

   333         (concat

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

   335          [0x5F ;; A-> E

   336           0x76

   337           0x18

   338           (->signed-8-bit

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

   340               (- 4)))])

   341         read-input

   342         (-> (tick (mid-game))

   343             (IE! 0)

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

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

   346     (dorun

   347      (for [i (range 0x100)]

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

   349      (println "tested all inputs.")

   350     read-input))

   351 

   352 (def symbol-index

   353   (fn [symbol sequence]

   354     (count (take-while

   355             (partial not= symbol)

   356             sequence))))

   357 

   358 (defn main-bootstrap-program

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

   360   ([start-address]

   361      ;; Register Use:

   362      

   363      ;; ED non-volitale scratch

   364      

   365      ;; A  user-input

   366      ;; HL target-address

   367      ;; B  bytes-to-write

   368      ;; C  non-volatile scratch

   369 

   370      ;; Modes (with codes) are:

   371 

   372      ;; single-action-modes:

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

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

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

   376 

   377      ;; multi-action-modes

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

   379 

   380      (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B

   381            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-jump]

   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             0x18

   427             :to-beginning] 

   428 

   429            symbols

   430            {:to-be-executed-address

   431             (reverse

   432              (disect-bytes-2

   433               (+ start-address

   434                  (count header)

   435                  (count init)

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

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

   438 

   439            program** (flatten

   440                       (replace

   441                        symbols

   442                        (concat init header input output)))

   443            

   444            resolve-internal-jumps

   445            {:output-start []

   446             :to-output

   447             (->signed-8-bit

   448              (dec

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

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

   451 

   452            program*

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

   454            

   455            resolve-external-jumps

   456            {:to-jump

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

   458                   (symbol-index :to-jump program*)) 2)

   459                

   460             :to-beginning

   461             (->signed-8-bit

   462              (+ (count init) -1

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

   464 

   465            program

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

   467        program)))

   468 

   469 

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

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

   472 

   473 (defn byte->nybbles [byte]

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

   475 

   476 (defn bootstrap-pattern

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

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

   479    program. The assembly must not have any consecutive repeating

   480    nybbles."

   481   [assembly]

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

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

   484         header (map buttons

   485                     (concat (repeat

   486                              50

   487                              (- 15 (first nybbles)))

   488                             [(first nybbles)]))]

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

   490     (concat header moves)))

   491     

   492 ;;;;;; TESTS ;;;;;;

   493 

   494 (def set-H-mode 0x67)

   495 (def set-L-mode 0x6F)

   496 (def jump-mode  0xE9)

   497 (def write-mode 0x47)

   498 

   499 

   500 (defn bootstrap-base []

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

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

   503     (-> (tick (mid-game))

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

   505         (PC! pokemon-list-start)

   506         (step [])

   507         (step []))))

   508 

   509 (defn test-set-H []

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

   511             (let [after

   512                   (-> state

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

   514                       (step (buttons n))

   515                       (step []))]

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

   517               (assert (= n (H after)))

   518               after))]

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

   520       (println "set H test passed.")

   521       result)))

   522 

   523 (defn test-write-bytes []

   524   (let [target-address 0xC00F

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

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

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

   528                                  target-address (+ target-address 20))

   529         before (bootstrap-base)

   530         after

   531         (-> before

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

   533             (step [])           ; at the beginning.

   534             (step [])                      

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

   536             (step (buttons target-high))

   537             (step [])

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

   539             (step (buttons target-low))

   540             (step [])

   541             (step (buttons write-mode))

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

   543             (step (buttons (nth assembly 0)))

   544             (step (buttons (nth assembly 1)))

   545             (step (buttons (nth assembly 2)))

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

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

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

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

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

   551     after))

   552 

   553 (defn test-jump []

   554   (let [target-address 0xC00F

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

   556         post-jump

   557         (-> (test-write-bytes)

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

   559             (step (buttons target-high))

   560             (step [])

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

   562             (step (buttons target-low))

   563             (step [])

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

   565         program-counters

   566         (capture-program-counter 

   567          post-jump

   568          10000)]

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

   570     (println "jump test passed.")

   571     post-jump))

   572 

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

   574   (bootstrap-pattern (main-bootstrap-program))

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

   576 

   577 (defn run-all-tests []

   578   (test-frame-metronome)

   579   (test-read-user-input)

   580   (test-set-H)

   581   (test-write-bytes)

   582   (test-jump)

   583   (test-no-repeated-nybbles)

   584   (println "\n all tests passed."))
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 03 May 2012 06:45:26 -0500
parents	21b8b3350b20
children	9068685e7d96