rlm@377: (ns com.aurellem.gb.rlm-assembly
rlm@377:   "Version of main bootstrap program that is valid output for the
rlm@377:    item-writer program."
rlm@377:   (:use (com.aurellem.gb gb-driver assembly util vbm constants))
rlm@377:   (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@377: 
rlm@414: (defn pc-item-writer-program
rlm@414:   []
rlm@595:   (let [limit 201 ;; should be more like 92
rlm@414:         [target-high target-low] (disect-bytes-2 pokemon-list-start)]
rlm@414:     (flatten
rlm@414:      [[0x00  ;; (item-hack) set increment stack pointer no-op
rlm@414:        0x1E  ;; load limit into E
rlm@414:        limit
rlm@414:        0x3F  ;; (item-hack) set carry flag no-op
rlm@414: 
rlm@414:        ;; load 2 into C.
rlm@414:        0x0E   ;; C == 1 means input-first nybble
rlm@414:        0x04   ;; C == 0 means input-second nybble
rlm@414: 
rlm@414:        0x21 ;; load target into HL
rlm@414:        target-low
rlm@414:        target-high
rlm@414:        0x37 ;; (item-hack) set carry flag no-op
rlm@414: 
rlm@414:        0x00 ;; (item-hack) no-op
rlm@414:        0x37 ;; (item-hack) set carry flag no-op
rlm@414:        
rlm@414:        0x00 ;; (item-hack) no-op
rlm@414:        0xF3 ;; disable interrupts
rlm@414:        ;; Input Section
rlm@414: 
rlm@414:        0x3E ;; load 0x20 into A, to measure buttons
rlm@414:        0x10 
rlm@414: 
rlm@414:        0x00 ;; (item-hack) no-op
rlm@414:        0xE0 ;; load A into [FF00]
rlm@414:        0x00
rlm@414: 
rlm@414:        0xF0 ;; load 0xFF00 into A to get
rlm@414:        0x00 ;; button presses
rlm@414:        
rlm@414:        0xE6
rlm@414:        0x0F ;; select bottom four bits of A
rlm@414:        0x37 ;; (item-hack) set carry flag no-op
rlm@414: 
rlm@414:        0x00 ;; (item-hack) no-op
rlm@414:        0xB8 ;; see if input is different (CP A B)
rlm@414: 
rlm@414:        0x00 ;; (item-hack) (INC SP)
rlm@414:        0x28 ;; repeat above steps if input is not different
rlm@414:        ;; (jump relative backwards if B != A)
rlm@414:        0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
rlm@414: 
rlm@414:        0x47 ;; load A into B
rlm@414:        
rlm@414:        0x0D ;; dec C
rlm@414:        0x37 ;; (item-hack) set-carry flag
rlm@414:        ;; branch based on C:
rlm@414:        0x20 ;; JR NZ
rlm@414:        23 ;; skip "input second nybble" and "jump to target" below
rlm@414:        
rlm@414:        ;; input second nybble
rlm@414: 
rlm@414:        0x0C ;; inc C
rlm@414:        0x0C ;; inc C
rlm@414: 
rlm@414:        0x00 ;; (item-hack) no-op
rlm@414:        0xE6 ;; select bottom bits
rlm@414:        0x0F
rlm@414:        0x37 ;; (item-hack) set-carry flag no-op
rlm@414: 
rlm@414:        0x00 ;; (item-hack) no-op
rlm@414:        0xB2 ;; (OR A D) -> A
rlm@414: 
rlm@414:        0x22 ;; (do (A -> (HL)) (INC HL))
rlm@414: 
rlm@414:        0x1D ;; (DEC E)
rlm@414: 
rlm@414:        0x00 ;; (item-hack) 
rlm@414:        0x20 ;; jump back to input section if not done
rlm@414:        0xDA ;; literal -36 == TM 18 (counter)
rlm@414:        0x01 ;; (item-hack) set BC to literal (no-op)
rlm@414: 
rlm@414:        ;; jump to target
rlm@414:        0x00  ;; (item-hack) these two bytes can be anything.
rlm@414:        0x01 
rlm@414: 
rlm@414:        0x00   ;; (item-hack) no-op
rlm@414:        0xBF   ;; (CP A A) ensures Z
rlm@414:        
rlm@414:        0xCA   ;; (item-hack) jump if Z
rlm@414:        target-low
rlm@414:        target-high
rlm@414:        0x01   ;; (item-hack) will never be reached.
rlm@414:        
rlm@414:        ;; input first nybble
rlm@414:        0x00
rlm@414:        0xCB
rlm@414:        0x37  ;; swap nybbles on A
rlm@414: 
rlm@414:        0x57  ;; A -> D
rlm@414: 
rlm@414:        0x37  ;; (item-hack) set carry flag no-op
rlm@414:        0x18  ;; relative jump backwards
rlm@414:        0xCD  ;; literal -51 == TM05; go back to input section
rlm@414:        0x01  ;; (item-hack) will never reach this instruction
rlm@414: 
rlm@414:        ]
rlm@414:       (repeat 8 [0x00 0x01]);; these can be anything
rlm@414: 
rlm@414:       [;; jump to actual program
rlm@414:        0x00
rlm@414:        0x37  ;; (item-hack) set carry flag no-op
rlm@414: 
rlm@414:        0x2E  ;; 0x3A -> L
rlm@414:        0x3A
rlm@414: 
rlm@414: 
rlm@414:        0x00  ;; (item-hack) no-op
rlm@414:        0x26  ;; 0xD5 -> L
rlm@414:        0xD5  
rlm@414:        0x01  ;; (item-hack) set-carry BC
rlm@414: 
rlm@414:        0x00  ;; (item-hack) these can be anything
rlm@414:        0x01  
rlm@414: 
rlm@414:        0x00
rlm@414:        0xE9 ;; jump to (HL)
rlm@414:        ]])))
rlm@414: 
rlm@390: 
rlm@390: 
rlm@377: ;; Specs for Main Bootstrap Program
rlm@377: 
rlm@377: ;; Number-Input
rlm@377: ;; Number input works using all eight buttons to
rlm@377: ;;   spell out an 8 bit number.  The order of buttons is
rlm@377: ;;   [:d :u :l :r :start :select :b :a]  -->  11111111
rlm@377: ;;   [      :l    :start            :a]  -->  00101001
rlm@377: 
rlm@409: ;;; MODES
rlm@409: ;; There are five modes in total:
rlm@409: ;;   MODE-SELECT
rlm@409: ;;   SET-H
rlm@409: ;;   SET-L
rlm@409: ;;   WRITE
rlm@409: ;;   JUMP
rlm@409: 
rlm@377: ;;; MODE-SELECT
rlm@377: ;;   The bootstrap program starts in MODE-SELECT mode.
rlm@377: ;;   MODE-SELECT transitions to one of three modes depending
rlm@377: ;;   on which buttons are pressed:
rlm@409: ;;       0   :  MODE-SELECT
rlm@409: ;;    0x67   :  SET-H
rlm@409: ;;    0x6F   :  SET-L
rlm@409: ;;    0x47   :  WRITE
rlm@409: ;;    0xE9   :  JUMP
rlm@409: 
rlm@409: ;;; SET-H
rlm@409: ;;   SET-H sets the high 8 bits of the target address to which
rlm@409: ;;   data will be written / the program will jump.  It expects
rlm@409: ;;   the following:
rlm@409: ;;
rlm@409: ;;    Byte 0 : New Value of H
rlm@409: ;;    Byte 1 : 0x00
rlm@409: 
rlm@409: ;;; SET-L
rlm@409: ;;   This mode sets the low 8 bits of the target address and has
rlm@409: ;;   the same semantics as SET-H.
rlm@377: 
rlm@377: ;;; WRITE-BYTES
rlm@377: ;;   WRITE-BYTES mode writes sequences of arbitray values to
rlm@377: ;;   arbitray memory locations. It expects you to enter a
rlm@409: ;;   header of one byte describing how many bytes to write.
rlm@377: 
rlm@377: ;;    Byte 0  : Number of Bytes to Write
rlm@377: 
rlm@377: ;;   Then, you enter the number of bytes specified in Byte 0
rlm@409: ;;   and they are written to the start address in sequence.
rlm@409: ;;   After the last byte is written control returns to
rlm@409: ;;   MODE-SELECT mode. The Target address will be incremented by
rlm@409: ;;   Number of Bytes to Write once you are done writing.
rlm@377: 
rlm@377: ;;   Example: to write the sequence [1 2 3 4] starting at
rlm@409: ;;   the target address enter:
rlm@377: ;;    Byte 0  : 4 (will write four bytes)
rlm@377: ;;    Byte 3  : 1 (write 1 to 0xC01F)
rlm@377: ;;    Byte 4  : 2 (write 2 to 0xC020)
rlm@377: ;;    Byte 5  : 3 (write 3 to 0xC021)
rlm@377: ;;    Byte 6  : 4 (write 4 to 0xC022)
rlm@377: 
rlm@377: ;;; JUMP 
rlm@409: ;;   JUMP mode jumps program control to the target address.
rlm@377: 
rlm@409: ;;; EXAMPLE
rlm@409: ;;   To write the infinite loop program [0x18 0xFE] to address
rlm@409: ;;   0xC00F and then jump to said program, enter the following
rlm@409: ;;   starting from MODE-SELECT mode.
rlm@377: 
rlm@409: ;;    Byte 0  : 0x67 [:a :b :l :u :select]        ;; SET-H mode
rlm@409: ;;    Byte 1  : 0xC0 [:d :u]                      ;; 0xC0 -> H
rlm@409: ;;    Byte 2  : 0x00 []                           ;; trailer
rlm@409: 
rlm@409: ;;    Byte 3  : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
rlm@409: ;;    Byte 4  : 0x0F [:a :start :b :select]       ;; 0x0F -> L
rlm@409: ;;    Byte 5  : 0x00 []                           ;; trailer
rlm@409: 
rlm@409: ;;    Byte 6  : 0x47 [:a :b :u :select]           ;; WRITE-MODE
rlm@409: ;;    Byte 7  : 0x02 [:b]                         ;; write 2 bytes
rlm@409: ;;    Byte 8  : 0x18 [:r :start]                  ;; assembly
rlm@409: ;;    Byte 9  : 0xFE [:r :start :b :d :l :u :select] ;; assembly
rlm@409: 
rlm@409: ;;    target address is now 0xC011 since we wrote 2 bytes.
rlm@409: ;;    set it back to 0xC00F.
rlm@409: 
rlm@409: ;;    Byte 10 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
rlm@409: ;;    Byte 12 : 0x0F [:a :start :b :select]       ;; 0x0F -> L
rlm@409: ;;    Byte 13 : 0x00 []                           ;; trailer
rlm@409: 
rlm@409: ;;    Byte 14 : 0xE9                              ;; JUMP-MODE
rlm@377: 
rlm@378: (defn ->signed-8-bit [n]
rlm@378:   (if (< n 0)
rlm@378:     (+ 256 n) n))
rlm@378: 
rlm@416: (defn frame-metronome []
rlm@404:   (let [init [0xC5] ;; save value of BC
rlm@404:         timing-loop
rlm@404:         [0x01 ; \
rlm@404:          0x43 ;  |
rlm@404:          0xFE ;  |  load 0xFF44 into BC without repeats
rlm@404:          0x0C ;  |
rlm@404:          0x04 ; /
rlm@404:          0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
rlm@404:         continue-if-144
rlm@404:         [0xFE
rlm@404:          144     ;; compare LY (in A) with 144
rlm@404:          0x20    ;; jump back to beginning if LY != 144 (not-v-blank)
rlm@404:          (->signed-8-bit
rlm@404:           (+ -4 (- (count timing-loop))))]
rlm@404:         spin-loop
rlm@404:         [0x05 ;; dec B, which is 0xFF
rlm@404:          0x20 ;; spin until B==0
rlm@404:          0xFD]]
rlm@404:     (concat init timing-loop continue-if-144 spin-loop)))
rlm@404: 
rlm@404: (defn frame-metronome* []
rlm@404:   [0x3E   ;; smallest version, but uses repeated nybbles
rlm@416:    0x01
rlm@404:    0xE0
rlm@404:    0xFF])
rlm@404: 
rlm@416: (defn frame-metronome** []
rlm@404:   [0x06 ;; load 0xFE into B
rlm@404:    0xFE
rlm@404:    0x04 ;; inc B, now B == FF
rlm@416: 
rlm@416:    0x3E ;;  RLM-debug
rlm@404:    0x01 ;; 1->A
rlm@416:   
rlm@404:    0x48 ;; B->C
rlm@404:    0x02]) ;; A->(BC) set exclusive v-blank interrupt
rlm@378: 
rlm@379: (defn test-frame-metronome
rlm@379:   "Ensure that frame-metronome ticks exactly once every frame."
rlm@379:   ([] (test-frame-metronome 151))
rlm@379:   ([steps]
rlm@416:      (let [inc-E [0x1C 0x18 
rlm@416:                   (->signed-8-bit
rlm@416:                    (+ -3
rlm@416:                       (-(count (frame-metronome)))))]
rlm@404:                    
rlm@388:            program (concat (frame-metronome) inc-E)
rlm@379:            count-frames
rlm@379:            (-> (tick (mid-game))
rlm@379:                (IE! 0)
rlm@388:                (DE! 0)
rlm@379:                (set-memory-range pokemon-list-start program)
rlm@379:                (PC! pokemon-list-start))
rlm@390:            E-after-moves
rlm@390:            (E (run-moves count-frames (repeat steps [])))]
rlm@405:        ;;(println "E:" E-after-moves) 
rlm@388:        (assert (= steps E-after-moves))
rlm@405:        (println "frame-count test passed.")
rlm@379:        count-frames)))
rlm@379: 
rlm@384: (defn read-user-input []
rlm@416:   [0x3E
rlm@388:    0x20 ; prepare to measure d-pad
rlm@384: 
rlm@405:    0x3F ; clear carry flag no-op to prevent repeated nybbles
rlm@405:    
rlm@388:    0x01 ;\
rlm@388:    0x01 ; |
rlm@388:    0xFE ; |  load 0xFF00 into BC without repeats
rlm@388:    0x04 ; |
rlm@388:    0x0D ;/
rlm@386:    
rlm@388:    0x02 
rlm@388:    0x0A ;; get D-pad info
rlm@385:    
rlm@385:    0xF5 ;; push AF
rlm@385:       
rlm@385:    0x3E
rlm@388:    0x10 ; prepare to measure buttons
rlm@388: 
rlm@388:    0x3F ;; clear carry flag no-op to prevent repeated nybbbles
rlm@385:    
rlm@388:    0x02
rlm@388:    0x0A ;; get button info
rlm@385:    
rlm@384:    0xE6 ;; select bottom bits of A
rlm@384:    0x0F
rlm@384: 
rlm@388:    0x47 ;; A->B
rlm@385: 
rlm@385:    0xF1 ;; pop AF
rlm@385: 
rlm@385:    0xE6
rlm@385:    0x0F ;; select bottom bits of A
rlm@385: 
rlm@384:    0xCB
rlm@384:    0x37 ;; swap A nybbles
rlm@387: 
rlm@388:    0xB0 ;; (or A B) -> A
rlm@387:  
rlm@384:    0x2F ;; (NOT A) -> A
rlm@384:    ])
rlm@384: 
rlm@384: (defn test-read-user-input []
rlm@384:   (let [program
rlm@384:         (concat
rlm@384:          (frame-metronome) (read-user-input)
rlm@388:          [0x5F ;; A-> E
rlm@404:           0x76
rlm@384:           0x18
rlm@384:           (->signed-8-bit
rlm@404:            (+ (- (count (read-user-input)))
rlm@404:               (- 4)))])
rlm@384:         read-input
rlm@384:         (-> (tick (mid-game))
rlm@384:             (IE! 0)
rlm@384:             (set-memory-range pokemon-list-start program)
rlm@384:             (PC! pokemon-list-start))]
rlm@384:     (dorun
rlm@404:      (for [i (range 0x100)]
rlm@404:        (assert (= (E (step read-input (buttons i))) i))))
rlm@405:      (println "tested all inputs.")
rlm@384:     read-input))
rlm@384: 
rlm@393: (def symbol-index
rlm@393:   (fn [symbol sequence]
rlm@393:     (count (take-while
rlm@393:             (partial not= symbol)
rlm@393:             sequence))))
rlm@385: 
rlm@552: (defn bootstrap-state-machine
rlm@403:   ([start-address]
rlm@403:      ;; Register Use:
rlm@403:      
rlm@403:      ;; ED non-volitale scratch
rlm@403:      
rlm@552:      ;; A  user-input (A MUST contain user-input for this to work!) 
rlm@403:      ;; HL target-address
rlm@403:      ;; B  bytes-to-write
rlm@403:      ;; C  non-volatile scratch
rlm@385: 
rlm@403:      ;; Modes (with codes) are:
rlm@390: 
rlm@403:      ;; single-action-modes:
rlm@403:      ;; SET-TARGET-HIGH     0x67 ;; A->H
rlm@403:      ;; SET-TARGET-LOW      0x6F ;; A->L
rlm@403:      ;; JUMP                0xE9 ;; jump to (HL)
rlm@390: 
rlm@403:      ;; multi-action-modes
rlm@403:      ;; WRITE               0x47 ;; A->B
rlm@552:      (let [
rlm@403:            input
rlm@403:            [0xC1  ;; pop BC so it's not volatile
rlm@388: 
rlm@403:             0x5F  ;; A->E
rlm@403:             0xAF  ;; test for output-mode (bytes-to-write > 0)
rlm@403:             0xB8  ;; (cp A B)
rlm@403:             0x7B  ;; E->A
rlm@403:             0x20       ;; skip to output section if
rlm@403:             :to-output ;; we're not in input mode 
rlm@403:             
rlm@403:             :to-be-executed
rlm@391: 
rlm@403:             ;; write mode to instruction-to-be-executed (pun)
rlm@403:             0xEA
rlm@403:             :to-be-executed-address
rlm@388: 
rlm@403:             ;; protection region -- do not queue this op for
rlm@403:             ;; execution if the last one was non-zero
rlm@403:             0x79 ;; C->A
rlm@403:             0xA7 ;; test A==0
rlm@403:             0x28
rlm@403:             0x04
rlm@403:             0xAF ;; put a no op (0x00) in to-be-executed
rlm@403:             0xEA ;; 
rlm@403:             :to-be-executed-address
rlm@403:             
rlm@403:             0x7B ;; E->A
rlm@403:             0x4F ;; A->C now C stores previous instruction
rlm@403:             0x18           ;; return
rlm@416:             :to-jump]
rlm@403:            
rlm@403:            output
rlm@403:            [:output-start ;; just a label
rlm@405:             0x3F ;; ;; prevent repeated nybbles
rlm@403:             0x54 ;;
rlm@403:             0x5D ;; HL->DE  \
rlm@552:             ;;          | This mess is here to do
rlm@403:             0x12 ;; A->(DE)  | 0x22 (LDI (HL), A) without
rlm@552:             ;;         /  any repeating nybbles
rlm@403:             0x05 ;; DEC bytes-to-write (B)
rlm@391: 
rlm@405:             0x23 ;; inc HL 
rlm@552:             ]
rlm@552:         
rlm@403:            symbols
rlm@403:            {:to-be-executed-address
rlm@403:             (reverse
rlm@403:              (disect-bytes-2
rlm@404:               (+ start-address
rlm@403:                  (symbol-index :to-be-executed input))))
rlm@405:             :to-be-executed 0x3F} ;; clear carry flag no-op
rlm@392: 
rlm@403:            program** (flatten
rlm@416:                       (replace
rlm@416:                        symbols
rlm@552:                        (concat input output)))
rlm@404:            
rlm@403:            resolve-internal-jumps
rlm@403:            {:output-start []
rlm@403:             :to-output
rlm@403:             (->signed-8-bit
rlm@403:              (dec
rlm@403:               (- (symbol-index :output-start program**)
rlm@403:                  (symbol-index :to-output program**))))}
rlm@391: 
rlm@403:            program*
rlm@403:            (flatten (replace resolve-internal-jumps program**))
rlm@403:            
rlm@403:            resolve-external-jumps
rlm@416:            {:to-jump
rlm@552:             (- (- (count program*)
rlm@552:                   (symbol-index :to-jump program*)) 1)}
rlm@403:            program
rlm@403:            (replace resolve-external-jumps program*)]
rlm@403:        program)))
rlm@552:      
rlm@552: 
rlm@552: (defn main-bootstrap-program
rlm@552:   ([] (main-bootstrap-program pokemon-list-start))
rlm@552:   ([start-address]
rlm@552:      (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@552:            header (concat (frame-metronome) (read-user-input))
rlm@552:            state-machine-start-address
rlm@552:            (+ start-address (count init) (count header))
rlm@552:            state-machine
rlm@552:            (bootstrap-state-machine state-machine-start-address)
rlm@552: 
rlm@552:            return-to-header
rlm@552:            (flatten 
rlm@552:             [0x18
rlm@552:              (->signed-8-bit
rlm@552:               (- (count init)
rlm@552:                  2 ;; this command length
rlm@552:                  3 ;; I have no idea why we need a 3 here
rlm@552:                    ;; need to investigate.
rlm@552:                  (count header)
rlm@552:                  (count state-machine)))])]
rlm@552:                  
rlm@552:        (concat init header state-machine return-to-header))))
rlm@552: 
rlm@414: 
rlm@414: 
rlm@414: (defn no-consecutive-repeats? [seq]
rlm@414:   (not (contains? (set(map - seq (rest seq))) 0)))
rlm@414: 
rlm@414: (defn byte->nybbles [byte]
rlm@414:   [(bit-shift-right byte 4) (bit-and byte 0x0F)])
rlm@414: 
rlm@414: (defn bootstrap-pattern
rlm@414:   "Given an assembly sequence, generate the keypresses required to
rlm@414:    create that sequence in memory using the pc-item-writer
rlm@414:    program. The assembly must not have any consecutive repeating
rlm@414:    nybbles."
rlm@414:   [assembly]
rlm@414:   (let [nybbles (flatten (map byte->nybbles assembly))
rlm@414:         moves (map (comp buttons (partial - 15)) nybbles)
rlm@414:         header (map buttons
rlm@414:                     (concat (repeat
rlm@414:                              50
rlm@414:                              (- 15 (first nybbles)))
rlm@415:                             [(first nybbles)]))]
rlm@414:     (assert (no-consecutive-repeats? nybbles))
rlm@415:     (concat header moves)))
rlm@378:     
rlm@377: ;;;;;; TESTS ;;;;;;
rlm@377: 
rlm@401: (def set-H-mode 0x67)
rlm@401: (def set-L-mode 0x6F)
rlm@401: (def jump-mode  0xE9)
rlm@401: (def write-mode 0x47)
rlm@401: 
rlm@401: 
rlm@377: (defn bootstrap-base []
rlm@377:   (let [program (main-bootstrap-program pokemon-list-start)]
rlm@377:     ;; make sure program is valid output for item-writer
rlm@377:     (-> (tick (mid-game))
rlm@377:         (set-memory-range pokemon-list-start program)
rlm@400:         (PC! pokemon-list-start)
rlm@400:         (step [])
rlm@400:         (step []))))
rlm@377: 
rlm@400: (defn test-set-H []
rlm@400:   (letfn [(test-H [state n]
rlm@400:             (let [after
rlm@400:                   (-> state
rlm@402:                       (step (buttons set-H-mode))
rlm@400:                       (step (buttons n))
rlm@400:                       (step []))]
rlm@401:               ;;(println "desired H =" n "actual =" (H after))
rlm@400:               (assert (= n (H after)))
rlm@400:               after))]
rlm@403:     (let [result (reduce test-H (bootstrap-base) (range 0x100))]
rlm@405:       (println "set H test passed.")
rlm@403:       result)))
rlm@400: 
rlm@401: (defn test-write-bytes []
rlm@377:   (let [target-address 0xC00F
rlm@377:         [target-high target-low] (disect-bytes-2 target-address)
rlm@377:         assembly [0xF3 0x18 0xFE 0x12]
rlm@377:         get-mem-region  #(subvec (vec (memory %))
rlm@377:                                  target-address (+ target-address 20))
rlm@377:         before (bootstrap-base)
rlm@377:         after
rlm@377:         (-> before
rlm@392:             (step [])           ; make sure it can handle blanks
rlm@392:             (step [])           ; at the beginning.
rlm@377:             (step [])                      
rlm@402:             (step (buttons set-H-mode))     ; select set-H
rlm@401:             (step (buttons target-high))
rlm@401:             (step [])
rlm@402:             (step (buttons set-L-mode))
rlm@401:             (step (buttons target-low))
rlm@401:             (step [])
rlm@401:             (step (buttons write-mode))
rlm@392:             (step (buttons 4))  ; write 4 bytes
rlm@377:             (step (buttons (nth assembly 0)))
rlm@377:             (step (buttons (nth assembly 1)))
rlm@377:             (step (buttons (nth assembly 2)))
rlm@409:             (step (buttons (nth assembly 3))))]
rlm@405:     ;;(println "before :" (get-mem-region before))
rlm@405:     ;;(println "after  :" (get-mem-region after))
rlm@405:     ;;(assert (= assembly (take 4 (get-mem-region after))))
rlm@405:     (println "write-test-passed.")
rlm@377:     after))
rlm@377: 
rlm@402: (defn test-jump []
rlm@377:   (let [target-address 0xC00F
rlm@377:         [target-high target-low] (disect-bytes-2 target-address)
rlm@377:         post-jump
rlm@402:         (-> (test-write-bytes)
rlm@402:             (step (buttons set-H-mode))     ; select set-H
rlm@402:             (step (buttons target-high))
rlm@377:             (step [])
rlm@402:             (step (buttons set-L-mode))
rlm@402:             (step (buttons target-low))
rlm@377:             (step [])
rlm@402:             (step (buttons jump-mode)))           ; Select JUMP mode.
rlm@377:         program-counters
rlm@377:         (capture-program-counter 
rlm@377:          post-jump
rlm@377:          10000)]
rlm@377:     (assert (contains? (set program-counters) target-address))
rlm@405:     (println "jump test passed.")
rlm@377:     post-jump))
rlm@402: 
rlm@405: (defn test-no-repeated-nybbles []
rlm@405:   (bootstrap-pattern (main-bootstrap-program))
rlm@405:   (println "no-repeated-nybbles"))
rlm@402: 
rlm@402: (defn run-all-tests []
rlm@402:   (test-frame-metronome)
rlm@402:   (test-read-user-input)
rlm@402:   (test-set-H)
rlm@402:   (test-write-bytes)
rlm@405:   (test-jump)
rlm@405:   (test-no-repeated-nybbles)
rlm@405:   (println "\n all tests passed."))