Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/rlm_assembly.clj @ 612:00c5cdfb9da7

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