From fafbeb6051a15232df1858ce64ff0375597b5044 Mon Sep 17 00:00:00 2001 From: aleksei Date: Fri, 12 Apr 2024 17:06:31 +1000 Subject: Moved around functions in files. --- 6502.lisp | 51 ------------------------------------------- utilities.lisp | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 69 insertions(+), 51 deletions(-) create mode 100644 utilities.lisp diff --git a/6502.lisp b/6502.lisp index 7c0c2a7..55a73cd 100644 --- a/6502.lisp +++ b/6502.lisp @@ -202,17 +202,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (NOP 234 (implied)) (BRK 0 (implied)))) - - -(defun extract-keys (list) - "Extract the keys of associative lists." - (let ((ret nil)) - (progn - (dolist (i list) - (setf ret - (cons (car i) ret))) - (reverse ret)))) - ;; Generated list of opcodes. (setf *opcodes* @@ -225,46 +214,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (caddr (assoc instruction *instructions*))) t) (t nil))) -(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." - (flet ((hex (c) - (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 ((ret 0)) - (do ((i 0 (incf i)) - (j (- (length string) 1) (decf j))) - ((minusp j) ()) - (setf ret - (+ ret - (* (expt 16 j) - (hex (char string i)))))) - ret))) - ;; A list with with the respective rules of some ;; addressing mode syntax. (setf 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)) -- cgit v1.2.3