test-asm.lisp (3493 bytes)
1 ;;; test-asm.lisp -- layer 2 tests: every instruction form the assembler knows, 2 ;;; assembled by asm.lisp and by the z80pack reference assembler (z80asm); 3 ;;; one instruction per check, bytes must match exactly. 4 ;;; Run: sbcl --script test-asm.lisp (needs Z80ASM, default ~/src/z80pack/z80asm/z80asm) 5 (load (merge-pathnames "asm.lisp" *load-truename*)) 6 (in-package :z80) 7 8 (defparameter *cases* 9 (let ((r8 '(b c d e h l (@ hl) a)) (out '())) 10 (flet ((add (f) (push f out))) 11 (dolist (x r8) (dolist (y r8) (unless (and (consp x) (consp y)) (add `(ld ,x ,y))))) 12 (dolist (x r8) (add `(ld ,x 66)) (add `(inc ,x)) (add `(dec ,x))) 13 (dolist (x '(b c d e h l a)) (add `(ld ,x (@ ix 5))) (add `(ld (@ ix -3) ,x))) 14 (dolist (op '(add adc sbc)) (dolist (x r8) (add `(,op a ,x))) (add `(,op a 7)) (add `(,op a (@ ix 2)))) 15 (dolist (op '(sub and xor or cp)) (dolist (x r8) (add `(,op ,x))) (add `(,op 200)) (add `(,op (@ ix 2)))) 16 (dolist (rr '(bc de hl sp)) (add `(ld ,rr 4660)) (add `(inc ,rr)) (add `(dec ,rr)) 17 (add `(add hl ,rr)) (add `(adc hl ,rr)) (add `(sbc hl ,rr)) (add `(ld ,rr (@ 4660))) (add `(ld (@ 4660) ,rr))) 18 (dolist (rr '(bc de ix sp)) (add `(add ix ,rr))) 19 (dolist (rr '(bc de hl af ix)) (add `(push ,rr)) (add `(pop ,rr))) 20 (dolist (cc '(nz z nc c po pe p m)) (add `(jp ,cc 4660)) (add `(call ,cc 4660)) (add `(ret ,cc))) 21 (dolist (cc '(nz z nc c)) (add `(jr ,cc 0))) 22 (dolist (op '(rlc rrc rl rr sla sra srl)) (dolist (x r8) (add `(,op ,x)))) 23 (dolist (op '(bit res set)) (dolist (n '(0 3 7)) (dolist (x r8) (add `(,op ,n ,x))))) 24 (dolist (p '(0 8 16 56)) (add `(rst ,p))) 25 (dolist (f '((ld a (@ bc)) (ld a (@ de)) (ld (@ bc) a) (ld (@ de) a) (ld a (@ 4660)) (ld (@ 4660) a) 26 (ld sp hl) (ld sp ix) (ld ix 4660) (ld ix (@ 4660)) (ld (@ 4660) ix) (ld (@ ix 4) 9) 27 (inc ix) (dec ix) (inc (@ ix 1)) (dec (@ ix 1)) (jp 4660) (jp (@ hl)) (jp (@ ix)) 28 (call 4660) (jr 0) (djnz 0) (ex de hl) (ex (@ sp) hl) (ex (@ sp) ix) (ex af af) 29 (in a (@ 40)) (out (@ 41) a) (nop) (rlca) (rrca) (rla) (rra) (cpl) (scf) (ccf) 30 (db 1 255 "ab") (dw 4660 1) (halt) (di) (ei) (ret) (exx) (neg) (ldir) (lddr) (cpir))) 31 (add f))) 32 (nreverse out))) 33 34 (defun reference-bytes (form) 35 (let ((src "/tmp/z80t.asm") (bin "/tmp/z80t.bin")) 36 (with-open-file (s src :direction :output :if-exists :supersede) 37 (format s " ~a~%" (insn->text form))) 38 (sb-ext:run-program (or (sb-ext:posix-getenv "Z80ASM") 39 (concatenate 'string (or (sb-ext:posix-getenv "Z80PACK") 40 (concatenate 'string (sb-ext:posix-getenv "HOME") "/src/z80pack")) 41 "/z80asm/z80asm")) 42 (list "-fb" (concatenate 'string "-o" bin) src) :output nil :error nil) 43 (with-open-file (s bin :element-type '(unsigned-byte 8)) 44 (let ((v (make-array (file-length s) :element-type '(unsigned-byte 8)))) (read-sequence v s) v)))) 45 46 (let ((pass 0) (fail 0)) 47 (dolist (f *cases*) 48 (let ((mine (ignore-errors (assemble (list f)))) (ref (reference-bytes f))) 49 (if (equalp mine ref) (incf pass) 50 (progn (incf fail) (format t "MISMATCH ~a: ours ~x ref ~x~%" (insn->text f) mine ref))))) 51 (format t "assembler: ~d passed, ~d failed, ~d total~%" pass fail (+ pass fail)) 52 (sb-ext:exit :code (if (zerop fail) 0 1)))