diff --git a/lisp/cpu.fasl b/lisp/cpu.fasl old mode 100644 new mode 100755 index 203fdb0..ab5bc15 Binary files a/lisp/cpu.fasl and b/lisp/cpu.fasl differ diff --git a/lisp/cpu.lisp b/lisp/cpu.lisp index f208e42..ddedd76 100644 --- a/lisp/cpu.lisp +++ b/lisp/cpu.lisp @@ -6,11 +6,13 @@ (x :initform 0 :accessor x) (y :initform 0 :accessor y) (a :initform 0 :accessor a) + (s :initform 0 :accessor s) (pc :initform 0 :accessor pc) (n :initform nil :accessor n) (z :initform nil :accessor z) (c :initform nil :accessor c) (i :initform nil :accessor i) + (cli-delay :initform -1 :accessor cli-delay) (d :initform nil :accessor d) (v :initform nil :accessor v) (b :initform nil :accessor b))) @@ -21,11 +23,13 @@ `(with-accessors ((x x) (y y) (a a) + (s s) (pc pc) (n n) (z z) (c c) (i i) + (cli-delay cli-delay) (d d) (v v) (b b)) @@ -47,6 +51,9 @@ (defun run-instruction () (with-cpu *cpu* + (when (> cli-delay 0) + (when (= (decf cli-delay) 0) + (setf i nil))) (run (decode (fetch-instruction)) (fetch-arguments)))) (defun fetch-instruction () @@ -122,7 +129,19 @@ (defun run (instr arguments) (funcall (symbol-function instr) *cpu* arguments)) - +;; Load / Store Operations +(defnzopcode tax + (setf x a)) +(defnzopcode tay + (setf y a)) +(defnzopcode tsx + (setf x s)) +(defopcode txs + (setf s x)) +(defnzopcode txa + (setf a x)) +(defnzopcode tya + (setf a y)) (defnzopcode lax (setf x (car args)) (setf a (car args))) @@ -139,6 +158,39 @@ (defopcode sty (mem-write (car args) y)) +;; Flag operations +(defopcode clc + (setf c nil)) +(defopcode sec + (setf c t)) +(defopcode cli + (setf cli-delay 1)) +(defopcode sei + (setf i t)) +(defopcode clv + (setf v nil)) +(defopcode cld + (setf d nil)) +(defopcode sed + (setf d t)) + +;; Boolean Operations +(defnzopcode 6502-and + (setf a (boole boole-and a (car args)))) +(defnzopcode eor + (setf a (boole boole-xor a (car args)))) +(defnzopcode ora + (setf a (boole boole-ior a (car args)))) +(defnzopcode asl + (let ((value (lsh ()))) + (if (= (car args) -1) + (setf a value) + (mem-write (car args) value)))) +(defopcode bit + (setf z (= 0 (boole boole-and a (car args)))) + (setf v (/= 0 (boole boole-and #x40 (car args)))) + (setf n (/= 0 (boole boole-and #x80 (car args))))) + (defopcode nop '())