Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/rlm_assembly.clj @ 392:309614263aa9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving progress....
author Robert McIntyre <rlm@mit.edu>
date Thu, 12 Apr 2012 00:52:19 -0500
parents 2e9b2d27f32f
children b21d28e6c966
comparison
equal deleted inserted replaced
391:2e9b2d27f32f 392:309614263aa9
209 ;; multi-action-modes 209 ;; multi-action-modes
210 ;; WRITE 0x47 ;; A->B 210 ;; WRITE 0x47 ;; A->B
211 211
212 (let [[start-high start-low] (disect-bytes-2 start-address) 212 (let [[start-high start-low] (disect-bytes-2 start-address)
213 jump-distance (+ (count (frame-metronome)) 213 jump-distance (+ (count (frame-metronome))
214 (read-user-input)) 214 (count (read-user-input)))
215 215
216 init 216 init
217 [0xAF 0x5F 0x57 0x47] ;; 0->A; 0->E; 0->D; 0->B 217 [0xAF 0x5F 0x57 0x47] ;; 0->A; 0->E; 0->D; 0->B
218 218
219 input 219 input
224 0xAF ;; test for output-mode (bytes-to-write > 0) 224 0xAF ;; test for output-mode (bytes-to-write > 0)
225 0xB8 ;; (cp A B) 225 0xB8 ;; (cp A B)
226 226
227 0x20 ;; skip input section if 227 0x20 ;; skip input section if
228 :to-output ;; we're not in input mode 228 :to-output ;; we're not in input mode
229 229
230
231 :to-be-executed 230 :to-be-executed
232 231
233 232 ;; write mode to instruction-to-be-executed (pun)
234 ;; write mode to instruction to be executed (pun)
235 0xEA 233 0xEA
236 :to-be-executed-address 234 :to-be-executed-address
237 0x18 ;; return 235 0x18 ;; return
238 :to-beginning] 236 :to-beginning-1]
239 237
240 output 238 output
241 [0x05 ;; DEC bytes-to-write (B) 239 [:output-start ;; just a label
242
243 0x54 ;; 240 0x54 ;;
244 0x5D ;; HL->DE \ 241 0x5D ;; HL->DE \
245 ;; | 242 ;; |
246 0x79 ;; C->A | this mess is all to do 243 0x79 ;; C->A | this mess is all to do
247 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without 244 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
248 ;; | any repeating nybbles 245 ;; | any repeating nybbles
249 0x23 ;; inc HL / 246 0x23 ;; inc HL /
250 247
251 ] 248
249 0x05 ;; DEC bytes-to-write (B)
250 0x20 ;; if there are no more bytes to write,
251 0x04
252 0xAF ;; put a no op (0x00) in to-be-executed
253 0xEA
254 :to-be-executed-address
255
256 0x18
257 :to-beginning-2]
258
259 symbol-index
260 (fn [symbol sequence]
261 (count (take-while
262 (partial not= symbol)
263 sequence)))
252 264
253 265 symbols
254 266 {:to-be-executed-address
255 267 (disect-bytes-2
256 268 (+ start-address jump-distance
257 269 (count init)
258 0x22 ;; A->(HL) ; inc HL 270 (symbol-index :to-be-executed input)))
259 271 :to-be-executed 0x3F} ;; clear carry flag no-op
260 272
261 273 program** (flatten
274 (replace
275 symbols
276 (concat init (frame-metronome)
277 (read-user-input)
278 input output)))
279 resolve-internal-jumps
280 {:output-start []
281 :to-output
282 (->signed-8-bit
283 (- (symbol-index :output-start program**)
284 (symbol-index :to-output program**)))}
285
286 program*
287 (flatten (replace resolve-internal-jumps program**))
262 288
263 289 resolve-external-jumps
264 290 {:to-beginning-1
265 ;; HL = here 291 (->signed-8-bit
266 ;; add C to HL 292 (+ -2 (- (symbol-index :to-beginning-1 program*))))
267 ;; jp HL 293 :to-beginning-2
268 294 (->signed-8-bit
269 ]])) 295 (+ -2 (- (symbol-index :to-beginning-2 program*))))}
270 296
271 297 program
272 298 (replace resolve-external-jumps program*)]
273 299 program))
274
275 300
276 301
277 (comment
278
279 ;;;;;; TESTS ;;;;;; 302 ;;;;;; TESTS ;;;;;;
280 303
281 (defn bootstrap-base [] 304 (defn bootstrap-base []
282 (let [program (main-bootstrap-program pokemon-list-start)] 305 (let [program (main-bootstrap-program pokemon-list-start)]
283 ;; make sure program is valid output for item-writer 306 ;; make sure program is valid output for item-writer
284 (bootstrap-pattern program) 307 ;;(bootstrap-pattern program)
285 (-> (tick (mid-game)) 308 (-> (tick (mid-game))
286 (set-memory-range pokemon-list-start program) 309 (set-memory-range pokemon-list-start program)
287 (PC! pokemon-list-start)))) 310 (PC! pokemon-list-start))))
288 311
289 (defn test-write-bytes-mode [] 312 (defn test-write-bytes-mode []
293 get-mem-region #(subvec (vec (memory %)) 316 get-mem-region #(subvec (vec (memory %))
294 target-address (+ target-address 20)) 317 target-address (+ target-address 20))
295 before (bootstrap-base) 318 before (bootstrap-base)
296 after 319 after
297 (-> before 320 (-> before
298 (step []) ; make sure it can handle blanks 321 (step []) ; make sure it can handle blanks
299 (step []) ; at the beginning. 322 (step []) ; at the beginning.
300 (step []) 323 (step [])
301 (step [:start]) ; select WRITE-BYTES mode 324 (step [:start]) ; select WRITE-BYTES mode
302 (step (buttons 4)) ; write 4 bytes 325 (step (buttons 4)) ; write 4 bytes
303 (step (buttons target-high)) 326 (step (buttons target-high))
304 (step (buttons target-low)) 327 (step (buttons target-low))
305 (step (buttons (nth assembly 0))) 328 (step (buttons (nth assembly 0)))
306 (step (buttons (nth assembly 1))) 329 (step (buttons (nth assembly 1)))
307 (step (buttons (nth assembly 2))) 330 (step (buttons (nth assembly 2)))
330 post-jump 353 post-jump
331 10000)] 354 10000)]
332 (println program-counters) 355 (println program-counters)
333 (assert (contains? (set program-counters) target-address)) 356 (assert (contains? (set program-counters) target-address))
334 post-jump)) 357 post-jump))
335 )