summaryrefslogtreecommitdiff
path: root/binary.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'binary.lisp')
-rw-r--r--binary.lisp103
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)))))