summaryrefslogtreecommitdiff
path: root/6502.lisp
diff options
context:
space:
mode:
Diffstat (limited to '6502.lisp')
-rw-r--r--6502.lisp310
1 files changed, 310 insertions, 0 deletions
diff --git a/6502.lisp b/6502.lisp
new file mode 100644
index 0000000..23696ac
--- /dev/null
+++ b/6502.lisp
@@ -0,0 +1,310 @@
+;; -*- mode: common-lisp -*-
+
+;; Every instruction, its decimal opcode, and the
+;; usable addressing modes.
+(setf
+ *instructions*
+ ;; Load & Store
+ '((LDA 169 (immediate
+ absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ (LDX 162 (immediate
+ zero-page
+ zero-page-indexed-y
+ absolute
+ absolute-indexed-y))
+ (LDY 160 (immediate
+ zero-page
+ zero-page-indexed-x
+ absolute
+ absolute-indexed-x))
+ (STA 137 (absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ (STX 130 (zero-page
+ zero-page-indexed-y
+ absolute))
+ (STY 128 (zero-page
+ zero-page-indexed-x
+ absolute))
+ ;;Arithmetic
+ (ADC 105 (immediate
+ absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ (SBC 233 (immediate
+ absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ ;;Increment & Decrement
+ (INC 226 (zero-page
+ zero-page-indexed-x
+ absolute
+ absolute-indexed-x))
+ (INX 232 (implied))
+ (INY 200 (implied))
+ (DEC 194 (zero-page
+ zero-page-indexed-x
+ absolute
+ absolute-indexed-x))
+ (DEX 202 (implied))
+ (DEY 136 (implied))
+ ;; Logical
+ (AND 41 (immediate
+ absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ (ORA 9 (immediate
+ absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ (EOR 73 (immediate
+ absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ ;; Jump, Branch, Compare
+ (JMP 72 (absolute
+ indirect-absolute))
+ (BCC 144 (relative))
+ (BCS 176 (relative))
+ (BEQ 240 (relative))
+ (BNE 208 (relative))
+ (BMI 48 (relative))
+ (BPL 16 (relative))
+ (BVS 112 (relative))
+ (BVC 80 (relative))
+ (CMP 201 (immediate
+ absolute
+ zero-page
+ absolute-indexed-x
+ absolute-indexed-y
+ zero-page-indexed-x
+ indexed-indirect
+ indirect-indexed))
+ (CPX 224 (immediate
+ zero-page
+ absolute))
+ (CPY 192 (immediate
+ zero-page
+ absolute))
+ (BIT 32 (zero-page
+ absolute))
+ ;; Shift & Rotate
+ (ASL 10 (accumulator
+ zero-page
+ zero-page-indexed-x
+ absolute
+ absolute-indexed-x))
+ (LSR 74 (accumulator
+ zero-page
+ zero-page-indexed-x
+ absolute
+ absolute-indexed-x))
+ (ROL 42 (accumulator
+ zero-page
+ zero-page-indexed-x
+ absolute
+ absolute-indexed-x))
+ (ROR 106 (accumulator
+ zero-page
+ zero-page-indexed-x
+ absolute
+ absolute-indexed-x))
+ ;; Transfer
+ (TAX 170 (implied))
+ (TAY 168 (implied))
+ (TXA 138 (implied))
+ (TYA 152 (implied))
+ ;; Stack
+ (TSX 186 (implied))
+ (TXS 154 (implied))
+ (PHA 72 (implied))
+ (PHP 8 (implied))
+ (PLA 104 (implied))
+ (PLP 40 (implied))
+ ;; Subroutine
+ (JSR 32 (implied))
+ (RTI 64 (implied))
+ (RTS 96 (implied))
+ ;; Set & Reset
+ (CLC 24 (implied))
+ (CLD 216 (implied))
+ (CLI 88 (implied))
+ (CLV 184 (implied))
+ (SEC 56 (implied))
+ (SED 248 (implied))
+ (SEI 120 (implied))
+ ;; Other
+ (NOP 234 (implied))
+ (BRK 0 (implied))))
+
+;; Predicate: is a combination of instruction
+;; and addressing mode correct?
+(defun valid-instruction? (instruction addressing-mode)
+ (dolist (x *instructions* nil)
+ (when
+ (and
+ (equal (car x) instruction)
+ (member addressing-mode (caddr x)))
+ (return T))))
+
+;; Is string hexadecimal?
+(defun hexd? (string)
+ (let ((stack ()))
+ (dotimes (i (length string))
+ (push
+ (or (and (char-not-lessp
+ (char string i) #\0)
+ (char-not-greaterp
+ (char string i) #\9))
+ (and (char-not-lessp
+ (char string i) #\A)
+ (char-not-greaterp
+ (char string i) #\F)))
+ stack))
+ (push 'and stack)
+ (eval stack)))
+
+;; Convert an arbitrarily sized hexadecimal number as
+;; string, to a positive decimal integer.
+(defun hex2dec (string)
+ (flet ((hex (c)
+ (cond
+ ((and (char-not-lessp c #\0)
+ (char-not-greaterp c #\9))
+ (- (char-code c)
+ (char-code #\0)))
+ ((and (char-not-lessp c #\A)
+ (char-not-greaterp c #\F))
+ (+ (- (char-code (char-downcase c))
+ (char-code #\a))
+ 10)))))
+ (let ((ret 0))
+ (do ((i 0 (incf i))
+ (j (- (length string) 1) (decf j)))
+ ((minusp j) ())
+ (setf ret
+ (+ ret
+ (* (expt 16 j)
+ (hex (char string i))))))
+ ret)))
+
+;;(define-compiler-macro (list)
+;; A list with with the respective rules of some
+;; addressing mode syntax.
+;; ... ... ... could definitely macro most of them.
+(setf
+ *addressing-modes-syntax*
+ '((immediate ; #?? ... more complex syntax rules for later
+ (lambda (s)
+ (eq "#" (subseq s 0 1))))
+ (absolute ;"$????"
+ (lambda (s)
+ (and
+ (equal (length s) 5)
+ (equal "$" (subseq s 0 1))
+ (hexd? (subseq s 1 5)))))
+ (zero-page ;"$??"
+ (lambda (s)
+ (and
+ (equal (length s) 3)
+ (equal "$" (subseq s 0 1))
+ (hexd? (subseq s 1 3)))))
+ (implied nil)
+ (indirect-absolute ;($????)
+ (lambda (s)
+ (and
+ (equal (length s) 7)
+ (equal "($" (subseq s 0 2))
+ (hexd? (subseq s 1 5))
+ (equal ")" (subseq s 5 6)))))
+ (absolute-indexed-x ;"$????,X"
+ (lambda (s)
+ (and
+ (equal (length s) 7)
+ (equal "$" (subseq s 0 1))
+ (hexd? (subseq s 1 5))
+ (equal ",X" (subseq s 5 7)))))
+ (absolute-indexed-y ;"$????,Y"
+ (lambda (s)
+ (and
+ (equal (length s) 7)
+ (equal "$" (subseq s 0 1))
+ (hexd? (subseq s 1 5))
+ (equal ",Y" (subseq s 5 7)))))
+ (zero-page-indexed-x ;"$??,X"
+ (lambda (s)
+ (and
+ (equal (length s) 5)
+ (equal (subseq s 0 1) "$")
+ (hexd? (subseq s 1 3))
+ (equal (subseq s 3 5) ",X"))))
+ (zero-page-indexed-y ;"$??,Y"
+ (lambda (s)
+ (and
+ (equal (length s) 5)
+ (equal (subseq s 0 1) "$")
+ (hexd? (subseq s 1 3))
+ (equal (subseq s 3 5) ",Y"))))
+ (indexed-indirect ;"($??,X)"
+ (lambda (s)
+ (and
+ (equal (length s) 7)
+ (equal (subseq s 0 2) "($")
+ (hexd? (subseq s 2 4))
+ (equal (subseq s 4 7) ",X)"))))
+ (indirect-indexed ;"($??),Y"
+ (lambda (s)
+ (and
+ (equal (length s) 7)
+ (equal (subseq s 0 2) "($")
+ (hexd? (subseq s 2 4))
+ (equal (subseq s 4 7) "),Y"))))
+ ;;How to fix that relative and absolute are the same rule?
+ ;;A check upstream would suffice.
+ (relative ;"$????"
+ (lambda (s)
+ (and
+ (equal (length s) 5)
+ (equal (subseq s 0 1) "$")
+ (hexd? (subseq s 1 5)))))
+ (accumulator ;"A"
+ (lambda (s)
+ (and
+ (equal (length s) 1)
+ (equal "A" (subseq s 0 1)))))))
+
+;; EXAMPLE
+;; Evaluate the second syntax rule on a string
+(funcall
+ (eval (cadar (cdr *addressing-modes-syntax*)))
+ "$A6AF")