;; -*- 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
|#

;;; List of addressing modes.
(setf
 *addressing-modes*
 '(immediate
   absolute 
   zero-page 
   implied 
   indirect-absolute 
   absolute-indexed-x 
   absolute-indexed-y 
   zero-page-indexed-x 
   zero-page-indexed-y 
   indexed-indirect 
   indirect-indexed 
   relative 
   accumulator))

;;; Instructions, with decimal opcode and
;;; addressing modes.
(setf
 *instructions*
 ;; Load & Store
 '((LDA 169 (immediate
			 absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   (LDX 162 (immediate
			 zero-page
			 zero-page-indexed-y
			 absolute
			 absolute-indexed-y))
   (LDY 160 (immediate
			 zero-page
			 zero-page-indexed-x
			 absolute
			 absolute-indexed-x))
   (STA 137 (absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   (STX 130 (zero-page
			 zero-page-indexed-y
			 absolute))
   (STY 128 (zero-page
			 zero-page-indexed-x
			 absolute))
   ;;Arithmetic
   (ADC 105 (immediate
			 absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   (SBC 233 (immediate
			 absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   ;;Increment & Decrement
   (INC 226 (zero-page
			 zero-page-indexed-x
			 absolute
			 absolute-indexed-x))
   (INX 232 (implied))
   (INY 200 (implied))
   (DEC 194 (zero-page
			 zero-page-indexed-x
			 absolute
			 absolute-indexed-x))
   (DEX 202 (implied))
   (DEY 136 (implied))
   ;; Logical
   (AND  41 (immediate
			 absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   (ORA   9 (immediate
			 absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   (EOR  73 (immediate
			 absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   ;; Jump, Branch, Compare
   (JMP  72 (absolute
			 indirect-absolute))
   (BCC 144 (relative))
   (BCS 176 (relative))
   (BEQ 240 (relative))
   (BNE 208 (relative))
   (BMI  48 (relative))
   (BPL  16 (relative))
   (BVS 112 (relative))
   (BVC  80 (relative))
   (CMP 201 (immediate
			 absolute
			 zero-page
			 absolute-indexed-x
			 absolute-indexed-y
			 zero-page-indexed-x
			 indexed-indirect
			 indirect-indexed))
   (CPX 224 (immediate
			 zero-page
			 absolute))
   (CPY 192 (immediate
			 zero-page
			 absolute))
   (BIT  32 (zero-page
			 absolute))
   ;; Shift & Rotate
   (ASL  10 (accumulator
			 zero-page
			 zero-page-indexed-x
			 absolute
			 absolute-indexed-x))
   (LSR  74 (accumulator
			 zero-page
			 zero-page-indexed-x
			 absolute
			 absolute-indexed-x))
   (ROL  42 (accumulator
			 zero-page
			 zero-page-indexed-x
			 absolute
			 absolute-indexed-x))
   (ROR 106 (accumulator
			 zero-page
			 zero-page-indexed-x
			 absolute
			 absolute-indexed-x))
   ;; Transfer
   (TAX 170 (implied))
   (TAY 168 (implied))
   (TXA 138 (implied))
   (TYA 152 (implied))
   ;; Stack
   (TSX 186 (implied))
   (TXS 154 (implied))
   (PHA  72 (implied))
   (PHP   8 (implied))
   (PLA 104 (implied))
   (PLP  40 (implied))
   ;; Subroutine
   (JSR  32 (implied))
   (RTI  64 (implied))
   (RTS  96 (implied))
   ;; Set & Reset
   (CLC  24 (implied))
   (CLD 216 (implied))
   (CLI  88 (implied))
   (CLV 184 (implied))
   (SEC  56 (implied))
   (SED 248 (implied))
   (SEI 120 (implied))
   ;; Other
   (NOP 234 (implied))
   (BRK   0 (implied))))

(defun valid-instruction? (instruction addressing-mode)
  "Is instruction and addressing mode combination correct?"
  (cond
	((member addressing-mode
			 (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
 *addressing-modes-syntax*
 '((immediate ; #?? ... more complex syntax rules for later
	(lambda (s)
	  (eq "#" (subseq s 0 1))))
   (absolute ;"$????"
	(lambda (s)
	  (and
	   (equal (length s) 5)
	   (equal "$" (subseq s 0 1))
	   (hexd? (subseq s 1 5)))))
   (zero-page ;"$??"
	(lambda (s)
	  (and
	   (equal (length s) 3)
	   (equal "$" (subseq s 0 1))
	   (hexd? (subseq s 1 3)))))
   (implied nil)
   (indirect-absolute ;($????)
	(lambda (s)
	  (and
	   (equal (length s) 7)
	   (equal "($" (subseq s 0 2))
	   (hexd? (subseq s 1 5))
	   (equal ")" (subseq s 5 6)))))
   (absolute-indexed-x ;"$????,X"
	(lambda (s)
	  (and
	   (equal (length s) 7)
	   (equal "$" (subseq s 0 1))
	   (hexd? (subseq s 1 5))
	   (equal ",X" (subseq s 5 7)))))
   (absolute-indexed-y ;"$????,Y"
	(lambda (s)
	  (and
	   (equal (length s) 7)
	   (equal "$" (subseq s 0 1))
	   (hexd? (subseq s 1 5))
	   (equal ",Y" (subseq s 5 7)))))
   (zero-page-indexed-x ;"$??,X"
	(lambda (s)
	  (and
	   (equal (length s) 5)
	   (equal (subseq s 0 1) "$")
	   (hexd? (subseq s 1 3))
	   (equal (subseq s 3 5) ",X"))))
   (zero-page-indexed-y ;"$??,Y"
	(lambda (s)
	  (and
	   (equal (length s) 5)
	   (equal (subseq s 0 1) "$")
	   (hexd? (subseq s 1 3))
	   (equal (subseq s 3 5) ",Y"))))
   (indexed-indirect ;"($??,X)"
	(lambda (s)
	  (and
	   (equal (length s) 7)
	   (equal (subseq s 0 2) "($")
	   (hexd? (subseq s 2 4))
	   (equal (subseq s 4 7) ",X)"))))
   (indirect-indexed ;"($??),Y"
	(lambda (s)
	  (and
	   (equal (length s) 7)
	   (equal (subseq s 0 2) "($")
	   (hexd? (subseq s 2 4))
	   (equal (subseq s 4 7) "),Y"))))
   ;;How to fix that relative and absolute are the same rule?
   ;;A check upstream would suffice.
   (relative ;"$????"
	(lambda (s)
	  (and
	   (equal (length s) 5)
	   (equal (subseq s 0 1) "$")
	   (hexd? (subseq s 1 5)))))
   (accumulator ;"A"
	(lambda (s)
	  (and
	   (equal (length s) 1)
	   (equal "A" (subseq s 0 1)))))))

;; Evaluate the second syntax rule on a string
;; temporary
(funcall
 (eval (cadr (assoc 'absolute *addressing-modes-syntax*)))
 "$A6AF")