Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/rlm_assembly.clj @ 552:9068685e7d96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
moduralized main-bootstrap-program
author Robert McIntyre <rlm@mit.edu>
date Thu, 30 Aug 2012 12:09:15 -0500
parents 21b8b3350b20
children 96ee9d72aeb9
comparison
equal deleted inserted replaced
551:b69a3dba8045 552:9068685e7d96
353 (fn [symbol sequence] 353 (fn [symbol sequence]
354 (count (take-while 354 (count (take-while
355 (partial not= symbol) 355 (partial not= symbol)
356 sequence)))) 356 sequence))))
357 357
358 (defn main-bootstrap-program 358 (defn bootstrap-state-machine
359 ([] (main-bootstrap-program pokemon-list-start))
360 ([start-address] 359 ([start-address]
361 ;; Register Use: 360 ;; Register Use:
362 361
363 ;; ED non-volitale scratch 362 ;; ED non-volitale scratch
364 363
365 ;; A user-input 364 ;; A user-input (A MUST contain user-input for this to work!)
366 ;; HL target-address 365 ;; HL target-address
367 ;; B bytes-to-write 366 ;; B bytes-to-write
368 ;; C non-volatile scratch 367 ;; C non-volatile scratch
369 368
370 ;; Modes (with codes) are: 369 ;; Modes (with codes) are:
374 ;; SET-TARGET-LOW 0x6F ;; A->L 373 ;; SET-TARGET-LOW 0x6F ;; A->L
375 ;; JUMP 0xE9 ;; jump to (HL) 374 ;; JUMP 0xE9 ;; jump to (HL)
376 375
377 ;; multi-action-modes 376 ;; multi-action-modes
378 ;; WRITE 0x47 ;; A->B 377 ;; WRITE 0x47 ;; A->B
379 378 (let [
380 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
381 header (concat (frame-metronome) (read-user-input))
382
383 input 379 input
384 [0xC1 ;; pop BC so it's not volatile 380 [0xC1 ;; pop BC so it's not volatile
385 381
386 0x5F ;; A->E 382 0x5F ;; A->E
387 0xAF ;; test for output-mode (bytes-to-write > 0) 383 0xAF ;; test for output-mode (bytes-to-write > 0)
414 output 410 output
415 [:output-start ;; just a label 411 [:output-start ;; just a label
416 0x3F ;; ;; prevent repeated nybbles 412 0x3F ;; ;; prevent repeated nybbles
417 0x54 ;; 413 0x54 ;;
418 0x5D ;; HL->DE \ 414 0x5D ;; HL->DE \
419 ;; | This mess is here to do 415 ;; | This mess is here to do
420 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without 416 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
421 ;; / any repeating nybbles 417 ;; / any repeating nybbles
422 0x05 ;; DEC bytes-to-write (B) 418 0x05 ;; DEC bytes-to-write (B)
423 419
424 0x23 ;; inc HL 420 0x23 ;; inc HL
425 421 ]
426 0x18 422
427 :to-beginning]
428
429 symbols 423 symbols
430 {:to-be-executed-address 424 {:to-be-executed-address
431 (reverse 425 (reverse
432 (disect-bytes-2 426 (disect-bytes-2
433 (+ start-address 427 (+ start-address
434 (count header)
435 (count init)
436 (symbol-index :to-be-executed input)))) 428 (symbol-index :to-be-executed input))))
437 :to-be-executed 0x3F} ;; clear carry flag no-op 429 :to-be-executed 0x3F} ;; clear carry flag no-op
438 430
439 program** (flatten 431 program** (flatten
440 (replace 432 (replace
441 symbols 433 symbols
442 (concat init header input output))) 434 (concat input output)))
443 435
444 resolve-internal-jumps 436 resolve-internal-jumps
445 {:output-start [] 437 {:output-start []
446 :to-output 438 :to-output
447 (->signed-8-bit 439 (->signed-8-bit
452 program* 444 program*
453 (flatten (replace resolve-internal-jumps program**)) 445 (flatten (replace resolve-internal-jumps program**))
454 446
455 resolve-external-jumps 447 resolve-external-jumps
456 {:to-jump 448 {:to-jump
457 (- (- (symbol-index :to-beginning program*) 449 (- (- (count program*)
458 (symbol-index :to-jump program*)) 2) 450 (symbol-index :to-jump program*)) 1)}
459
460 :to-beginning
461 (->signed-8-bit
462 (+ (count init) -1
463 (- (symbol-index :to-beginning program*))))}
464
465 program 451 program
466 (replace resolve-external-jumps program*)] 452 (replace resolve-external-jumps program*)]
467 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
468 479
469 480
470 (defn no-consecutive-repeats? [seq] 481 (defn no-consecutive-repeats? [seq]
471 (not (contains? (set(map - seq (rest seq))) 0))) 482 (not (contains? (set(map - seq (rest seq))) 0)))
472 483