Permalink
Browse files

Finish automating Klaus' test-suite. We pass with flying colors!

  • Loading branch information...
1 parent 6cd6ee9 commit aa90f1ee4c638e3cf2e70ad8535ae0bcba9461c5 @kingcons committed Mar 13, 2013
Showing with 13 additions and 16 deletions.
  1. +1 −0 NEWS.md
  2. +12 −16 tests/opcodes.lisp
View
@@ -1,5 +1,6 @@
## Changes for 0.9.0 (2013-03-xx):
+* Perfect run on Klaus Dorfmann's test suite aside from decimal mode ADC/SBC.
* Added and exported CURRENT-INSTRUCTION helper.
* Fix stack wraparound in PHP, PLA, etc.
View
@@ -3,27 +3,23 @@
(def-suite opcodes :in 6502-tests)
(in-suite opcodes)
-;; Klaus test-suite jumps to self to indicate successful completion.
-(defvar *debug* nil)
-
-(defmethod 6502-step :before ((cpu cpu) opcode)
- (when *debug*
- (6502::disasm-ins (immediate cpu))))
-
-(defmethod 6502::jmp :around ((opcode (eql 76)) cpu &key mode setf-form)
- (when *debug*
- (let ((result (call-next-method)))
- (if (= (absolute cpu) (cpu-pc cpu))
- :done
- result))))
-
(defun klaus-init ()
(let ((test-rom (read-file-into-byte-vector (app-path "tests/test.bin"))))
(setf (get-range #x0a) test-rom
(cpu-pc *cpu*) #x1000)))
+(defun klaus-test ()
+ (let ((cycles (* 45 (expt 2 21))))
+ (loop until (> (cpu-cc *cpu*) cycles)
+ do (6502-step *cpu* (get-byte (immediate *cpu*))))))
+
(deftest pass-klaus-test-suite
"We should pass Klaus Dorfmann's test suite."
(klaus-init)
- (let ((*debug* t))
- (is (eql (execute cpu) :done))))
+ (klaus-test)
+ (destructuring-bind (op addr) (current-instruction cpu)
+ (is (and (eql op :jmp)
+ (eql (6502::extract-num (format nil "~A" addr)) (cpu-pc cpu))))
+ ;; There are multiple traps in the code that are jump-to-self.
+ ;; Only 0x3c37 is the 'success' macro. Disasm surrounding code to verify.
+ (is (eql (cpu-pc cpu) #x3c37))))

0 comments on commit aa90f1e

Please sign in to comment.