Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/rlm_assembly.clj @ 513:3dbb863eb801

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
accuracy of displayed image is much improved, but there the palettes are still messed up.
author Robert McIntyre <rlm@mit.edu>
date Fri, 22 Jun 2012 18:58:47 -0500
parents 21b8b3350b20
children 9068685e7d96
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@403 358 (defn main-bootstrap-program
rlm@403 359 ([] (main-bootstrap-program pokemon-list-start))
rlm@403 360 ([start-address]
rlm@403 361 ;; Register Use:
rlm@403 362
rlm@403 363 ;; ED non-volitale scratch
rlm@403 364
rlm@403 365 ;; A user-input
rlm@403 366 ;; HL target-address
rlm@403 367 ;; B bytes-to-write
rlm@403 368 ;; C non-volatile scratch
rlm@385 369
rlm@403 370 ;; Modes (with codes) are:
rlm@390 371
rlm@403 372 ;; single-action-modes:
rlm@403 373 ;; SET-TARGET-HIGH 0x67 ;; A->H
rlm@403 374 ;; SET-TARGET-LOW 0x6F ;; A->L
rlm@403 375 ;; JUMP 0xE9 ;; jump to (HL)
rlm@390 376
rlm@403 377 ;; multi-action-modes
rlm@403 378 ;; WRITE 0x47 ;; A->B
rlm@390 379
rlm@416 380 (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@416 381 header (concat (frame-metronome) (read-user-input))
rlm@404 382
rlm@403 383 input
rlm@403 384 [0xC1 ;; pop BC so it's not volatile
rlm@388 385
rlm@403 386 0x5F ;; A->E
rlm@403 387 0xAF ;; test for output-mode (bytes-to-write > 0)
rlm@403 388 0xB8 ;; (cp A B)
rlm@403 389 0x7B ;; E->A
rlm@403 390 0x20 ;; skip to output section if
rlm@403 391 :to-output ;; we're not in input mode
rlm@403 392
rlm@403 393 :to-be-executed
rlm@391 394
rlm@403 395 ;; write mode to instruction-to-be-executed (pun)
rlm@403 396 0xEA
rlm@403 397 :to-be-executed-address
rlm@388 398
rlm@403 399 ;; protection region -- do not queue this op for
rlm@403 400 ;; execution if the last one was non-zero
rlm@403 401 0x79 ;; C->A
rlm@403 402 0xA7 ;; test A==0
rlm@403 403 0x28
rlm@403 404 0x04
rlm@403 405 0xAF ;; put a no op (0x00) in to-be-executed
rlm@403 406 0xEA ;;
rlm@403 407 :to-be-executed-address
rlm@403 408
rlm@403 409 0x7B ;; E->A
rlm@403 410 0x4F ;; A->C now C stores previous instruction
rlm@403 411 0x18 ;; return
rlm@416 412 :to-jump]
rlm@403 413
rlm@403 414 output
rlm@403 415 [:output-start ;; just a label
rlm@405 416 0x3F ;; ;; prevent repeated nybbles
rlm@403 417 0x54 ;;
rlm@403 418 0x5D ;; HL->DE \
rlm@404 419 ;; | This mess is here to do
rlm@403 420 0x12 ;; A->(DE) | 0x22 (LDI (HL), A) without
rlm@405 421 ;; / any repeating nybbles
rlm@403 422 0x05 ;; DEC bytes-to-write (B)
rlm@391 423
rlm@405 424 0x23 ;; inc HL
rlm@405 425
rlm@403 426 0x18
rlm@404 427 :to-beginning]
rlm@404 428
rlm@403 429 symbols
rlm@403 430 {:to-be-executed-address
rlm@403 431 (reverse
rlm@403 432 (disect-bytes-2
rlm@404 433 (+ start-address
rlm@404 434 (count header)
rlm@416 435 (count init)
rlm@403 436 (symbol-index :to-be-executed input))))
rlm@405 437 :to-be-executed 0x3F} ;; clear carry flag no-op
rlm@392 438
rlm@403 439 program** (flatten
rlm@416 440 (replace
rlm@416 441 symbols
rlm@416 442 (concat init header input output)))
rlm@404 443
rlm@403 444 resolve-internal-jumps
rlm@403 445 {:output-start []
rlm@403 446 :to-output
rlm@403 447 (->signed-8-bit
rlm@403 448 (dec
rlm@403 449 (- (symbol-index :output-start program**)
rlm@403 450 (symbol-index :to-output program**))))}
rlm@391 451
rlm@403 452 program*
rlm@403 453 (flatten (replace resolve-internal-jumps program**))
rlm@403 454
rlm@403 455 resolve-external-jumps
rlm@416 456 {:to-jump
rlm@404 457 (- (- (symbol-index :to-beginning program*)
rlm@416 458 (symbol-index :to-jump program*)) 2)
rlm@404 459
rlm@404 460 :to-beginning
rlm@403 461 (->signed-8-bit
rlm@416 462 (+ (count init) -1
rlm@404 463 (- (symbol-index :to-beginning program*))))}
rlm@389 464
rlm@403 465 program
rlm@403 466 (replace resolve-external-jumps program*)]
rlm@403 467 program)))
rlm@414 468
rlm@414 469
rlm@414 470 (defn no-consecutive-repeats? [seq]
rlm@414 471 (not (contains? (set(map - seq (rest seq))) 0)))
rlm@414 472
rlm@414 473 (defn byte->nybbles [byte]
rlm@414 474 [(bit-shift-right byte 4) (bit-and byte 0x0F)])
rlm@414 475
rlm@414 476 (defn bootstrap-pattern
rlm@414 477 "Given an assembly sequence, generate the keypresses required to
rlm@414 478 create that sequence in memory using the pc-item-writer
rlm@414 479 program. The assembly must not have any consecutive repeating
rlm@414 480 nybbles."
rlm@414 481 [assembly]
rlm@414 482 (let [nybbles (flatten (map byte->nybbles assembly))
rlm@414 483 moves (map (comp buttons (partial - 15)) nybbles)
rlm@414 484 header (map buttons
rlm@414 485 (concat (repeat
rlm@414 486 50
rlm@414 487 (- 15 (first nybbles)))
rlm@415 488 [(first nybbles)]))]
rlm@414 489 (assert (no-consecutive-repeats? nybbles))
rlm@415 490 (concat header moves)))
rlm@378 491
rlm@377 492 ;;;;;; TESTS ;;;;;;
rlm@377 493
rlm@401 494 (def set-H-mode 0x67)
rlm@401 495 (def set-L-mode 0x6F)
rlm@401 496 (def jump-mode 0xE9)
rlm@401 497 (def write-mode 0x47)
rlm@401 498
rlm@401 499
rlm@377 500 (defn bootstrap-base []
rlm@377 501 (let [program (main-bootstrap-program pokemon-list-start)]
rlm@377 502 ;; make sure program is valid output for item-writer
rlm@377 503 (-> (tick (mid-game))
rlm@377 504 (set-memory-range pokemon-list-start program)
rlm@400 505 (PC! pokemon-list-start)
rlm@400 506 (step [])
rlm@400 507 (step []))))
rlm@377 508
rlm@400 509 (defn test-set-H []
rlm@400 510 (letfn [(test-H [state n]
rlm@400 511 (let [after
rlm@400 512 (-> state
rlm@402 513 (step (buttons set-H-mode))
rlm@400 514 (step (buttons n))
rlm@400 515 (step []))]
rlm@401 516 ;;(println "desired H =" n "actual =" (H after))
rlm@400 517 (assert (= n (H after)))
rlm@400 518 after))]
rlm@403 519 (let [result (reduce test-H (bootstrap-base) (range 0x100))]
rlm@405 520 (println "set H test passed.")
rlm@403 521 result)))
rlm@400 522
rlm@401 523 (defn test-write-bytes []
rlm@377 524 (let [target-address 0xC00F
rlm@377 525 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 526 assembly [0xF3 0x18 0xFE 0x12]
rlm@377 527 get-mem-region #(subvec (vec (memory %))
rlm@377 528 target-address (+ target-address 20))
rlm@377 529 before (bootstrap-base)
rlm@377 530 after
rlm@377 531 (-> before
rlm@392 532 (step []) ; make sure it can handle blanks
rlm@392 533 (step []) ; at the beginning.
rlm@377 534 (step [])
rlm@402 535 (step (buttons set-H-mode)) ; select set-H
rlm@401 536 (step (buttons target-high))
rlm@401 537 (step [])
rlm@402 538 (step (buttons set-L-mode))
rlm@401 539 (step (buttons target-low))
rlm@401 540 (step [])
rlm@401 541 (step (buttons write-mode))
rlm@392 542 (step (buttons 4)) ; write 4 bytes
rlm@377 543 (step (buttons (nth assembly 0)))
rlm@377 544 (step (buttons (nth assembly 1)))
rlm@377 545 (step (buttons (nth assembly 2)))
rlm@409 546 (step (buttons (nth assembly 3))))]
rlm@405 547 ;;(println "before :" (get-mem-region before))
rlm@405 548 ;;(println "after :" (get-mem-region after))
rlm@405 549 ;;(assert (= assembly (take 4 (get-mem-region after))))
rlm@405 550 (println "write-test-passed.")
rlm@377 551 after))
rlm@377 552
rlm@402 553 (defn test-jump []
rlm@377 554 (let [target-address 0xC00F
rlm@377 555 [target-high target-low] (disect-bytes-2 target-address)
rlm@377 556 post-jump
rlm@402 557 (-> (test-write-bytes)
rlm@402 558 (step (buttons set-H-mode)) ; select set-H
rlm@402 559 (step (buttons target-high))
rlm@377 560 (step [])
rlm@402 561 (step (buttons set-L-mode))
rlm@402 562 (step (buttons target-low))
rlm@377 563 (step [])
rlm@402 564 (step (buttons jump-mode))) ; Select JUMP mode.
rlm@377 565 program-counters
rlm@377 566 (capture-program-counter
rlm@377 567 post-jump
rlm@377 568 10000)]
rlm@377 569 (assert (contains? (set program-counters) target-address))
rlm@405 570 (println "jump test passed.")
rlm@377 571 post-jump))
rlm@402 572
rlm@405 573 (defn test-no-repeated-nybbles []
rlm@405 574 (bootstrap-pattern (main-bootstrap-program))
rlm@405 575 (println "no-repeated-nybbles"))
rlm@402 576
rlm@402 577 (defn run-all-tests []
rlm@402 578 (test-frame-metronome)
rlm@402 579 (test-read-user-input)
rlm@402 580 (test-set-H)
rlm@402 581 (test-write-bytes)
rlm@405 582 (test-jump)
rlm@405 583 (test-no-repeated-nybbles)
rlm@405 584 (println "\n all tests passed."))