;; -*- 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 an associative list."
  (let ((return-value nil))
	(progn
	  (dolist (i alist)
		(setf return-value
			  (cons (car i) return-value)))
	  (reverse return-value))))

(defun last-char (s)
  (char s (- (length s) 1)))

(defun hexd? (string)
  "Is string a hexadecimal 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 hexadecimal number (as string) to a positive decimal."
  (if (hexd? string)
	  ;; Return a character as a hexadecimal digit.
	 (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 ((return-value 0))
		 ;; Loop through string and convert.
		 (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))
	 ;; Return nil if string was not a hexadecimal number.
	 nil))