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 75

    10         limit 201 ;; (item-hack 201 is the smallest I could make this.) 

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

    12     (flatten

    13      [[0x00  ;; (item-hack) no-op (can't buy repel (1E) at celadon)

    14        0x1E  ;; load limit into E

    15        limit

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

    17 

    18        ;; load 2 into C.

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

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

    21 

    22        0x21 ;; load target into HL

    23        target-low

    24        target-high

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

    26 

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

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

    29        

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

    31        0xF3 ;; disable interrupts

    32        ;; Input Section

    33 

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

    35        0x10 

    36 

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

    38        0xE0 ;; load A into [FF00]

    39        0x00

    40 

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

    42        0x00 ;; button presses

    43        

    44        0xE6

    45        0x0F ;; select bottom four bits of A

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

    47 

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

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

    50 

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

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

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

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

    55 

    56        0x47 ;; load A into B

    57        

    58        0x0D ;; dec C

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

    60        ;; branch based on C:

    61        0x20 ;; JR NZ

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

    63        

    64        ;; input second nybble

    65 

    66        0x0C ;; inc C

    67        0x0C ;; inc C

    68 

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

    70        0xE6 ;; select bottom bits

    71        0x0F

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

    73 

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

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

    76 

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

    78 

    79        0x1D ;; (DEC E)

    80 

    81        0x00 ;; (item-hack) 

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

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

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

    85 

    86        ;; jump to target

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

    88        0x01 

    89 

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

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

    92        

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

    94        target-low

    95        target-high

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

    97        

    98        ;; input first nybble

    99        0x00

   100        0xCB

   101        0x37  ;; swap nybbles on A

   102 

   103        0x57  ;; A -> D

   104 

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

   106        0x18  ;; relative jump backwards

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

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

   109 

   110        ]

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

   112 

   113       [;; jump to actual program

   114        0x00

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

   116 

   117        0x2E  ;; 0x3A -> L

   118        0x3A

   119 

   120 

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

   122        0x26  ;; 0xD5 -> L

   123        0xD5  

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

   125 

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

   127        0x01  

   128 

   129        0x00

   130        0xE9 ;; jump to (HL)

   131        ]])))

   132 

   133 

   134 

   135 ;; Specs for Main Bootstrap Program

   136 

   137 ;; Number-Input

   138 ;; Number input works using all eight buttons to

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

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

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

   142 

   143 ;;; MODES

   144 ;; There are five modes in total:

   145 ;;   MODE-SELECT

   146 ;;   SET-H

   147 ;;   SET-L

   148 ;;   WRITE

   149 ;;   JUMP

   150 

   151 ;;; MODE-SELECT

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

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

   154 ;;   on which buttons are pressed:

   155 ;;       0   :  MODE-SELECT

   156 ;;    0x67   :  SET-H

   157 ;;    0x6F   :  SET-L

   158 ;;    0x47   :  WRITE

   159 ;;    0xE9   :  JUMP

   160 

   161 ;;; SET-H

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

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

   164 ;;   the following:

   165 ;;

   166 ;;    Byte 0 : New Value of H

   167 ;;    Byte 1 : 0x00

   168 

   169 ;;; SET-L

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

   171 ;;   the same semantics as SET-H.

   172 

   173 ;;; WRITE-BYTES

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

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

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

   177 

   178 ;;    Byte 0  : Number of Bytes to Write

   179 

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

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

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

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

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

   185 

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

   187 ;;   the target address enter:

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

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

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

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

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

   193 

   194 ;;; JUMP 

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

   196 

   197 ;;; EXAMPLE

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

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

   200 ;;   starting from MODE-SELECT mode.

   201 

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

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

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

   205 

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

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

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

   209 

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

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

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

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

   214 

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

   216 ;;    set it back to 0xC00F.

   217 

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

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

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

   221 

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

   223 

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

   225   (if (< n 0)

   226     (+ 256 n) n))

   227 

   228 (defn frame-metronome []

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

   230         timing-loop

   231         [0x01 ; \

   232          0x43 ;  |

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

   234          0x0C ;  |

   235          0x04 ; /

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

   237         continue-if-144

   238         [0xFE

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

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

   241          (->signed-8-bit

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

   243         spin-loop

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

   245          0x20 ;; spin until B==0

   246          0xFD]]

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

   248 

   249 (defn frame-metronome* []

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

   251    0x01

   252    0xE0

   253    0xFF])

   254 

   255 (defn frame-metronome** []

   256   [0x06 ;; load 0xFE into B

   257    0xFE

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

   259 

   260    0x3E ;;  RLM-debug

   261    0x01 ;; 1->A

   262   

   263    0x48 ;; B->C

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

   265 

   266 (defn test-frame-metronome

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

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

   269   ([steps]

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

   271                   (->signed-8-bit

   272                    (+ -3

   273                       (-(count (frame-metronome)))))]

   274                    

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

   276            count-frames

   277            (-> (tick (mid-game))

   278                (IE! 0)

   279                (DE! 0)

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

   281                (PC! pokemon-list-start))

   282            E-after-moves

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

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

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

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

   287        count-frames)))

   288 

   289 (defn read-user-input []

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

   360   ([start-address]

   361      ;; Register Use:

   362      

   363      ;; ED non-volitale scratch

   364      

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

   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      (let [

   380            input

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

   382 

   383             0x5F  ;; A->E

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

   385             0xB8  ;; (cp A B)

   386             0x7B  ;; E->A

   387             0x20       ;; skip to output section if

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

   389             

   390             :to-be-executed

   391 

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

   393             0xEA

   394             :to-be-executed-address

   395 

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

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

   398             0x79 ;; C->A

   399             0xA7 ;; test A==0

   400             0x28

   401             0x04

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

   403             0xEA ;; 

   404             :to-be-executed-address

   405             

   406             0x7B ;; E->A

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

   408             0x18           ;; return

   409             :to-jump]

   410            

   411            output

   412            [:output-start ;; just a label

   413             0x3F ;; ;; prevent repeated nybbles

   414             0x54 ;;

   415             0x5D ;; HL->DE  \

   416             ;;          | This mess is here to do

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

   418             ;;         /  any repeating nybbles

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

   420 

   421             0x23 ;; inc HL 

   422             ]

   423         

   424            symbols

   425            {:to-be-executed-address

   426             (reverse

   427              (disect-bytes-2

   428               (+ start-address

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

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

   431 

   432            program** (flatten

   433                       (replace

   434                        symbols

   435                        (concat input output)))

   436            

   437            resolve-internal-jumps

   438            {:output-start []

   439             :to-output

   440             (->signed-8-bit

   441              (dec

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

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

   444 

   445            program*

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

   447            

   448            resolve-external-jumps

   449            {:to-jump

   450             (- (- (count program*)

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

   452            program

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

   454        program)))

   455      

   456 

   457 (defn main-bootstrap-program

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

   459   ([start-address]

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

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

   462            state-machine-start-address

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

   464            state-machine

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

   466 

   467            return-to-header

   468            (flatten 

   469             [0x18

   470              (->signed-8-bit

   471               (- (count init)

   472                  2 ;; this command length

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

   474                    ;; need to investigate.

   475                  (count header)

   476                  (count state-machine)))])]

   477                  

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

   479 

   480 

   481 

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

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

   484 

   485 (defn byte->nybbles [byte]

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

   487 

   488 (defn bootstrap-pattern

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

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

   491    program. The assembly must not have any consecutive repeating

   492    nybbles."

   493   [assembly]

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

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

   496         header (map buttons

   497                     (concat (repeat

   498                              23 ;; found by manual binary search

   499                              (- 15 (first nybbles)))

   500                             [(first nybbles)]))]

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

   502     (concat header moves)))

   503     

   504 ;;;;;; TESTS ;;;;;;

   505 

   506 (def set-H-mode 0x67)

   507 (def set-L-mode 0x6F)

   508 (def jump-mode  0xE9)

   509 (def write-mode 0x47)

   510 

   511 

   512 (defn bootstrap-base []

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

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

   515     (-> (tick (mid-game))

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

   517         (PC! pokemon-list-start)

   518         (step [])

   519         (step []))))

   520 

   521 (defn test-set-H []

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

   523             (let [after

   524                   (-> state

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

   526                       (step (buttons n))

   527                       (step []))]

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

   529               (assert (= n (H after)))

   530               after))]

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

   532       (println "set H test passed.")

   533       result)))

   534 

   535 (defn test-write-bytes []

   536   (let [target-address 0xC00F

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

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

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

   540                                  target-address (+ target-address 20))

   541         before (bootstrap-base)

   542         after

   543         (-> before

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

   545             (step [])           ; at the beginning.

   546             (step [])                      

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

   548             (step (buttons target-high))

   549             (step [])

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

   551             (step (buttons target-low))

   552             (step [])

   553             (step (buttons write-mode))

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

   555             (step (buttons (nth assembly 0)))

   556             (step (buttons (nth assembly 1)))

   557             (step (buttons (nth assembly 2)))

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

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

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

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

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

   563     after))

   564 

   565 (defn test-jump []

   566   (let [target-address 0xC00F

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

   568         post-jump

   569         (-> (test-write-bytes)

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

   571             (step (buttons target-high))

   572             (step [])

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

   574             (step (buttons target-low))

   575             (step [])

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

   577         program-counters

   578         (capture-program-counter 

   579          post-jump

   580          10000)]

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

   582     (println "jump test passed.")

   583     post-jump))

   584 

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

   586   (bootstrap-pattern (main-bootstrap-program))

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

   588 

   589 (defn run-all-tests []

   590   (test-frame-metronome)

   591   (test-read-user-input)

   592   (test-set-H)

   593   (test-write-bytes)

   594   (test-jump)

   595   (test-no-repeated-nybbles)

   596   (println "\n all tests passed."))
author	rlm <rlm@aurellem.org>
date	Sun, 07 Feb 2016 23:16:04 -0800
parents	747d47d96d2f
children