diff options
Diffstat (limited to 'utilities.lisp')
-rw-r--r-- | utilities.lisp | 69 |
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)) |