1.1 --- a/clojure/com/aurellem/gb/rlm_assembly.clj	Sat Apr 14 04:09:51 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/rlm_assembly.clj	Sat Apr 14 05:41:55 2012 -0500
     1.3 @@ -224,7 +224,7 @@
     1.4    (if (< n 0)
     1.5      (+ 256 n) n))
     1.6  
     1.7 -(defn frame-metronome** []
     1.8 +(defn frame-metronome []
     1.9    (let [init [0xC5] ;; save value of BC
    1.10          timing-loop
    1.11          [0x01 ; \
    1.12 @@ -247,18 +247,18 @@
    1.13  
    1.14  (defn frame-metronome* []
    1.15    [0x3E   ;; smallest version, but uses repeated nybbles
    1.16 -   0x01    
    1.17 +   0x01
    1.18     0xE0
    1.19     0xFF])
    1.20  
    1.21 -
    1.22 -(defn frame-metronome []
    1.23 +(defn frame-metronome** []
    1.24    [0x06 ;; load 0xFE into B
    1.25     0xFE
    1.26     0x04 ;; inc B, now B == FF
    1.27 -   0x3E
    1.28 +
    1.29 +   0x3E ;;  RLM-debug
    1.30     0x01 ;; 1->A
    1.31 -   
    1.32 +  
    1.33     0x48 ;; B->C
    1.34     0x02]) ;; A->(BC) set exclusive v-blank interrupt
    1.35  
    1.36 @@ -266,8 +266,10 @@
    1.37    "Ensure that frame-metronome ticks exactly once every frame."
    1.38    ([] (test-frame-metronome 151))
    1.39    ([steps]
    1.40 -     (let [inc-E [0x1C 0x76 0x18 
    1.41 -                  (->signed-8-bit -4)]
    1.42 +     (let [inc-E [0x1C 0x18 
    1.43 +                  (->signed-8-bit
    1.44 +                   (+ -3
    1.45 +                      (-(count (frame-metronome)))))]
    1.46                     
    1.47             program (concat (frame-metronome) inc-E)
    1.48             count-frames
    1.49 @@ -284,10 +286,7 @@
    1.50         count-frames)))
    1.51  
    1.52  (defn read-user-input []
    1.53 -  [0xAF 0x4F 0x47 ;; 0->A; 0->C; 0->B
    1.54 -   0xC5 ;; save value of BC
    1.55 -      
    1.56 -   0x3E
    1.57 +  [0x3E
    1.58     0x20 ; prepare to measure d-pad
    1.59  
    1.60     0x3F ; clear carry flag no-op to prevent repeated nybbles
    1.61 @@ -378,7 +377,8 @@
    1.62       ;; multi-action-modes
    1.63       ;; WRITE               0x47 ;; A->B
    1.64  
    1.65 -     (let [header (concat (frame-metronome) (read-user-input))
    1.66 +     (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
    1.67 +           header (concat (frame-metronome) (read-user-input))
    1.68             
    1.69             input
    1.70             [0xC1  ;; pop BC so it's not volatile
    1.71 @@ -409,7 +409,7 @@
    1.72              0x7B ;; E->A
    1.73              0x4F ;; A->C now C stores previous instruction
    1.74              0x18           ;; return
    1.75 -            :to-halt]
    1.76 +            :to-jump]
    1.77             
    1.78             output
    1.79             [:output-start ;; just a label
    1.80 @@ -423,7 +423,6 @@
    1.81  
    1.82              0x23 ;; inc HL 
    1.83              
    1.84 -            0x76 ;; HALT, peasant!
    1.85              0x18
    1.86              :to-beginning] 
    1.87  
    1.88 @@ -433,11 +432,14 @@
    1.89               (disect-bytes-2
    1.90                (+ start-address
    1.91                   (count header)
    1.92 +                 (count init)
    1.93                   (symbol-index :to-be-executed input))))
    1.94              :to-be-executed 0x3F} ;; clear carry flag no-op
    1.95  
    1.96             program** (flatten
    1.97 -                      (replace symbols (concat header input output)))
    1.98 +                      (replace
    1.99 +                       symbols
   1.100 +                       (concat init header input output)))
   1.101             
   1.102             resolve-internal-jumps
   1.103             {:output-start []
   1.104 @@ -451,13 +453,13 @@
   1.105             (flatten (replace resolve-internal-jumps program**))
   1.106             
   1.107             resolve-external-jumps
   1.108 -           {:to-halt
   1.109 +           {:to-jump
   1.110              (- (- (symbol-index :to-beginning program*)
   1.111 -                  (symbol-index :to-halt program*)) 3)
   1.112 +                  (symbol-index :to-jump program*)) 2)
   1.113                 
   1.114              :to-beginning
   1.115              (->signed-8-bit
   1.116 -             (+ 2 (count (frame-metronome))
   1.117 +             (+ (count init) -1
   1.118                  (- (symbol-index :to-beginning program*))))}
   1.119  
   1.120             program

     2.1 --- a/clojure/com/aurellem/run/bootstrap_1.clj	Sat Apr 14 04:09:51 2012 -0500
     2.2 +++ b/clojure/com/aurellem/run/bootstrap_1.clj	Sat Apr 14 05:41:55 2012 -0500
     2.3 @@ -779,18 +779,18 @@
     2.4                         0xD162 (+ 0xD162 (count pattern)))
     2.5            pattern))))
     2.6  
     2.7 -(defn launch-main-bootstrap-program
     2.8 +(defn-memo launch-main-bootstrap-program
     2.9    ([] (launch-main-bootstrap-program
    2.10         (control-checkpoint)
    2.11         ;;(launch-bootstrap-program)
    2.12         ))
    2.13    ([script]
    2.14 -     (->> script
    2.15 -          (play-moves
    2.16 -           (bootstrap-pattern (main-bootstrap-program)))
    2.17 -          (play-moves
    2.18 -           (take 263 (interleave (repeat 1000 [:b])
    2.19 -                                 (repeat 1000 [])))))))
    2.20 +       (->> script
    2.21 +            (play-moves
    2.22 +             (bootstrap-pattern (main-bootstrap-program)))
    2.23 +            (play-moves
    2.24 +             (take 253 (interleave (repeat 1000 [:b])
    2.25 +                                   (repeat 1000 [])))))))
    2.26  
    2.27  (defn test-main-bootstrap-integrety
    2.28    []
    2.29 @@ -811,17 +811,32 @@
    2.30            (map buttons
    2.31                 [set-H-mode target-high 0x00
    2.32                  set-L-mode target-low  0x00])))))
    2.33 -                
    2.34 +
    2.35 +(defn write-RAM-segment
    2.36 +  "Assumes that the game is under control of the main-bootstrap
    2.37 +   program in MODE-SELECT mode and that target-address has been
    2.38 +   appropriately set, and writes 255 bytes or less to RAM."
    2.39 +  [segment script]
    2.40 +  (->> script
    2.41 +       (play-moves
    2.42 +        (map buttons
    2.43 +             [write-mode (count segment)]))
    2.44 +       (play-moves (map buttons segment))
    2.45 +       (play-moves [[]])))
    2.46 +
    2.47  (defn write-RAM
    2.48    "Assumes that the game is under control of the main-bootstrap
    2.49     program in MODE-SELECT mode, and rewrites RAM starting at
    2.50     'start-address with 'new-ram."
    2.51    [start-address new-ram script]
    2.52 -  (->> script
    2.53 -       (set-target-address start-address)
    2.54 -       (play-moves [(buttons (count new-ram))])
    2.55 -       (play-moves (map buttons new-ram))))
    2.56 -
    2.57 +  (loop [s (set-target-address start-address script)
    2.58 +         to-write new-ram]
    2.59 +    (if (< (count to-write) 0x100)
    2.60 +      (write-RAM-segment to-write s)
    2.61 +      (recur
    2.62 +       (write-RAM-segment (take 0xFF to-write) s)
    2.63 +       (drop 0xFF to-write)))))
    2.64 +          
    2.65  (defn transfer-control
    2.66    "Assumes that the game is under control of the main-bootstrap
    2.67     program in MODE-SELECT mode, and jumps to the target-address."
    2.68 @@ -830,17 +845,23 @@
    2.69         (set-target-address target-address)
    2.70         (play-moves [(buttons jump-mode)])))
    2.71  
    2.72 -(defn relocate-main-bootstrap
    2.73 +(def box-target (+ 90 pokemon-box-1-address))
    2.74 +
    2.75 +(defn-memo relocate-main-bootstrap
    2.76    ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
    2.77    ([script]
    2.78       (let [target (+ 90 pokemon-box-1-address)]
    2.79         (->> script
    2.80 -            (do-nothing 500)))))
    2.81 +            (do-nothing 2)
    2.82 +            (write-RAM target (main-bootstrap-program target))
    2.83 +            (do-nothing 1)
    2.84 +            (transfer-control target)
    2.85 +            (do-nothing 1)))))
    2.86  
    2.87  (def mid-game-data
    2.88    (subvec (vec (memory (mid-game)))
    2.89            pokemon-list-start
    2.90 -          (+ pokemon-list-start 100)))
    2.91 +          (+ pokemon-list-start 697)))
    2.92  
    2.93  (def mid-game-map-address 0x46BC)
    2.94  
    2.95 @@ -849,9 +870,39 @@
    2.96    ([script]
    2.97       (->> script
    2.98            (do-nothing 10)
    2.99 -          (write-RAM pokemon-list-start mid-game-data))))
   2.100 +          (write-RAM pokemon-list-start
   2.101 +                     mid-game-data))))
   2.102 +(defn test-set-data
   2.103 +  ([] (test-set-data (relocate-main-bootstrap)))
   2.104 +  ([script]
   2.105 +     (->> script
   2.106 +          (do-nothing 10)
   2.107 +          (write-RAM pokemon-list-start
   2.108 +                     (repeat 500 0xCC)))))
   2.109 +      
   2.110 +(defn test-mid-game-transfer []
   2.111 +  (= (subvec (vec (memory (second (set-mid-game-data))))
   2.112 +             pokemon-list-start
   2.113 +             (+ pokemon-list-start 500))
   2.114 +     (subvec (vec (memory (mid-game)))
   2.115 +             pokemon-list-start
   2.116 +             (+ pokemon-list-start 500))))
   2.117  
   2.118 -
   2.119 +(defn return-to-pokemon-kernel
   2.120 +  ([] (return-to-pokemon-kernel (set-mid-game-data)))
   2.121 +  ([script]
   2.122 +     (let [scratch (+ 200 pokemon-box-1-address)
   2.123 +           return-program
   2.124 +           (flatten
   2.125 +            [0xFB
   2.126 +             0xC3
   2.127 +             (reverse (disect-bytes-2 mid-game-map-address))])]
   2.128 +       (->> script
   2.129 +            (write-RAM scratch return-program)
   2.130 +            (transfer-control scratch)
   2.131 +            (do-nothing 1)))))
   2.132 +                                              
   2.133 +       
   2.134  
   2.135  
   2.136         

     3.1 Binary file moves/temp.vbm has changed