Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/rlm_assembly.clj @ 402:eee219d1a259

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
all tests passed.
author Robert McIntyre <rlm@mit.edu>
date Fri, 13 Apr 2012 09:47:34 -0500
parents 0262094d0914
children ea37e98e188e
comparison
equal deleted inserted replaced
401:0262094d0914 402:eee219d1a259
272 input output))) 272 input output)))
273 resolve-internal-jumps 273 resolve-internal-jumps
274 {:output-start [] 274 {:output-start []
275 :to-output 275 :to-output
276 (->signed-8-bit 276 (->signed-8-bit
277 (- (symbol-index :output-start program**) 277 (dec
278 (symbol-index :to-output program**)))} 278 (- (symbol-index :output-start program**)
279 (symbol-index :to-output program**))))}
279 280
280 program* 281 program*
281 (flatten (replace resolve-internal-jumps program**)) 282 (flatten (replace resolve-internal-jumps program**))
282 283
283 resolve-external-jumps 284 resolve-external-jumps
315 316
316 (defn test-set-H [] 317 (defn test-set-H []
317 (letfn [(test-H [state n] 318 (letfn [(test-H [state n]
318 (let [after 319 (let [after
319 (-> state 320 (-> state
320 (step (buttons set-H)) 321 (step (buttons set-H-mode))
321 (step (buttons n)) 322 (step (buttons n))
322 (step []))] 323 (step []))]
323 ;;(println "desired H =" n "actual =" (H after)) 324 ;;(println "desired H =" n "actual =" (H after))
324 (assert (= n (H after))) 325 (assert (= n (H after)))
325 after))] 326 after))]
336 after 337 after
337 (-> before 338 (-> before
338 (step []) ; make sure it can handle blanks 339 (step []) ; make sure it can handle blanks
339 (step []) ; at the beginning. 340 (step []) ; at the beginning.
340 (step []) 341 (step [])
341 (step (buttons set-H)) ; select set-H 342 (step (buttons set-H-mode)) ; select set-H
342 (step (buttons target-high)) 343 (step (buttons target-high))
343 (step []) 344 (step [])
344 (step (buttons set-L)) 345 (step (buttons set-L-mode))
345 (step (buttons target-low)) 346 (step (buttons target-low))
346 (step []) 347 (step [])
347 (step (buttons write-mode)) 348 (step (buttons write-mode))
348 (step (buttons 4)) ; write 4 bytes 349 (step (buttons 4)) ; write 4 bytes
349 (step (buttons (nth assembly 0))) 350 (step (buttons (nth assembly 0)))
353 (step []) 354 (step [])
354 (step []) 355 (step [])
355 (step []))] 356 (step []))]
356 (println "before :" (get-mem-region before)) 357 (println "before :" (get-mem-region before))
357 (println "after :" (get-mem-region after)) 358 (println "after :" (get-mem-region after))
358 ;;(assert (= assembly (take 4 (get-mem-region after)))) 359 (assert (= assembly (take 4 (get-mem-region after))))
359 after)) 360 after))
360 361
361 (defn test-jump-mode [] 362 (defn test-jump []
362 (let [target-address 0xC00F 363 (let [target-address 0xC00F
363 [target-high target-low] (disect-bytes-2 target-address) 364 [target-high target-low] (disect-bytes-2 target-address)
364 post-jump 365 post-jump
365 (-> (test-write-bytes-mode) 366 (-> (test-write-bytes)
366 (step []) 367 (step (buttons set-H-mode)) ; select set-H
367 (step [])
368 (step [])
369 (step (buttons 0xFF)) ; Select JUMP mode.
370 (step (buttons target-high)) 368 (step (buttons target-high))
371 (step (buttons target-low))) 369 (step [])
370 (step (buttons set-L-mode))
371 (step (buttons target-low))
372 (step [])
373 (step (buttons jump-mode))) ; Select JUMP mode.
372 program-counters 374 program-counters
373 (capture-program-counter 375 (capture-program-counter
374 post-jump 376 post-jump
375 10000)] 377 10000)]
376 (println program-counters)
377 (assert (contains? (set program-counters) target-address)) 378 (assert (contains? (set program-counters) target-address))
379 (println "jump test passed")
378 post-jump)) 380 post-jump))
381
382
383 (defn run-all-tests []
384 (test-frame-metronome)
385 (test-read-user-input)
386 (test-set-H)
387 (test-write-bytes)
388 (test-jump))