diff options
author | Aleksei Eaves <alekseijeaves@protonmail.com> | 2024-04-14 12:50:36 +1000 |
---|---|---|
committer | Aleksei Eaves <alekseijeaves@protonmail.com> | 2024-04-14 12:50:36 +1000 |
commit | 75db422f7b9c73f1057bf3187c73bfaeb6003a0b (patch) | |
tree | 71639abce71a942fe593ba9e5111291da061bbc2 | |
parent | 5fd0592e0bf449ec25392d2cb1b4c3b45b9cd718 (diff) |
Shifted things around
-rw-r--r-- | 6502.lisp | 99 | ||||
-rw-r--r-- | utilities.lisp | 7 |
2 files changed, 15 insertions, 91 deletions
@@ -1,4 +1,6 @@ ;; -*- mode: common-lisp -*- +;; 6502.lisp +;; Contains data structures specific to the 6502 system. #| clasm-6502: An assembler for the 6502 written in Common Lisp. Copyright (C) 2024 Aleksei Eaves @@ -20,7 +22,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;; List of addressing modes and their length. (defparameter - *addressing-modes* + *addressing-mode-lengths* '((immediate 2) (absolute 3) (zero-page 2) @@ -35,6 +37,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (relative 2) (accumulator 1))) +;; Generated list of addressing modes. +(defparameter + *addressing-modes* + (extract-keys *addressing-modes-lengths*)) + ;;; Instructions, with decimal opcode and ;;; addressing modes. (defparameter @@ -206,93 +213,3 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (defparameter *opcodes* (extract-keys *instructions*)) - -(defun valid-instruction? (instruction addressing-mode) - "Is instruction and addressing mode combination correct?" - (cond - ((member addressing-mode - (caddr (assoc instruction *instructions*))) t) - (t nil))) - -;; A list with with the respective rules of -;; addressing mode syntax. -(defparameter - *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))))))) diff --git a/utilities.lisp b/utilities.lisp index c231f72..cb6aa51 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -73,3 +73,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA return-value)) ;; Return nil if string was not a hexadecimal number. nil)) + +(defun valid-instruction? (instruction addressing-mode) + "Is instruction and addressing mode combination correct?" + (cond + ((member addressing-mode + (caddr (assoc instruction *instructions*))) t) + (t nil))) |