1.1 --- a/clojure/com/aurellem/gb/rlm_assembly.clj	Fri Apr 13 09:47:34 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/rlm_assembly.clj	Fri Apr 13 09:59:32 2012 -0500
     1.3 @@ -70,26 +70,30 @@
     1.4    (if (< n 0)
     1.5      (+ 256 n) n))
     1.6  
     1.7 -(defn frame-metronome []
     1.8 -  (let [init [0xC5] ;; save value of BC
     1.9 -        timing-loop
    1.10 -        [0x01 ; \
    1.11 -         0x43 ;  |
    1.12 -         0xFE ;  |  load 0xFF44 into BC without repeats
    1.13 -         0x0C ;  |
    1.14 -         0x04 ; /
    1.15 -         0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
    1.16 -        continue-if-144
    1.17 -        [0xFE
    1.18 -         144     ;; compare LY (in A) with 144
    1.19 -         0x20    ;; jump back to beginning if LY != 144 (not-v-blank)
    1.20 -         (->signed-8-bit
    1.21 -          (+ -4 (- (count timing-loop))))]
    1.22 -        spin-loop
    1.23 -        [0x05 ;; dec B, which is 0xFF
    1.24 -         0x20 ;; spin until B==0
    1.25 -         0xFD]]
    1.26 -    (concat init timing-loop continue-if-144 spin-loop)))
    1.27 +(defn frame-metronome
    1.28 +  ([] (frame-metronome true))
    1.29 +  ([spin-loop?]
    1.30 +     (let [init [0xC5] ;; save value of BC
    1.31 +           timing-loop
    1.32 +           [0x01 ; \
    1.33 +            0x43 ;  |
    1.34 +            0xFE ;  |  load 0xFF44 into BC without repeats
    1.35 +            0x0C ;  |
    1.36 +            0x04 ; /
    1.37 +            0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
    1.38 +           continue-if-144
    1.39 +           [0xFE
    1.40 +            144     ;; compare LY (in A) with 144
    1.41 +            0x20    ;; jump back to beginning if LY != 144 (not-v-blank)
    1.42 +            (->signed-8-bit
    1.43 +             (+ -4 (- (count timing-loop))))]
    1.44 +           spin-loop
    1.45 +           [0x05 ;; dec B, which is 0xFF
    1.46 +            0x20 ;; spin until B==0
    1.47 +            0xFD]]
    1.48 +       (concat init timing-loop continue-if-144
    1.49 +               (if spin-loop?
    1.50 +                 spin-loop [])))))
    1.51  
    1.52  (defn test-frame-metronome
    1.53    "Ensure that frame-metronome ticks exactly once every frame."
    1.54 @@ -182,118 +186,119 @@
    1.55              (partial not= symbol)
    1.56              sequence))))
    1.57  
    1.58 +(defn main-bootstrap-program
    1.59 +  ([] (main-bootstrap-program pokemon-list-start))
    1.60 +  ([start-address]
    1.61 +     ;; Register Use:
    1.62 +     
    1.63 +     ;; ED non-volitale scratch
    1.64 +     
    1.65 +     ;; A  user-input
    1.66 +     ;; HL target-address
    1.67 +     ;; B  bytes-to-write
    1.68 +     ;; C  non-volatile scratch
    1.69  
    1.70 -(defn main-bootstrap-program [start-address]
    1.71 -  ;; Register Use:
    1.72 -  
    1.73 -  ;; ED non-volitale scratch
    1.74 -  
    1.75 -  ;; A  user-input
    1.76 -  ;; HL target-address
    1.77 -  ;; B  bytes-to-write
    1.78 -  ;; C  non-volatile scratch
    1.79 +     ;; Modes (with codes) are:
    1.80  
    1.81 -  ;; Modes (with codes) are:
    1.82 +     ;; single-action-modes:
    1.83 +     ;; SET-TARGET-HIGH     0x67 ;; A->H
    1.84 +     ;; SET-TARGET-LOW      0x6F ;; A->L
    1.85 +     ;; JUMP                0xE9 ;; jump to (HL)
    1.86  
    1.87 -  ;; single-action-modes:
    1.88 -  ;; SET-TARGET-HIGH     0x67 ;; A->H
    1.89 -  ;; SET-TARGET-LOW      0x6F ;; A->L
    1.90 -  ;; JUMP                0xE9 ;; jump to (HL)
    1.91 +     ;; multi-action-modes
    1.92 +     ;; WRITE               0x47 ;; A->B
    1.93  
    1.94 -  ;; multi-action-modes
    1.95 -  ;; WRITE               0x47 ;; A->B
    1.96 +     (let [[start-high start-low] (disect-bytes-2 start-address)
    1.97 +           jump-distance (+ (count (frame-metronome))
    1.98 +                            (count (read-user-input)))
    1.99  
   1.100 -  (let [[start-high start-low] (disect-bytes-2 start-address)
   1.101 -        jump-distance (+ (count (frame-metronome))
   1.102 -                         (count (read-user-input)))
   1.103 +           init
   1.104 +           [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
   1.105  
   1.106 -        init
   1.107 -        [0xAF 0x4F 0x57 0x47] ;; 0->A; 0->C; 0->D; 0->B
   1.108 +           input
   1.109 +           [0xC1  ;; pop BC so it's not volatile
   1.110  
   1.111 -        input
   1.112 -        [0xC1  ;; pop BC so it's not volatile
   1.113 +            0x5F  ;; A->E
   1.114 +            0xAF  ;; test for output-mode (bytes-to-write > 0)
   1.115 +            0xB8  ;; (cp A B)
   1.116 +            0x7B  ;; E->A
   1.117 +            0x20       ;; skip to output section if
   1.118 +            :to-output ;; we're not in input mode 
   1.119 +            
   1.120 +            :to-be-executed
   1.121  
   1.122 -         0x5F  ;; A->E
   1.123 -         0xAF  ;; test for output-mode (bytes-to-write > 0)
   1.124 -         0xB8  ;; (cp A B)
   1.125 -         0x7B  ;; E->A
   1.126 -         0x20       ;; skip to output section if
   1.127 -         :to-output ;; we're not in input mode 
   1.128 -       
   1.129 -         :to-be-executed
   1.130 +            ;; write mode to instruction-to-be-executed (pun)
   1.131 +            0xEA
   1.132 +            :to-be-executed-address
   1.133  
   1.134 -         ;; write mode to instruction-to-be-executed (pun)
   1.135 -         0xEA
   1.136 -         :to-be-executed-address
   1.137 +            ;; protection region -- do not queue this op for
   1.138 +            ;; execution if the last one was non-zero
   1.139 +            0x79 ;; C->A
   1.140 +            0xA7 ;; test A==0
   1.141 +            0x28
   1.142 +            0x04
   1.143 +            0xAF ;; put a no op (0x00) in to-be-executed
   1.144 +            0xEA ;; 
   1.145 +            :to-be-executed-address
   1.146 +            
   1.147 +            0x7B ;; E->A
   1.148 +            0x4F ;; A->C now C stores previous instruction
   1.149 +            0x18           ;; return
   1.150 +            :to-beginning-1]
   1.151 +           
   1.152 +           output
   1.153 +           [:output-start ;; just a label
   1.154 +            0x54 ;;
   1.155 +            0x5D ;; HL->DE  \
   1.156 +            ;;          | This mess is here to do
   1.157 +            0x12 ;; A->(DE)  | 0x22 (LDI (HL), A) without
   1.158 +            ;;          | any repeating nybbles
   1.159 +            0x23 ;; inc HL  /
   1.160  
   1.161 -         ;; protection region -- do not queue this op for
   1.162 -         ;; execution if the last one was non-zero
   1.163 -         0x79 ;; C->A
   1.164 -         0xA7 ;; test A==0
   1.165 -         0x28
   1.166 -         0x04
   1.167 -         0xAF ;; put a no op (0x00) in to-be-executed
   1.168 -         0xEA ;; 
   1.169 -         :to-be-executed-address
   1.170 -         
   1.171 -         0x7B ;; E->A
   1.172 -         0x4F ;; A->C now C stores previous instruction
   1.173 -         0x18           ;; return
   1.174 -         :to-beginning-1]
   1.175 -        
   1.176 -        output
   1.177 -        [:output-start ;; just a label
   1.178 -         0x54 ;;
   1.179 -         0x5D ;; HL->DE  \
   1.180 -              ;;          | This mess is here to do
   1.181 -         0x12 ;; A->(DE)  | 0x22 (LDI (HL), A) without
   1.182 -              ;;          | any repeating nybbles
   1.183 -         0x23 ;; inc HL  /
   1.184 +            0x05 ;; DEC bytes-to-write (B)
   1.185  
   1.186 -         0x05 ;; DEC bytes-to-write (B)
   1.187 +            0x18
   1.188 +            :to-beginning-2]
   1.189 +           
   1.190 +           symbols
   1.191 +           {:to-be-executed-address
   1.192 +            (reverse
   1.193 +             (disect-bytes-2
   1.194 +              (+ start-address jump-distance
   1.195 +                 (count init)
   1.196 +                 (symbol-index :to-be-executed input))))
   1.197 +            :to-be-executed 0x00} ;; clear carry flag no-op
   1.198  
   1.199 -         0x18
   1.200 -         :to-beginning-2]
   1.201 -        
   1.202 -        symbols
   1.203 -        {:to-be-executed-address
   1.204 -         (reverse
   1.205 -          (disect-bytes-2
   1.206 -           (+ start-address jump-distance
   1.207 -              (count init)
   1.208 -              (symbol-index :to-be-executed input))))
   1.209 -         :to-be-executed 0x00} ;; clear carry flag no-op
   1.210 +           program** (flatten
   1.211 +                      (replace
   1.212 +                       symbols
   1.213 +                       (concat init (frame-metronome)
   1.214 +                               (read-user-input)
   1.215 +                               input output)))
   1.216 +           resolve-internal-jumps
   1.217 +           {:output-start []
   1.218 +            :to-output
   1.219 +            (->signed-8-bit
   1.220 +             (dec
   1.221 +              (- (symbol-index :output-start program**)
   1.222 +                 (symbol-index :to-output program**))))}
   1.223  
   1.224 -        program** (flatten
   1.225 -                  (replace
   1.226 -                   symbols
   1.227 -                   (concat init (frame-metronome)
   1.228 -                           (read-user-input)
   1.229 -                           input output)))
   1.230 -        resolve-internal-jumps
   1.231 -        {:output-start []
   1.232 -         :to-output
   1.233 -         (->signed-8-bit
   1.234 -          (dec
   1.235 -           (- (symbol-index :output-start program**)
   1.236 -              (symbol-index :to-output program**))))}
   1.237 +           program*
   1.238 +           (flatten (replace resolve-internal-jumps program**))
   1.239 +           
   1.240 +           resolve-external-jumps
   1.241 +           {:to-beginning-1
   1.242 +            (->signed-8-bit
   1.243 +             (+ (count init)
   1.244 +                -2 (- (dec (symbol-index :to-beginning-1 program*)))))
   1.245 +            :to-beginning-2
   1.246 +            (->signed-8-bit
   1.247 +             (+ (count init)
   1.248 +                -2 (- (dec (symbol-index :to-beginning-2 program*)))))}
   1.249  
   1.250 -        program*
   1.251 -        (flatten (replace resolve-internal-jumps program**))
   1.252 -        
   1.253 -        resolve-external-jumps
   1.254 -        {:to-beginning-1
   1.255 -         (->signed-8-bit
   1.256 -          (+ (count init)
   1.257 -             -2 (- (dec (symbol-index :to-beginning-1 program*)))))
   1.258 -         :to-beginning-2
   1.259 -         (->signed-8-bit
   1.260 -          (+ (count init)
   1.261 -             -2 (- (dec (symbol-index :to-beginning-2 program*)))))}
   1.262 -
   1.263 -        program
   1.264 -        (replace resolve-external-jumps program*)]
   1.265 -    program))
   1.266 +           program
   1.267 +           (replace resolve-external-jumps program*)]
   1.268 +       program)))
   1.269          
   1.270      
   1.271  ;;;;;; TESTS ;;;;;;
   1.272 @@ -324,8 +329,9 @@
   1.273                ;;(println "desired H =" n "actual =" (H after))
   1.274                (assert (= n (H after)))
   1.275                after))]
   1.276 -    (println "tested all H values")
   1.277 -    (reduce test-H (bootstrap-base) (range 0x100))))
   1.278 +    (let [result (reduce test-H (bootstrap-base) (range 0x100))]
   1.279 +      (println "tested all H values")
   1.280 +      result)))
   1.281  
   1.282  (defn test-write-bytes []
   1.283    (let [target-address 0xC00F