From 75db422f7b9c73f1057bf3187c73bfaeb6003a0b Mon Sep 17 00:00:00 2001
From: Aleksei Eaves <alekseijeaves@protonmail.com>
Date: Sun, 14 Apr 2024 12:50:36 +1000
Subject: Shifted things around

---
 6502.lisp | 99 ++++++---------------------------------------------------------
 1 file changed, 8 insertions(+), 91 deletions(-)

(limited to '6502.lisp')

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)))))))
-- 
cgit v1.2.3