From df508744ec2975cec0ba05e8a4358c1c41265c4c Mon Sep 17 00:00:00 2001 From: bd Date: Thu, 10 Apr 2025 03:53:43 -0400 Subject: Add untested (but works on the single input file) code emission --- rva.asd | 1 + src/emit.lisp | 66 ++++++++++++++++++++++++++ src/main.lisp | 7 ++- src/package.lisp | 11 +++-- src/parse.lisp | 42 ++++++++--------- src/util.lisp | 31 +++---------- t/parse.lisp | 139 +++++++++++++++++++++++++++++++------------------------ t/util.lisp | 16 ++++--- 8 files changed, 193 insertions(+), 120 deletions(-) create mode 100644 src/emit.lisp diff --git a/rva.asd b/rva.asd index 9271472..092fd44 100644 --- a/rva.asd +++ b/rva.asd @@ -16,6 +16,7 @@ :components ((:file "package") (:file "util") (:file "parse") + (:file "emit") (:file "main")))) :long-description #.(uiop:read-file-string diff --git a/src/emit.lisp b/src/emit.lisp new file mode 100644 index 0000000..acc2772 --- /dev/null +++ b/src/emit.lisp @@ -0,0 +1,66 @@ +(in-package #:emit) + +(defun fits-in-X-bits (n) + "Returns the number of bits required to represent N" + (ceiling (/ (log (ceiling n (log 2))) (log 2)))) + +(defmacro generate-type-map (ops) + "Generates an alist where the key corresponds to an element in +OPS, while the value is the index of that key (padded to the minimum +number of bits required to represent all +concatenated with TYPE." + `(let ((i 0) + (opsize (fits-in-X-bits (length ,ops)))) + (mapcar (lambda (x) + (incf i) + (cons x (util:format-as-binary i opsize))) + ,ops))) + +(defvar mnemonic-loc + `(,@(generate-type-map util:r-type) + ,@(generate-type-map util:i-type) + ,@(generate-type-map util:j-type)) + "An alist mapping known mnemonics to their binary representation.") + +(defun lookup-mnemonic (mnemonic) + (cdr (assoc mnemonic mnemonic-loc :test #'string=))) + +(defun p (d x) + (append x d)) + +(defun d (&rest lst) + (mapcar (lambda (x) (util:format-as-binary x 32)) lst)) + +(defun x (&rest lst) + lst) + +(defun r (mnemonic s1 s2 d) + (concatenate + 'string (format nil "~10,'0d" 0) d s2 s1 (lookup-mnemonic mnemonic) "00")) + +(defun i (mnemonic s d i) + (concatenate + 'string (util:format-as-binary i 16) d s (lookup-mnemonic mnemonic) "01")) + +(defun j (mnemonic b d) + (concatenate + 'string (util:format-as-binary d 21) b (lookup-mnemonic mnemonic) "10")) + +(defun rr (val) + (if (<= 0 val 23) + (util:format-as-binary val 5) + (error (format nil "~a is not a valid register id!~%" val)))) + +(defun imm (val) val) + +(defun l (l s) + (let ((d (util:get-label l))) + (- d s))) + +(defun var (s) + (let ((pos (util:get-variable s))) + (+ pos parse:line-number))) + +(defun emit (p) + (format t "~a~%" p) + (eval p)) diff --git a/src/main.lisp b/src/main.lisp index 9692603..f20b022 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -38,10 +38,9 @@ _/_/ _/_/ " (error "The file is not an asm source code file.~%")) (t (let ((str (uiop:read-file-string file))) (if str - (progn (pprint (esrap:parse 'parse:str->ast (string-upcase str))) - (terpri) - (maphash #'(lambda (k v) (format t "~A => ~A~%" k v)) util:label-table) - (format t "---~%")) + (let ((ast (esrap:parse 'parse::str->ast (string-upcase str)))) + (when emit? + (format t "~a~%" (emit::emit ast)))) (error "The file does not exist, or it could not be opened.~%")) (format t "Nitimur in Vetitum~%")))))) diff --git a/src/package.lisp b/src/package.lisp index 115942e..bbb45a3 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -13,12 +13,15 @@ #:add-label #:get-variable #:get-label - #:label-table #:r-type #:i-type - #:j-type - #:mnemonic-loc)) + #:j-type)) (defpackage #:parse (:use #:cl) - (:export #:str->ast)) + (:export #:str->ast + #:line-number)) + +(defpackage #:emit + (:use #:cl) + (:export #:emit)) diff --git a/src/parse.lisp b/src/parse.lisp index d07fbde..d971444 100644 --- a/src/parse.lisp +++ b/src/parse.lisp @@ -44,25 +44,25 @@ (esrap:defrule register (and #\$ int) (:function cadr) - (:lambda (e) (list 'rr e))) + (:lambda (e) (list 'emit::rr e))) (esrap:defrule var alpha - (:lambda (e) (list (list 'rr 0) (list 'var e)))) + (:lambda (e) (list (list 'emit::rr 0) (list 'emit::var e)))) (esrap:defrule dereference (and (esrap:? (or #\+ #\-)) int #\( register #\)) (:destructure (s i1 w1 r w2) (declare (ignore w1 w2)) - (list r (list 'imm (if (and s (string= s "-")) (- i1) i1))))) + (list r (list 'emit::imm (if (and s (string= s "-")) (- i1) i1))))) (esrap:defrule immediate int - (:lambda (e) (list 'imm e))) + (:lambda (e) (list 'emit::imm e))) ;;; defines rules to parse labels (esrap:defrule label alpha - (:lambda (e) (list 'l e))) + (:lambda (e) (list 'emit::l e line-number))) -(esrap:defrule label-decl (and label #\:) +(esrap:defrule label-decl (and alpha #\:) (:function car) (:lambda (e) (util:add-label e line-number) @@ -102,33 +102,33 @@ DESTRUCTURE-PATTERN is the list of non-terminals on the right side of the gramma (and ,(read-from-string (format nil "~A-m" name)) ,@(util:riffle (make-list pattern-size :initial-element 'space) destructure-pattern)) (:destructure (m ,@(util:riffle spaces vars)) (declare (ignore ,@spaces)) - (list ,type-id m ,@(mapcar (lambda (x) (or (nth x vars) ''(rr 0))) order)))))) + (list ,type-id m ,@(mapcar (lambda (x) (or (nth x vars) ''(emit::rr 0))) order)))))) -(defrule-instr r-type-1 'r (1 2 0) register register) -(defrule-instr r-type-2 'r (0 1 2) register register) -(defrule-instr r-type-3 'r (1 2 0) register register register) -(defrule-instr i-type-3 'i (0 1 2) register register immediate) -(defrule-instr j-type-3 'j (1 0) label) +(defrule-instr r-type-1 'emit::r (1 2 0) register register) +(defrule-instr r-type-2 'emit::r (0 1 2) register register) +(defrule-instr r-type-3 'emit::r (1 2 0) register register register) +(defrule-instr i-type-3 'emit::i (0 1 2) register register immediate) +(defrule-instr j-type-3 'emit::j (1 0) label) (esrap:defrule i-type-1 (and i-type-1-m space register space (or dereference var)) (:destructure (m w1 s w2 di) (declare (ignore w1 w2)) - `(i ,m ,s ,@di))) + `(emit::i ,m ,s ,@di))) (esrap:defrule i-type-2 (and i-type-2-m space register space (or dereference var)) (:destructure (m w1 s w2 di) (declare (ignore w1 w2)) - `(i ,m ,@(util:insert-in-middle di s)))) + `(emit::i ,m ,@(util:insert-in-middle di s)))) (esrap:defrule j-type-1 (and j-type-1-m space dereference) (:destructure (m w di) (declare (ignore w)) - `(j ,m ,@di))) + `(emit::j ,m ,@di))) (esrap:defrule j-type-2 (and j-type-2-m space register) (:destructure (m w r) (declare (ignore w)) - `(j ,m ,r (imm 0)))) + `(emit::j ,m ,r (emit::imm 0)))) (esrap:defrule instr (or r-type-1 r-type-2 r-type-3 i-type-1 i-type-2 i-type-3 j-type-1 j-type-2 j-type-3)) @@ -145,7 +145,7 @@ DESTRUCTURE-PATTERN is the list of non-terminals on the right side of the gramma (esrap:defrule text (and ".TEXT" (esrap:? space) nl (* text-line)) (:function cadddr) - (:lambda (e) `(x ,@(remove nil e)))) + (:lambda (e) `(emit::x ,@(remove nil e)))) ;;; defines rules to parse the .data segment @@ -165,10 +165,10 @@ DESTRUCTURE-PATTERN is the list of non-terminals on the right side of the gramma (esrap:defrule data (and ".DATA" (esrap:? space) nl (* data-line)) (:function cadddr) - (:lambda (e) `(d ,@(apply #'append e)))) + (:lambda (e) `(emit::d ,@(apply #'append e)))) ;;; defines rules to parse a program -(esrap:defrule str->ast (and (* (or space nl)) (* (or data text))) - (:function cadr) - (:lambda (e) `(p ,@e))) +(esrap:defrule str->ast (and (* (or space nl)) data text) + (:function cdr) + (:lambda (e) `(emit::p ,@e))) diff --git a/src/util.lisp b/src/util.lisp index d8bd227..f3035fe 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -4,15 +4,13 @@ "Returns t if FILE is extended with .asm, nil otherwise." (string= (pathname-type file) "asm")) -(defun fits-in-X-bits (n) - "Returns the number of bits required to represent N" - (ceiling (/ (log (ceiling n (log 2))) (log 2)))) (defun format-as-binary (num len) "Formats NUM as a binary number, and pads to LEN with zeros." (declare (type number num)) (declare (type (integer 0 *) len)) - (format nil "~V,'0b" len num)) + (let ((max-val (1- (expt 2 len)))) + (format nil "~V,'0b" len (logand num max-val)))) (defun insert-in-middle (list element) (append (list (car list)) (list element) (cdr list))) @@ -33,8 +31,8 @@ of the elements from both lists. Returns nil if the lists are not equal size." for l2 in lst2 append (list l1 l2)))) -(defvar variable-table (make-hash-table :test #'equal)) -(defvar label-table (make-hash-table :test #'equal)) +(defvar variable-table (make-hash-table :test #'equalp)) +(defvar label-table (make-hash-table :test #'equalp)) (defun add-variable (name value) (if (gethash name variable-table) @@ -49,25 +47,14 @@ of the elements from both lists. Returns nil if the lists are not equal size." (defun get-variable (name) (alexandria:if-let ((value (gethash name variable-table))) value - (error "~@" name))) + (progn (maphash #'(lambda (k v) (format t "~A => ~A~%" k v)) variable-table) + (error "~@" name)))) (defun get-label (name) (alexandria:if-let ((value (gethash name label-table))) value (error "~@