Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 510:b9814e3114e4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
efficient data writing assembly complete.
author Robert McIntyre <rlm@mit.edu>
date Wed, 20 Jun 2012 22:49:31 -0500
parents d2c40a12de28
children 964957680c11
comparison
equal deleted inserted replaced
509:d2c40a12de28 510:b9814e3114e4
430 430
431 (defn write-data 431 (defn write-data
432 "Efficient assembly to write a sequence of values to 432 "Efficient assembly to write a sequence of values to
433 memory, starting at a target address." 433 memory, starting at a target address."
434 [base-address target-address data] 434 [base-address target-address data]
435 (let [len (count data)] 435 (let [len (count data)
436 program-length 21] ;; change this if program length
437 ;; below changes!
438
436 (flatten 439 (flatten
437 (if (<= len 255)
438 [0x21 ;; load data address start into HL 440 [0x21 ;; load data address start into HL
439 (reverse (disect-bytes-2 (+ 16 base-address))) 441 (reverse (disect-bytes-2 (+ base-address program-length)))
440 442
441 0x01 ;; load target address into BC 443 0x01 ;; load target address into BC
442 (reverse (disect-bytes-2 target-address)) 444 (reverse (disect-bytes-2 target-address))
443 445
444 0x16 ;; load len into D 446 0x11 ;; load len into DE
445 len 447 (reverse (disect-bytes-2 len))
446 448
447 449
448 ;; data x-fer loop start 450 ;; data x-fer loop start
449 0x2A ;; (HL) -> A; HL++; 451 0x2A ;; (HL) -> A; HL++;
450 0x02 ;; A -> (BC); 452 0x02 ;; A -> (BC);
451 0x03 ;; INC BC; 453 0x03 ;; INC BC;
452 0x15 ;; DEC D 454 0x1B ;; DEC DE
453 455
454 0x20 ;; if D is not now 0, 456 0xAF
455 (->signed-8-bit -6) ;; GOTO start 457 0xB2 ;; (OR D E) -> A
458 0xB3
459
456 460
457 0x18 461 0x20 ;; if DE is not now 0,
458 len 462 (->signed-8-bit -9) ;; GOTO start
459 463
460 data] 464 0xC3
461 (let [first-part (write-data base-address target-address 465 (reverse
462 (take 255 data))] 466 (disect-bytes-2
463 [first-part 467 (+ len base-address program-length)))
464 (write-data (+ base-address (count first-part)) 468 data])))
465 (+ target-address 255) 469
466 (drop 255 data))])))))
467 470
468 (defn test-write-data [] 471 (defn test-write-data []
469 (let [test-data [0xDE 0xAD 0xBE 0xEF] 472 (let [test-data (concat (range 256)
470 base-address 0xA000 473 (reverse (range 256)))
471 target-address 0xC000 474 base-address 0xC000
475 target-address 0xD000
472 476
473 test-kernel 477 test-kernel
474 (flatten 478 (flatten
475 [0xF3 ;; disable interrupts 479 [0xF3 ;; disable interrupts
476 (write-data (+ 1 base-address) 480 (write-data (+ 1 base-address)
477 target-address test-data) 481 target-address test-data)
478 (clear-music-registers)
479 (infinite-loop)])] 482 (infinite-loop)])]
480 (assert 483 (assert
481 (= test-data 484 (= test-data
482 (-> (mid-game) 485 (-> (mid-game)
483 tick tick tick 486 tick tick tick
484 (set-memory-range base-address test-kernel) 487 (set-memory-range base-address test-kernel)
485 (PC! base-address) 488 (PC! base-address)
486
487 (run-moves (repeat 100 [])) 489 (run-moves (repeat 100 []))
488 (memory) 490 (memory)
489 vec 491 vec
490 (subvec target-address 492 (subvec target-address
491 (+ target-address 493 (+ target-address
492 (count test-data)))))))) 494 (count test-data))))))))
493 495
494
495
496
497
498
499
500 (defn display-image-kernel [base-address ^BufferedImage image] 496 (defn display-image-kernel [base-address ^BufferedImage image]
501 (let [gb-image (image->gb-image image)] 497 (let [gb-image (image->gb-image image)]
502 498
503 [(clear-music-registers) 499 [(clear-music-registers)
504 500