From 4faa636ffb51461001af6e4378fe6461de4583de Mon Sep 17 00:00:00 2001
From: Aleksei Eaves <alekseijeaves@protonmail.com>
Date: Tue, 16 Apr 2024 15:03:54 +1000
Subject: Added addressing mode binary conversion

---
 binary.lisp | 103 +++++++++++++++++++++++++++++
 labels.lisp |  20 ++++++
 main.lisp   |   3 +
 syntax.lisp | 214 ++++++++++++++++++++++++++++++------------------------------
 4 files changed, 233 insertions(+), 107 deletions(-)
 create mode 100644 binary.lisp
 create mode 100644 labels.lisp

diff --git a/binary.lisp b/binary.lisp
new file mode 100644
index 0000000..75ca5e9
--- /dev/null
+++ b/binary.lisp
@@ -0,0 +1,103 @@
+;; -*- mode: common-lisp -*-
+#|
+clasm-6502: An assembler for the 6502 written in Common Lisp.
+Copyright (C) 2024  Aleksei Eaves
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+|#
+
+;; Rules for converting an addressing mode argument.
+(defparameter
+	*convert-addressing-modes*
+  '(
+	(immediate
+	 (lambda (s)
+	   (let ((return-value 0) ; Final return value.
+			 (operand nil))   ; Stores +/- found.
+		 (dotimes (i (length s))
+		   (cond
+			 ;; Starting hash
+			 ((eq (char s i) #\#)
+			  nil)
+			 ;; Hexadecimal value
+			 ((eq (char s i) #\$)
+			  (progn (incf i)
+					 (setf return-value
+						   (if (not (equal operand nil))
+							   (funcall operand
+										return-value
+										(hex2dec (subseq s i (+ i 2))))
+							   (hex2dec (subseq s i (+ i 2)))))
+					 (incf i)))
+			 ;; Plus or Minus
+			 ((or (eq (char s i) #\+)
+				  (eq (char s i) #\-))
+			  (setf operand
+					(read-from-string (subseq s i (+ i 1)))))
+			 ;; Interpret character
+			 ((and (eq (char s i) #\')
+				   (eq (char s (+ i 2)) #\'))
+			  (progn (incf i)
+					 (setf return-value
+						   (if (not (equal operand nil))
+							   (funcall operand
+										return-value
+										(char-code (char s i)))
+							   (char-code (char s i))))
+					 (incf i)))
+			 (t (error "Badly formed immediate instruction."))
+			 ))
+		 (mod return-value 256)))
+	 (absolute
+	  (lambda (s)
+		(list (hex2dec (subseq s 1 3))
+			  (hex2dec (subseq s 3 5)))))
+	 (zero-page
+	  (lambda (s)
+		(list (hex2dec (subseq s 1 3)))))
+	 (implied
+	  (lambda (s)
+		nil))
+	 (indirect-absolute
+	  (lambda (s)
+		(list (hex2dec (subseq s 2 4))
+			  (hex2dec (subseq s 4 6)))))
+	 (absolute-indexed-x
+	  (lambda (s)
+		(list (hex2dec (subseq s 1 3))
+			  (hex2dec (subseq s 3 5)))))
+	 (absolute-indexed-y
+	  (lambda (s)
+		(list (hex2dec (subseq s 1 3))
+			  (hex2dec (subseq s 3 5)))))
+	 (zero-page-indexed-x
+	  (lambda (s) 
+		(list (hex2dec (subseq s 1 3)))))
+	 (zero-page-indexed-y
+	  (lambda (s)
+		(list (hex2dec (subseq s 1 3)))))
+	 (indexed-indirect
+	  (lambda (s)
+		(list (hex2dec (subseq s 2 4)))))
+	 (indirect-indexed
+	  (lambda (s)
+		(list (hex2dec (subseq s 2 4)))))
+	 (relative
+	  (lambda (s)
+		(list (hex2dec (subseq s 1 3))
+			  (hex2dec (subseq s 3 5)))))
+	 (accumulator
+	  (lambda (s)
+		nil)))))
diff --git a/labels.lisp b/labels.lisp
new file mode 100644
index 0000000..c293ff5
--- /dev/null
+++ b/labels.lisp
@@ -0,0 +1,20 @@
+;; -*- mode: common-lisp -*-
+#|
+clasm-6502: An assembler for the 6502 written in Common Lisp.
+Copyright (C) 2024  Aleksei Eaves
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+|#
+
diff --git a/main.lisp b/main.lisp
index 48fefe0..8afe531 100644
--- a/main.lisp
+++ b/main.lisp
@@ -46,4 +46,7 @@ This owuld make it simple
 ;; Process the program list attributes
 (load "~/clasm-6502/attributes.lisp")
 
+
+
+;; Process the program list labels
 (load "~/clasm-6502/labels.lisp")
diff --git a/syntax.lisp b/syntax.lisp
index 982397a..c8e11fd 100644
--- a/syntax.lisp
+++ b/syntax.lisp
@@ -20,116 +20,116 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 ;; Rules for the interpretation of lines.
 (defparameter
- *line-syntax*
- '(
-   (label
-	(lambda (l)
-	  (and (eq (last-char (first l)) #\:)
-		   (eq (length l) 1))))
-   (label-instruction
-	(lambda (l)
-	  (and (eq (last-char (first l)) #\:)
-		   (member (read-from-string (second l)) *opcodes*))))
-   (attribute
-	(lambda (l)
-	  (and (equal (char (first l) 0) #\.)
-		   (not (equal (first l) ".WORD")))))
-   (word
-	(lambda (l)
-	  (and (equal (char (first l) 0) #\.)
-		   (equal (first l) ".WORD"))))
-   (instruction
-	(lambda (l)
-	  (member (read-from-string (first l)) *opcodes*)))
-   (macro
-	(lambda (l)
-	  (equal (second l) "=")))   
-   (unknown
-	(lambda (l)
-	  t))))
+	*syntax-line*
+  '(
+	(label
+	 (lambda (l)
+	   (and (eq (last-char (first l)) #\:)
+			(eq (length l) 1))))
+	(label-instruction
+	 (lambda (l)
+	   (and (eq (last-char (first l)) #\:)
+			(member (read-from-string (second l)) *opcodes*))))
+	(attribute
+	 (lambda (l)
+	   (and (equal (char (first l) 0) #\.)
+			(not (equal (first l) ".WORD")))))
+	(word
+	 (lambda (l)
+	   (and (equal (char (first l) 0) #\.)
+			(equal (first l) ".WORD"))))
+	(instruction
+	 (lambda (l)
+	   (member (read-from-string (first l)) *opcodes*)))
+	(macro
+	 (lambda (l)
+	   (equal (second l) "=")))   
+	(unknown
+	 (lambda (l)
+	   t))))
 
 ;; Rules for identifying addressing modes.
 (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)))))))
-
+	*syntax-addressing-modes*
+  '((immediate ; #??
+	 (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)))))))
+	
 (defun syntax-rule (line list)
   "Apply a syntax rule against a delimited line from a program."
   (dolist (i (extract-keys list))
-- 
cgit v1.2.3