diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/main.lisp | 8 | ||||
| -rw-r--r-- | src/package.lisp | 6 | ||||
| -rw-r--r-- | src/parse.lisp | 73 | ||||
| -rw-r--r-- | src/util.lisp | 5 |
4 files changed, 71 insertions, 21 deletions
diff --git a/src/main.lisp b/src/main.lisp index f6e5754..8a36a66 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -47,8 +47,14 @@ _/_/ _/_/ " (t (let ((tokens (lex:file->tokens file))) (if tokens (progn (pprint tokens) - (terpri)) + (terpri) + (format t "---~%")) (error "The file does not exist, or it could not be opened.~%")) + (if parse? + (let ((tokens (parse:tokens->ast tokens))) + (progn (pprint tokens) + (terpri) + (format t "---~%")))) (format t "Nitimur in Vetitum~%")))))) diff --git a/src/package.lisp b/src/package.lisp index 3364856..7a14bd2 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,4 +1,4 @@ -helper(defpackage #:rva +(defpackage #:rva (:use #:cl) (:export #:main)) @@ -22,5 +22,7 @@ helper(defpackage #:rva (:use #:cl) (:export #:parser-error #:tokens->ast + #:to-register ;; exported for testing only - #:extract-label)) + #:extract-label + #:extract-r-type)) diff --git a/src/parse.lisp b/src/parse.lisp index 3052583..bd50a23 100644 --- a/src/parse.lisp +++ b/src/parse.lisp @@ -1,4 +1,14 @@ -helper(in-package #:parse) +(in-package #:parse) + +(defparameter reg-loc + '(("zr" . 0) ("lk" . 1) + ("sp" . 2) ("cc" . 3) + ("vl" . 4) ("fp" . 5)) + "A symbol table mapping register aliases to identifiers. If you want to add +a new alias, do it here.") + +(defparameter label-loc '() + "A symbol table mapping label names to line indices.") (define-condition parser-error (error) ((message :initarg :message @@ -8,6 +18,19 @@ helper(in-package #:parse) (format stream "~A" (message condition)))) (:documentation "Dedicated error for an invalid parse.")) +(defun to-register (tokens) + "Attempts to parse a register from the start of TOKENS. If it is badly formed, +throws a PARSER-ERROR." + (or (and (equal (car tokens) 'LEX::DOLLAR) + (cadr tokens) + (let ((r (cadr tokens))) + (cond ((stringp r) (cdr (assoc r reg-loc :test #'string=))) + ((numberp r) (and (<= 0 r 23) r))))) + (error 'parser-error + :message + (format nil "PARSE failed--Expected register, got ~a.~%" + (subseq tokens 0 (min 2 (length tokens))))))) + (defun tokens->ast (program) "Given PROGRAM, which is a list of lists of symbols, filters out the labels and parses." @@ -26,30 +49,52 @@ Note that this function is intended to be called using mapcar, so that labels can be added to a map and otherwise removed from processing." (trivia:match line - ((list (and id (type string)) - (satisfies (lambda (x) (equal x 'lex::colon)))) - (progn (push (cons (read-from-string id) i) util:label-loc) nil)) + ((list (type string) 'lex::colon) + (progn (push (cons (read-from-string (car line)) i) label-loc) nil)) (_ (progn (incf i) line))))) (defun extract-instruction (line i) "Given instruction LINE, determines the expected type format and passes LINE and the index I to the the respective function." - ;; TODO add pseudo-ops (i.e., nop, mov, ...) - (let* ((type-map '((r-type . extract-r-type) - (i-type . extract-i-type) - (j-type . extract-j-type))) - (keyword (car line)) - (type-fn (cdr (assoc keyword type-map)))) + (let* ((mnemonic (intern (string-upcase (car line)) :util)) + ;; TODO add pseudo-ops (i.e., nop, leave, ret...) + ;; should probably be their own extract function + (type-fn (cond + ((member mnemonic util:type-r) #'extract-r-type) + ((member mnemonic util:type-i) #'extract-i-type) + ((member mnemonic util:type-j) #'extract-j-type)))) (if type-fn (funcall type-fn line i) (error 'parser-error - (format nil "PARSE failed--~a is not a known keyword.~%" (keyword)))))) + :message + (format nil "PARSE failed--~a is not a known keyword.~%" mnemonic))))) (defun extract-r-type (line i) - 'r) + (let ((mnemonic (intern (string-upcase (car line)) :util))) + (defun die () + (error 'parser-error + :message + (format nil "PARSE failed---Incorrect number of operands for ~a" mnemonic))) + (defun eat-registers (registers-so-far lst) + (if (not (null lst)) + (eat-registers (cons (to-register lst) registers-so-far) + (cddr lst)) + (reverse registers-so-far))) + (let* ((registers (eat-registers '() (cdr line))) + ;; handle special cases + (registers (cond ((member mnemonic '(util::CMP util::CEV)) + (if (= 2 (length registers)) + (cons 0 registers) + (die))) + ((member mnemonic '(util::NOT)) + (if (= 2 (length registers)) + (append registers (list 0)) + (die))) + (t (if (= 3 (length registers)) registers (die)))))) + (list :op mnemonic :d (car registers) :s1 (cadr registers) :s2 (caddr registers))))) (defun extract-i-type (line i) - 'i) + line) (defun extract-j-type (line i) - 'j) + line) diff --git a/src/util.lisp b/src/util.lisp index 5edee4a..027a770 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -16,12 +16,9 @@ "R-type instructions.") (defparameter type-i - '(LOAD LOADV ADDI SUBI SFTRI SFTLI ANDI ORI XORI STORE STOREV) + '(LOAD LOADV ADDI SUBI SFTRI SFTLI ANDI ORI XORI STORE STOREV MOV) "I-type instructions.") (defparameter type-j '(JMP JRL JAL BEQ BGT BUF BOF PUSH POP) "J-type instructions.") - -(defparameter label-loc '() - "A symbol table mapping label names to line indices.") |