Added addressing mode binary conversionHEADmaster

1 files changed, 103 insertions, 0 deletions

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)))))