Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/rlm_assembly.clj @ 593:daa3497bbe12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
increased speed to travel to floor two of celadon dept. store.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 12:38:26 -0500
parents 9068685e7d96
children 96ee9d72aeb9
rev   line source
rlm@377 1 (ns com.aurellem.gb.rlm-assembly
rlm@377 2 "Version of main bootstrap program that is valid output for the
rlm@377 3 item-writer program."
rlm@377 4 (:use (com.aurellem.gb gb-driver assembly util vbm constants))
rlm@377 5 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@377 6
rlm@414 7 (defn pc-item-writer-program
rlm@414 8 []
rlm@414 9 (let [limit 201
rlm@414 10 [target-high target-low] (disect-bytes-2 pokemon-list-start)]
rlm@414 11 (flatten
rlm@414 12 [[0x00 ;; (item-hack) set increment stack pointer no-op
rlm@414 13 0x1E ;; load limit into E
rlm@414 14 limit
rlm@414 15 0x3F ;; (item-hack) set carry flag no-op
rlm@414 16
rlm@414 17 ;; load 2 into C.
rlm@414 18 0x0E ;; C == 1 means input-first nybble
rlm@414 19 0x04 ;; C == 0 means input-second nybble
rlm@414 20
rlm@414 21 0x21 ;; load target into HL
rlm@414 22 target-low
rlm@414 23 target-high
rlm@414 24 0x37 ;; (item-hack) set carry flag no-op
rlm@414 25
rlm@414 26 0x00 ;; (item-hack) no-op
rlm@414 27 0x37 ;; (item-hack) set carry flag no-op
rlm@414 28
rlm@414 29 0x00 ;; (item-hack) no-op
rlm@414 30 0xF3 ;; disable interrupts
rlm@414 31 ;; Input Section
rlm@414 32
rlm@414 33 0x3E ;; load 0x20 into A, to measure buttons
rlm@414 34 0x10
rlm@414 35
rlm@414 36 0x00 ;; (item-hack) no-op
rlm@414 37 0xE0 ;; load A into [FF00]
rlm@414 38 0x00
rlm@414 39
rlm@414 40 0xF0 ;; load 0xFF00 into A to get
rlm@414 41 0x00 ;; button presses
rlm@414 42
rlm@414 43 0xE6
rlm@414 44 0x0F ;; select bottom four bits of A
rlm@414 45 0x37 ;; (item-hack) set carry flag no-op
rlm@414 46
rlm@414 47 0x00 ;; (item-hack) no-op
rlm@414 48 0xB8 ;; see if input is different (CP A B)
rlm@414 49
rlm@414 50 0x00 ;; (item-hack) (INC SP)
rlm@414 51 0x28 ;; repeat above steps if input is not different
rlm@414 52 ;; (jump relative backwards if B != A)
rlm@414 53 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
rlm@414 54
rlm@414 55 0x47 ;; load A into B
rlm@414 56
rlm@414 57 0x0D ;; dec C
rlm@414 58 0x37 ;; (item-hack) set-carry flag
rlm@414 59 ;; branch based on C:
rlm@414 60 0x20 ;; JR NZ
rlm@414 61 23 ;; skip "input second nybble" and "jump to target" below
rlm@414 62
rlm@414 63 ;; input second nybble
rlm@414 64
rlm@414 65 0x0C ;; inc C
rlm@414 66 0x0C ;; inc C
rlm@414 67
rlm@414 68 0x00 ;; (item-hack) no-op
rlm@414 69 0xE6 ;; select bottom bits
rlm@414 70 0x0F
rlm@414 71 0x37 ;; (item-hack) set-carry flag no-op
rlm@414 72
rlm@414 73 0x00 ;; (item-hack) no-op
rlm@414 74 0xB2 ;; (OR A D) -> A
rlm@414 75
rlm@414 76 0x22 ;; (do (A -> (HL)) (INC HL))
rlm@414 77
rlm@414 78 0x1D ;; (DEC E)
rlm@414 79
rlm@414 80 0x00 ;; (item-hack)
rlm@414 81 0x20 ;; jump back to input section if not done
rlm@414 82 0xDA ;; literal -36 == TM 18 (counter)
rlm@414 83 0x01 ;; (item-hack) set BC to literal (no-op)
rlm@414 84
rlm@414 85 ;; jump to target
rlm@414 86 0x00 ;; (item-hack) these two bytes can be anything.
rlm@414 87 0x01
rlm@414 88
rlm@414 89 0x00 ;; (item-hack) no-op
rlm@414 90 0xBF ;; (CP A A) ensures Z
rlm@414 91
rlm@414 92 0xCA ;; (item-hack) jump if Z
rlm@414 93 target-low
rlm@414 94 target-high
rlm@414 95 0x01 ;; (item-hack) will never be reached.
rlm@414 96
rlm@414 97 ;; input first nybble
rlm@414 98 0x00
rlm@414 99 0xCB
rlm@414 100 0x37 ;; swap nybbles on A
rlm@414 101
rlm@414 102 0x57 ;; A -> D
rlm@414 103
rlm@414 104 0x37 ;; (item-hack) set carry flag no-op
rlm@414 105 0x18 ;; relative jump backwards
rlm@414 106 0xCD ;; literal -51 == TM05; go back to input section
rlm@414 107 0x01 ;; (item-hack) will never reach this instruction
rlm@414 108
rlm@414 109 ]
rlm@414 110 (repeat 8 [0x00 0x01]);; these can be anything
rlm@414 111
rlm@414 112 [;; jump to actual program
rlm@414 113 0x00
rlm@414 114 0x37 ;; (item-hack) set carry flag no-op
rlm@414 115
rlm@414 116 0x2E ;; 0x3A -> L
rlm@414 117 0x3A
rlm@414 118
rlm@414 119
rlm@414 120 0x00 ;; (item-hack) no-op
rlm@414 121 0x26 ;; 0xD5 -> L
rlm@414 122 0xD5
rlm@414 123 0x01 ;; (item-hack) set-carry BC
rlm@414 124
rlm@414 125 0x00 ;; (item-hack) these can be anything
rlm@414 126 0x01
rlm@414 127
rlm@414 128 0x00
rlm@414 129 0xE9 ;; jump to (HL)
rlm@414 130 ]])))
rlm@414 131
rlm@390 132
rlm@390 133
rlm@377 134 ;; Specs for Main Bootstrap Program
rlm@377 135
rlm@377 136 ;; Number-Input
rlm@377 137 ;; Number input works using all eight buttons to
rlm@377 138 ;; spell out an 8 bit number. The order of buttons is
rlm@377 139 ;; [:d :u :l :r :start :select :b :a] --> 11111111
rlm@377 140 ;; [ :l :start :a] --> 00101001
rlm@377 141
rlm@409 142 ;;; MODES
rlm@409 143 ;; There are five modes in total:
rlm@409 144 ;; MODE-SELECT
rlm@409 145 ;; SET-H
rlm@409 146 ;; SET-L
rlm@409 147 ;; WRITE
rlm@409 148 ;; JUMP
rlm@409 149
rlm@377 150 ;;; MODE-SELECT
rlm@377 151 ;; The bootstrap program starts in MODE-SELECT mode.
rlm@377 152 ;; MODE-SELECT transitions to one of three modes depending
rlm@377 153 ;; on which buttons are pressed:
rlm@409 154 ;; 0 : MODE-SELECT
rlm@409 155 ;; 0x67 : SET-H
rlm@409 156 ;; 0x6F : SET-L
rlm@409 157 ;; 0x47 : WRITE
rlm@409 158 ;; 0xE9 : JUMP
rlm@409 159
rlm@409 160 ;;; SET-H
rlm@409 161 ;; SET-H sets the high 8 bits of the target address to which
rlm@409 162 ;; data will be written / the program will jump. It expects
rlm@409 163 ;; the following:
rlm@409 164 ;;
rlm@409 165 ;; Byte 0 : New Value of H
rlm@409 166 ;; Byte 1 : 0x00
rlm@409 167
rlm@409 168 ;;; SET-L
rlm@409 169 ;; This mode sets the low 8 bits of the target address and has
rlm@409 170 ;; the same semantics as SET-H.
rlm@377 171
rlm@377 172 ;;; WRITE-BYTES
rlm@377 173 ;; WRITE-BYTES mode writes sequences of arbitray values to
rlm@377 174 ;; arbitray memory locations. It expects you to enter a
rlm@409 175 ;; header of one byte describing how many bytes to write.
rlm@377 176
rlm@377 177 ;; Byte 0 : Number of Bytes to Write
rlm@377 178
rlm@377 179 ;; Then, you enter the number of bytes specified in Byte 0
rlm@409 180 ;; and they are written to the start address in sequence.
rlm@409 181 ;; After the last byte is written control returns to
rlm@409 182 ;; MODE-SELECT mode. The Target address will be incremented by
rlm@409 183 ;; Number of Bytes to Write once you are done writing.
rlm@377 184
rlm@377 185 ;; Example: to write the sequence [1 2 3 4] starting at
rlm@409 186 ;; the target address enter:
rlm@377 187 ;; Byte 0 : 4 (will write four bytes)
rlm@377 188 ;; Byte 3 : 1 (write 1 to 0xC01F)
rlm@377 189 ;; Byte 4 : 2 (write 2 to 0xC020)
rlm@377 190 ;; Byte 5 : 3 (write 3 to 0xC021)
rlm@377 191 ;; Byte 6 : 4 (write 4 to 0xC022)
rlm@377 192
rlm@377 193 ;;; JUMP
rlm@409 194 ;; JUMP mode jumps program control to the target address.
rlm@377 195
rlm@409 196 ;;; EXAMPLE
rlm@409 197 ;; To write the infinite loop program [0x18 0xFE] to address
rlm@409 198 ;; 0xC00F and then jump to said program, enter the following
rlm@409 199 ;; starting from MODE-SELECT mode.
rlm@377 200
rlm@409 201 ;; Byte 0 : 0x67 [:a :b :l :u :select] ;; SET-H mode
rlm@409 202 ;; Byte 1 : 0xC0 [:d :u] ;; 0xC0 -> H
rlm@409 203 ;; Byte 2 : 0x00 [] ;; trailer
rlm@409 204
rlm@409 205 ;; Byte 3 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
rlm@409 206 ;; Byte 4 : 0x0F [:a :start :b :select] ;; 0x0F -> L
rlm@409 207 ;; Byte 5 : 0x00 [] ;; trailer
rlm@409 208
rlm@409 209 ;; Byte 6 : 0x47 [:a :b :u :select] ;; WRITE-MODE
rlm@409 210 ;; Byte 7 : 0x02 [:b] ;; write 2 bytes
rlm@409 211 ;; Byte 8 : 0x18 [:r :start] ;; assembly
rlm@409 212 ;; Byte 9 : 0xFE [:r :start :b :d :l :u :select] ;; assembly
rlm@409 213
rlm@409 214 ;; target address is now 0xC011 since we wrote 2 bytes.
rlm@409 215 ;; set it back to 0xC00F.
rlm@409 216
rlm@409 217 ;; Byte 10 : 0x6F [:a :start :b :l :u :select] ;; SET-L mode
rlm@409 218 ;; Byte 12 : 0x0F [:a :start :b :select] ;; 0x0F -> L
rlm@409 219 ;; Byte 13 : 0x00 [] ;; trailer
rlm@409 220
rlm@409 221 ;; Byte 14 : 0xE9 ;; JUMP-MODE
rlm@377 222
rlm@378 223 (defn ->signed-8-bit [n]
rlm@378 224 (if (< n 0)
rlm@378 225 (+ 256 n) n))
rlm@378 226
rlm@416 227 (defn frame-metronome []
rlm@404 228 (let [init [0xC5] ;; save value of BC
rlm@404 229 timing-loop
rlm@404 230 [0x01 ; \
rlm@404 231 0x43 ; |
rlm@404 232 0xFE ; | load 0xFF44 into BC without repeats
rlm@404 233 0x0C ; |
rlm@404 234 0x04 ; /
rlm@404 235 0x0A] ;; (BC) -> A, now A = LY (vertical line coord)
rlm@404 236 continue-if-144
rlm@404 237 [0xFE
rlm@404 238 144 ;; compare LY (in A) with 144
rlm@404 239 0x20 ;; jump back to beginning if LY != 144 (not-v-blank)
rlm@404 240 (->signed-8-bit
rlm@404 241 (+ -4 (- (count timing-loop))))]
rlm@404 242 spin-loop
rlm@404 243 [0x05 ;; dec B, which is 0xFF
rlm@404 244 0x20 ;; spin until B==0
rlm@404 245 0xFD]]
rlm@404 246 (concat init timing-loop continue-if-144 spin-loop)))
rlm@404 247
rlm@404 248 (defn frame-metronome* []
rlm@404 249 [0x3E ;; smallest version, but uses repeated nybbles
rlm@416 250 0x01
rlm@404 251 0xE0
rlm@404 252 0xFF])
rlm@404 253
rlm@416 254 (defn frame-metronome** []
rlm@404 255 [0x06 ;; load 0xFE into B
rlm@404 256 0xFE
rlm@404 257 0x04 ;; inc B, now B == FF
rlm@416 258
rlm@416 259 0x3E ;; RLM-debug
rlm@404 260 0x01 ;; 1->A
rlm@416 261
rlm@404 262 0x48 ;; B->C
rlm@404 263 0x02]) ;; A->(BC) set exclusive v-blank interrupt
rlm@378 264
rlm@379 265 (defn test-frame-metronome
rlm@379 266 "Ensure that frame-metronome ticks exactly once every frame."
rlm@379 267 ([] (test-frame-metronome 151))
rlm@379 268 ([steps]
rlm@416 269 (let [inc-E [0x1C 0x18
rlm@416 270 (->signed-8-bit
rlm@416 271 (+ -3
rlm@416 272 (-(count (frame-metronome)))))]
rlm@404 273
rlm@388 274 program (concat (frame-metronome) inc-E)
rlm@379 275 count-frames
rlm@379 276 (-> (tick (mid-game))
rlm@379 277 (IE! 0)
rlm@388 278 (DE! 0)
rlm@379 279 (set-memory-range pokemon-list-start program)
rlm@379 280 (PC! pokemon-list-start))
rlm@390 281 E-after-moves
rlm@390 282 (E (run-moves count-frames (repeat steps [])))]
rlm@405 283 ;;(println "E:" E-after-moves)
rlm@388 284 (assert (= steps E-after-moves))
rlm@405 285 (println "frame-count test passed.")
rlm@379 286 count-frames)))
rlm@379 287
rlm@384 288 (defn read-user-input []
rlm@416 289 [0x3E
rlm@388 290 0x20 ; prepare to measure d-pad
rlm@384 291
rlm@405 292 0x3F ; clear carry flag no-op to prevent repeated nybbles
rlm@405 293
rlm@388 294 0x01 ;\
rlm@388 295 0x01 ; |
rlm@388 296 0xFE ; | load 0xFF00 into BC without repeats
rlm@388 297 0x04 ; |
rlm@388 298 0x0D ;/
rlm@386 299
rlm@388 300 0x02
rlm@388 301 0x0A ;; get D-pad info
rlm@385 302
rlm@385 303 0xF5 ;; push AF
rlm@385 304
rlm@385 305 0x3E
rlm@388 306 0x10 ; prepare to measure buttons
rlm@388 307
rlm@388 308 0x3F ;; clear carry flag no-op to prevent repeated nybbbles
rlm@385 309
rlm@388 310 0x02
rlm@388 311 0x0A ;; get button info
rlm@385 312
rlm@384 313 0xE6 ;; select bottom bits of A
rlm@384 314 0x0F
rlm@384 315
rlm@388 316 0x47 ;; A->B
rlm@385 317
rlm@385 318 0xF1 ;; pop AF
rlm@385 319
rlm@385 320 0xE6
rlm@385 321 0x0F ;; select bottom bits of A
rlm@385 322
rlm@384 323 0xCB
rlm@384 324 0x37 ;; swap A nybbles
rlm@387 325
rlm@388 326 0xB0 ;; (or A B) -> A
rlm@387 327
rlm@384 328 0x2F ;; (NOT A) -> A
rlm@384 329 ])
rlm@384 330
rlm@384 331 (defn test-read-user-input []
rlm@384 332 (let [program
rlm@384 333 (concat
rlm@384 334 (frame-metronome) (read-user-input)
rlm@388 335 [0x5F ;; A-> E
rlm@404 336 0x76
rlm@384 337 0x18
rlm@384 338 (->signed-8-bit
rlm@404 339 (+ (- (count (read-user-input)))
rlm@404 340 (- 4)))])
rlm@384 341 read-input
rlm@384 342 (-> (tick (mid-game))
rlm@384 343 (IE! 0)
rlm@384 344 (set-memory-range pokemon-list-start program)
rlm@384 345 (PC! pokemon-list-start))]
rlm@384 346 (dorun
rlm@404 347 (for [i (range 0x100)]
rlm@404 348 (assert (= (E (step read-input (buttons i))) i))))
rlm@405 349 (println "tested all inputs.")
rlm@384 350 read-input))
rlm@384 351
rlm@393 352 (def symbol-index
rlm@393 353 (fn [symbol sequence]
rlm@393 354 (count (take-while
rlm@393 355 (partial not= symbol)
rlm@393 356 sequence))))
rlm@385 357
rlm@552 358 (defn bootstrap-state-machine
rlm@403 359 ([start-address]
rlm@403 360 ;; Register Use:
rlm@403 361
rlm@403 362 ;; ED non-volitale scratch
rlm@403 363
rlm@552 364 ;; A user-input (A MUST contain user-input for this to work!)
rlm@403 365 ;; HL target-address
rlm@403 366 ;; B bytes-to-write
rlm@403 367 ;; C non-volatile scratch
rlm@385 368
rlm@403 369 ;; Modes (with codes) are:
rlm@390 370
rlm@403 371 ;; single-action-modes:
rlm@403 372 ;; SET-TARGET-HIGH 0x67 ;; A->H
rlm@403 373 ;; SET-TARGET-LOW 0x6F ;; A->L
rlm@403 374 ;; JUMP 0xE9 ;; jump to (HL)
rlm@390 375
rlm@403 376 ;; multi-action-modes
rlm@403 377 ;; WRITE 0x47 ;; A->B
rlm@552 378 (let [
rlm@403 379 input
rlm@403 380 [0xC1 ;; pop BC so it's not volatile
rlm@388 381
rlm@403 382 0x5F ;; A->E
rlm@403 383 0xAF ;; test for output-mode (bytes-to-write > 0)
rlm@403 384 0xB8 ;; (cp A B)
rlm@403 385 0x7B ;; E->A
rlm@403 386 0x20 ;; skip to output section if
rlm@403 387 :to-output ;; we're not in input mode
rlm@403 388
rlm@403 389 :to-be-executed
rlm@391 390
rlm@403 391 ;; write mode to instruction-to-be-executed (pun)
rlm@403 392 0xEA
rlm@403 393 :to-be-executed-address
rlm@388 394
rlm@403 395 ;; protection region -- do not queue this op for
rlm@403 396 ;; execution if the last one was non-zero
rlm@403 397 0x79 ;; C->A
rlm@403 398 0xA7 ;; test A==0
rlm@403 399 0x28
rlm@403 400 0x04
rlm@403 401 0xAF ;; put a no op (0x00) in to-be-executed
rlm@403 402 0xEA ;;
rlm@403 403 :to-be-executed-address
rlm@403 404
rlm@403 405 0x7B ;; E->A
rlm@403 406 0x4F ;; A->C now C stores previous instruction
rlm@403 407 0x18 ;; return
rlm@416 408 :to-jump]
rlm@403 409
rlm@403 410 output
rlm@403 411 [:output-start ;; just a label
rlm@405 412 0x3F ;; ;; prevent repeated nybbles
rlm@403 413 0x54 ;;
rlm@403 414 0x5D ;; HL->DE \
rlm@552 415 ;; | This mess is here to do
rlm@403 416 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
rlm@552 417 ;; / any repeating nybbles
rlm@403 418 0x05 ;; DEC bytes-to-write (B)
rlm@391 419
rlm@405 420 0x23 ;; inc HL
rlm@552 421 ]
rlm@552 422
rlm@403 423 symbols
rlm@403 424 {:to-be-executed-address
rlm@403 425 (reverse
rlm@403 426 (disect-bytes-2
rlm@404 427 (+ start-address
rlm@403 428 (symbol-index :to-be-executed input))))
rlm@405 429 :to-be-executed 0x3F} ;; clear carry flag no-op
rlm@392 430
rlm@403 431 program** (flatten
rlm@416 432 (replace
rlm@416 433 symbols
rlm@552 434 (concat input output)))
rlm@404 435
rlm@403 436 resolve-internal-jumps
rlm@403 437 {:output-start []
rlm@403 438 :to-output
rlm@403 439 (->signed-8-bit
rlm@403 440 (dec
rlm@403 441 (- (symbol-index :output-start program**)
rlm@403 442 (symbol-index :to-output program**))))}
rlm@391 443
rlm@403 444 program*
rlm@403 445 (flatten (replace resolve-internal-jumps program**))
rlm@403 446
rlm@403 447 resolve-external-jumps
rlm@416 448 {:to-jump
rlm@552 449 (- (- (count program*)
rlm@552 450 (symbol-index :to-jump program*)) 1)}
rlm@403 451 program
rlm@403 452 (replace resolve-external-jumps program*)]
rlm@403 453 program)))
rlm@552 454
rlm@552 455
rlm@552 456 (defn main-bootstrap-program
rlm@552 457 ([] (main-bootstrap-program pokemon-list-start))
rlm@552 458 ([start-address]
rlm@552 459 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@552 460 header (concat (frame-metronome) (read-user-input))
rlm@552 461 state-machine-start-address
rlm@552 462 (+ start-address (count init) (count header))
rlm@552 463 state-machine
rlm@552 464 (bootstrap-state-machine state-machine-start-address)
rlm@552 465
rlm@552 466 return-to-header
rlm@552 467 (flatten
rlm@552 468 [0x18
rlm@552 469 (->signed-8-bit
rlm@552 470 (- (count init)
rlm@552 471 2 ;; this command length
rlm@552 472 3 ;; I have no idea why we need a 3 here
rlm@552 473 ;; need to investigate.
rlm@552 474 (count header)
rlm@552 475 (count state-machine)))])]
rlm@552 476
rlm@552 477 (concat init header state-machine return-to-header))))
rlm@552 478
rlm@414 479
rlm@414 480
rlm@414 481 (defn no-consecutive-repeats? [seq]
rlm@414 482 (not (contains? (set(map - seq (rest seq))) 0)))
rlm@414 483
rlm@414 484 (defn byte->nybbles [byte]
rlm@414 485 [(bit-shift-right byte 4) (bit-and byte 0x0F)])
rlm@414 486
rlm@414 487 (defn bootstrap-pattern
rlm@414 488 "Given an assembly sequence, generate the keypresses required to
rlm@414 489 create that sequence in memory using the pc-item-writer
rlm@414 490 program. The assembly must not have any consecutive repeating
rlm@414 491 nybbles."
rlm@414 492 [assembly]
rlm@414 493 (let [nybbles (flatten (map byte->nybbles assembly))
rlm@414 494 moves (map (comp buttons (partial - 15)) nybbles)
rlm@414 495 header (map buttons
rlm@414 496 (concat (repeat
rlm@414 497 50
rlm@414 498 (- 15 (first nybbles)))
rlm@415 499 [(first nybbles)]))]
rlm@414 500 (assert (no-consecutive-repeats? nybbles))
rlm@415 501 (concat header moves)))
rlm@378 502
rlm@377 503 ;;;;;; TESTS ;;;;;;
rlm@377 504
rlm@401 505 (def set-H-mode 0x67)
rlm@401 506 (def set-L-mode 0x6F)
rlm@401 507 (def jump-mode 0xE9)
rlm@401 508 (def write-mode 0x47)
rlm@401 509
rlm@401 510
rlm@377 511 (defn bootstrap-base []
rlm@377 512 (let [program (main-bootstrap-program pokemon-list-start)]
rlm@377 513 ;; make sure program is valid output for item-writer
rlm@377 514 (-> (tick (mid-game))
rlm@377 515 (set-memory-range pokemon-list-start program)
rlm@400 516 (PC! pokemon-list-start)
rlm@400 517 (step [])
rlm@400 518 (step []))))
rlm@377 519
rlm@400 520 (defn test-set-H []
rlm@400 521 (letfn [(test-H [state n]
rlm@400 522 (let [after
rlm@400 523 (-> state
rlm@402 524 (step (buttons set-H-mode))
rlm@400 525 (step (buttons n))
rlm@400 526 (step []))]
rlm@401 527 ;;(println "desired H =" n "actual =" (H after))
rlm@400 528 (assert (= n (H after)))
rlm@400 529 after))]
rlm@403 530 (let [result (reduce test-H (bootstrap-base) (range 0x100))]
rlm@405 531 (println "set H test passed.")
rlm@403 532 result)))
rlm@400 533
rlm@401 534 (defn test-write-bytes []
rlm@377 535 (let [target-address 0xC00F
rlm@377 536 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 537 assembly [0xF3 0x18 0xFE 0x12]
rlm@377 538 get-mem-region #(subvec (vec (memory %))
rlm@377 539 target-address (+ target-address 20))
rlm@377 540 before (bootstrap-base)
rlm@377 541 after
rlm@377 542 (-> before
rlm@392 543 (step []) ; make sure it can handle blanks
rlm@392 544 (step []) ; at the beginning.
rlm@377 545 (step [])
rlm@402 546 (step (buttons set-H-mode)) ; select set-H
rlm@401 547 (step (buttons target-high))
rlm@401 548 (step [])
rlm@402 549 (step (buttons set-L-mode))
rlm@401 550 (step (buttons target-low))
rlm@401 551 (step [])
rlm@401 552 (step (buttons write-mode))
rlm@392 553 (step (buttons 4)) ; write 4 bytes
rlm@377 554 (step (buttons (nth assembly 0)))
rlm@377 555 (step (buttons (nth assembly 1)))
rlm@377 556 (step (buttons (nth assembly 2)))
rlm@409 557 (step (buttons (nth assembly 3))))]
rlm@405 558 ;;(println "before :" (get-mem-region before))
rlm@405 559 ;;(println "after :" (get-mem-region after))
rlm@405 560 ;;(assert (= assembly (take 4 (get-mem-region after))))
rlm@405 561 (println "write-test-passed.")
rlm@377 562 after))
rlm@377 563
rlm@402 564 (defn test-jump []
rlm@377 565 (let [target-address 0xC00F
rlm@377 566 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 567 post-jump
rlm@402 568 (-> (test-write-bytes)
rlm@402 569 (step (buttons set-H-mode)) ; select set-H
rlm@402 570 (step (buttons target-high))
rlm@377 571 (step [])
rlm@402 572 (step (buttons set-L-mode))
rlm@402 573 (step (buttons target-low))
rlm@377 574 (step [])
rlm@402 575 (step (buttons jump-mode))) ; Select JUMP mode.
rlm@377 576 program-counters
rlm@377 577 (capture-program-counter
rlm@377 578 post-jump
rlm@377 579 10000)]
rlm@377 580 (assert (contains? (set program-counters) target-address))
rlm@405 581 (println "jump test passed.")
rlm@377 582 post-jump))
rlm@402 583
rlm@405 584 (defn test-no-repeated-nybbles []
rlm@405 585 (bootstrap-pattern (main-bootstrap-program))
rlm@405 586 (println "no-repeated-nybbles"))
rlm@402 587
rlm@402 588 (defn run-all-tests []
rlm@402 589 (test-frame-metronome)
rlm@402 590 (test-read-user-input)
rlm@402 591 (test-set-H)
rlm@402 592 (test-write-bytes)
rlm@405 593 (test-jump)
rlm@405 594 (test-no-repeated-nybbles)
rlm@405 595 (println "\n all tests passed."))