diff options
Diffstat (limited to '6502.lisp')
| -rw-r--r-- | 6502.lisp | 310 |
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") |