1 files changed, 69 insertions, 0 deletions
diff --git a/utilities.lisp b/utilities.lisp
new file mode 100644
index 0000000..414f0f2
--- /dev/null
+++ b/utilities.lisp
@@ -0,0 +1,69 @@
+;; -*- 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
+|#
+
+(defun extract-keys (alist)
+  "Extract the keys of associative lists."
+  (let ((return-value nil))
+	(progn
+	  (dolist (i alist)
+		(setf return-value
+			  (cons (car i) return-value)))
+	  (reverse return-value))))
+
+(defun hexd? (string)
+  "Is a string a hexd number?"
+  (let ((stack ()))
+	(dotimes (i (length string))
+	  (push
+	   (or (and (char-not-lessp
+				 (char string i) #\0)
+				(char-not-greaterp
+				 (char string i) #\9))
+		   (and (char-not-lessp
+				 (char string i) #\A)
+				(char-not-greaterp
+				 (char string i) #\F)))
+	   stack))
+	(push 'and stack)
+	(eval stack)))
+
+(defun hex2dec (string)
+  "Convert an arbitrarily sized hexd number (as string) to a positive decimal."
+  (if (hexd? string)
+	 (flet ((hex (c) ;Return character as hexadecimal
+			  (cond
+				((and (char-not-lessp c #\0)
+					  (char-not-greaterp c #\9))
+				 (- (char-code c)
+					(char-code #\0)))
+				((and (char-not-lessp c #\A)
+					  (char-not-greaterp c #\F))
+				 (+ (- (char-code (char-downcase c))
+					   (char-code #\a)) 10)))))
+	   (let ((return-value 0))
+		 (do ((i 0 (incf i))
+			  (j (- (length string) 1) (decf j)))
+			 ((minusp j) ())
+		   (setf return-value
+				 (+ return-value
+					(* (expt 16 j)
+					   (hex (char string i))))))
+		 return-value))
+	nil))