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 bootstrap-state-machine

   359   ([start-address]

   360      ;; Register Use:

   361      

   362      ;; ED non-volitale scratch

   363      

   364      ;; A  user-input (A MUST contain user-input for this to work!) 

   365      ;; HL target-address

   366      ;; B  bytes-to-write

   367      ;; C  non-volatile scratch

   368 

   369      ;; Modes (with codes) are:

   370 

   371      ;; single-action-modes:

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

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

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

   375 

   376      ;; multi-action-modes

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

   378      (let [

   379            input

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

   381 

   382             0x5F  ;; A->E

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

   384             0xB8  ;; (cp A B)

   385             0x7B  ;; E->A

   386             0x20       ;; skip to output section if

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

   388             

   389             :to-be-executed

   390 

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

   392             0xEA

   393             :to-be-executed-address

   394 

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

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

   397             0x79 ;; C->A

   398             0xA7 ;; test A==0

   399             0x28

   400             0x04

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

   402             0xEA ;; 

   403             :to-be-executed-address

   404             

   405             0x7B ;; E->A

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

   407             0x18           ;; return

   408             :to-jump]

   409            

   410            output

   411            [:output-start ;; just a label

   412             0x3F ;; ;; prevent repeated nybbles

   413             0x54 ;;

   414             0x5D ;; HL->DE  \

   415             ;;          | This mess is here to do

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

   417             ;;         /  any repeating nybbles

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

   419 

   420             0x23 ;; inc HL 

   421             ]

   422         

   423            symbols

   424            {:to-be-executed-address

   425             (reverse

   426              (disect-bytes-2

   427               (+ start-address

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

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

   430 

   431            program** (flatten

   432                       (replace

   433                        symbols

   434                        (concat input output)))

   435            

   436            resolve-internal-jumps

   437            {:output-start []

   438             :to-output

   439             (->signed-8-bit

   440              (dec

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

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

   443 

   444            program*

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

   446            

   447            resolve-external-jumps

   448            {:to-jump

   449             (- (- (count program*)

   450                   (symbol-index :to-jump program*)) 1)}

   451            program

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

   453        program)))

   454      

   455 

   456 (defn main-bootstrap-program

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

   458   ([start-address]

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

   460            header (concat (frame-metronome) (read-user-input))

   461            state-machine-start-address

   462            (+ start-address (count init) (count header))

   463            state-machine

   464            (bootstrap-state-machine state-machine-start-address)

   465 

   466            return-to-header

   467            (flatten 

   468             [0x18

   469              (->signed-8-bit

   470               (- (count init)

   471                  2 ;; this command length

   472                  3 ;; I have no idea why we need a 3 here

   473                    ;; need to investigate.

   474                  (count header)

   475                  (count state-machine)))])]

   476                  

   477        (concat init header state-machine return-to-header))))

   478 

   479 

   480 

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

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

   483 

   484 (defn byte->nybbles [byte]

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

   486 

   487 (defn bootstrap-pattern

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

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

   490    program. The assembly must not have any consecutive repeating

   491    nybbles."

   492   [assembly]

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

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

   495         header (map buttons

   496                     (concat (repeat

   497                              50

   498                              (- 15 (first nybbles)))

   499                             [(first nybbles)]))]

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

   501     (concat header moves)))

   502     

   503 ;;;;;; TESTS ;;;;;;

   504 

   505 (def set-H-mode 0x67)

   506 (def set-L-mode 0x6F)

   507 (def jump-mode  0xE9)

   508 (def write-mode 0x47)

   509 

   510 

   511 (defn bootstrap-base []

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

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

   514     (-> (tick (mid-game))

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

   516         (PC! pokemon-list-start)

   517         (step [])

   518         (step []))))

   519 

   520 (defn test-set-H []

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

   522             (let [after

   523                   (-> state

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

   525                       (step (buttons n))

   526                       (step []))]

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

   528               (assert (= n (H after)))

   529               after))]

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

   531       (println "set H test passed.")

   532       result)))

   533 

   534 (defn test-write-bytes []

   535   (let [target-address 0xC00F

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

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

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

   539                                  target-address (+ target-address 20))

   540         before (bootstrap-base)

   541         after

   542         (-> before

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

   544             (step [])           ; at the beginning.

   545             (step [])                      

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

   547             (step (buttons target-high))

   548             (step [])

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

   550             (step (buttons target-low))

   551             (step [])

   552             (step (buttons write-mode))

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

   554             (step (buttons (nth assembly 0)))

   555             (step (buttons (nth assembly 1)))

   556             (step (buttons (nth assembly 2)))

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

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

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

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

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

   562     after))

   563 

   564 (defn test-jump []

   565   (let [target-address 0xC00F

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

   567         post-jump

   568         (-> (test-write-bytes)

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

   570             (step (buttons target-high))

   571             (step [])

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

   573             (step (buttons target-low))

   574             (step [])

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

   576         program-counters

   577         (capture-program-counter 

   578          post-jump

   579          10000)]

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

   581     (println "jump test passed.")

   582     post-jump))

   583 

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

   585   (bootstrap-pattern (main-bootstrap-program))

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

   587 

   588 (defn run-all-tests []

   589   (test-frame-metronome)

   590   (test-read-user-input)

   591   (test-set-H)

   592   (test-write-bytes)

   593   (test-jump)

   594   (test-no-repeated-nybbles)

   595   (println "\n all tests passed."))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 01 Sep 2012 03:09:31 -0500
parents	9068685e7d96
children	96ee9d72aeb9