summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAleksei Eaves <alekseijeaves@protonmail.com>2024-04-14 12:50:36 +1000
committerAleksei Eaves <alekseijeaves@protonmail.com>2024-04-14 12:50:36 +1000
commit75db422f7b9c73f1057bf3187c73bfaeb6003a0b (patch)
tree71639abce71a942fe593ba9e5111291da061bbc2
parent5fd0592e0bf449ec25392d2cb1b4c3b45b9cd718 (diff)
Shifted things around
-rw-r--r--6502.lisp99
-rw-r--r--utilities.lisp7
2 files changed, 15 insertions, 91 deletions
diff --git a/6502.lisp b/6502.lisp
index 1115a21..38814af 100644
--- a/6502.lisp
+++ b/6502.lisp
@@ -1,4 +1,6 @@
;; -*- mode: common-lisp -*-
+;; 6502.lisp
+;; Contains data structures specific to the 6502 system.
#|
clasm-6502: An assembler for the 6502 written in Common Lisp.
Copyright (C) 2024 Aleksei Eaves
@@ -20,7 +22,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; List of addressing modes and their length.
(defparameter
- *addressing-modes*
+ *addressing-mode-lengths*
'((immediate 2)
(absolute 3)
(zero-page 2)
@@ -35,6 +37,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(relative 2)
(accumulator 1)))
+;; Generated list of addressing modes.
+(defparameter
+ *addressing-modes*
+ (extract-keys *addressing-modes-lengths*))
+
;;; Instructions, with decimal opcode and
;;; addressing modes.
(defparameter
@@ -206,93 +213,3 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(defparameter
*opcodes*
(extract-keys *instructions*))
-
-(defun valid-instruction? (instruction addressing-mode)
- "Is instruction and addressing mode combination correct?"
- (cond
- ((member addressing-mode
- (caddr (assoc instruction *instructions*))) t)
- (t nil)))
-
-;; A list with with the respective rules of
-;; addressing mode syntax.
-(defparameter
- *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)))))))
diff --git a/utilities.lisp b/utilities.lisp
index c231f72..cb6aa51 100644
--- a/utilities.lisp
+++ b/utilities.lisp
@@ -73,3 +73,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
return-value))
;; Return nil if string was not a hexadecimal number.
nil))
+
+(defun valid-instruction? (instruction addressing-mode)
+ "Is instruction and addressing mode combination correct?"
+ (cond
+ ((member addressing-mode
+ (caddr (assoc instruction *instructions*))) t)
+ (t nil)))