diff options
| -rw-r--r-- | rva.asd | 1 | ||||
| -rw-r--r-- | src/emit.lisp | 66 | ||||
| -rw-r--r-- | src/main.lisp | 7 | ||||
| -rw-r--r-- | src/package.lisp | 11 | ||||
| -rw-r--r-- | src/parse.lisp | 42 | ||||
| -rw-r--r-- | src/util.lisp | 31 | ||||
| -rw-r--r-- | t/parse.lisp | 139 | ||||
| -rw-r--r-- | t/util.lisp | 16 |
8 files changed, 193 insertions, 120 deletions
@@ -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 "~@<Variable ~S not declared.~@:>" name))) + (progn (maphash #'(lambda (k v) (format t "~A => ~A~%" k v)) variable-table) + (error "~@<Variable ~S not declared.~@:>" name)))) (defun get-label (name) (alexandria:if-let ((value (gethash name label-table))) value (error "~@<Label ~S not found.~@:>" name))) -(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 (format-as-binary i opsize))) - ,ops))) - (defvar r-type '("ADD" "SUB" "MUL" "QUOT" "REM" "SFTR" "SFTL" "AND" "OR" "NOT" "XOR" "ADDV" "SUBV" "MULV" "DIVV" "CMP" "CEV") @@ -80,9 +67,3 @@ concatenated with TYPE." (defvar j-type '("JMP" "JRL" "JAL" "BEQ" "BGT" "BUF" "BOF" "PUSH" "POP") "J-type instructions.") - -(defvar mnemonic-loc - `(,@(generate-type-map r-type) - ,@(generate-type-map i-type) - ,@(generate-type-map j-type)) - "An alist mapping known mnemonics to their binary representation.") diff --git a/t/parse.lisp b/t/parse.lisp index 9562e1d..3c29dbc 100644 --- a/t/parse.lisp +++ b/t/parse.lisp @@ -10,104 +10,123 @@ (in-suite parse-tests) (test esrap-register-bases - (is (equal '(parse::p - (parse::x - (parse::r "ADD" (parse::rr 10) (parse::rr 10) (parse::rr 10)))) - (esrap:parse 'parse::str->ast (format nil ".TEXT~%~tADD $0O012 $0B1010 $0XA~%"))))) + (is (equal '(emit::p + (emit::d) + (emit::x + (emit::r "ADD" (emit::rr 10) (emit::rr 10) (emit::rr 10)))) + (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tADD $0O012 $0B1010 $0XA~%"))))) (test esrap-instr-all-type-r (is (equal - '(parse::p - (parse::x - (parse::r "ADDV" (parse::rr 1) (parse::rr 2) (parse::rr 3)) - (parse::r "NOT" (parse::rr 4) (parse::rr 0) (parse::rr 5)) - (parse::r "CMP" (parse::rr 6) (parse::rr 7) (parse::rr 0)))) - (esrap:parse 'parse::str->ast (format nil ".TEXT~%~tADDV $3 $1 $2 + '(emit::p + (emit::d) + (emit::x + (emit::r "ADDV" (emit::rr 1) (emit::rr 2) (emit::rr 3)) + (emit::r "NOT" (emit::rr 4) (emit::rr 0) (emit::rr 5)) + (emit::r "CMP" (emit::rr 6) (emit::rr 7) (emit::rr 0)))) + (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tADDV $3 $1 $2 ~tNOT $5 $4~%~tCMP $6 $7~%"))))) (test esrap-instr-all-type-i (is (equal - '(parse::p - (parse::x - (parse::i "LOADV" (parse::rr 8) (parse::rr 9) (parse::imm 1)) - (parse::i "STORE" (parse::rr 3) (parse::rr 5) (parse::imm 3)) - (parse::i "ADDI" (parse::rr 5) (parse::rr 4) (parse::imm 2)))) - (esrap:parse 'parse::str->ast (format nil ".TEXT~%~tLOADV $8 1($9) + '(emit::p + (emit::d) + (emit::x + (emit::i "LOADV" (emit::rr 8) (emit::rr 9) (emit::imm 1)) + (emit::i "STORE" (emit::rr 3) (emit::rr 5) (emit::imm 3)) + (emit::i "ADDI" (emit::rr 5) (emit::rr 4) (emit::imm 2)))) + (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tLOADV $8 1($9) ~tSTORE $5 3($3)~%~tADDI $5 $4 2~%"))))) (test esrap-instr-type-all-type-j (is (equal - '(parse::p - (parse::x - (parse::j "JMP" (parse::rr 3) (parse::imm 3)) - (parse::j "JRL" (parse::rr 0) (parse::l "FOO")) - (parse::j "PUSH" (parse::rr 5) (parse::imm 0)))) - (esrap:parse 'parse::str->ast (format nil ".TEXT~%~tJMP 3($3) + '(emit::p + (emit::d) + (emit::x + (emit::j "JMP" (emit::rr 3) (emit::imm 3)) + (emit::j "JRL" (emit::rr 0) (emit::l "FOO" 8)) + (emit::j "PUSH" (emit::rr 5) (emit::imm 0)))) + (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tJMP 3($3) ~tJRL FOO~%~tPUSH $5~%"))))) +(test esrap-instr-type-i-negative + (is (equal + '(emit::p + (emit::d) + (emit::x + (emit::i "LOADV" (emit::rr 8) (emit::rr 3) (emit::imm -3)))) + (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tLOADV $8 -3($3)~%"))))) + (test esrap-instr-type-i-vars (is (equal - '(parse::p - (parse::x - (parse::i "LOADV" (parse::rr 8) (parse::rr 0) (parse::var "vector")) - (parse::i "STORE" (parse::rr 0) (parse::rr 5) (parse::var "int")))) - (esrap:parse 'parse::str->ast (format nil ".TEXT~%~tLOADV $8 vector + '(emit::p + (emit::d) + (emit::x + (emit::i "LOADV" (emit::rr 8) (emit::rr 0) (emit::var "vector")) + (emit::i "STORE" (emit::rr 0) (emit::rr 5) (emit::var "int")))) + (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tLOADV $8 vector ~tSTORE $5 int~%"))))) (test esrap-instr-type-all-lazy-spaces (is (equal - '(parse::p - (parse::x - (parse::j "JMP" (parse::rr 3) (parse::imm 3)) - (parse::j "JRL" (parse::rr 0) (parse::l "FOO")) - (parse::j "PUSH" (parse::rr 5) (parse::imm 0)))) - (esrap:parse 'parse::str->ast (format nil "~t~%.TEXT~t~%JMP 3($3)~t + '(emit::p + (emit::d) + (emit::x + (emit::j "JMP" (emit::rr 3) (emit::imm 3)) + (emit::j "JRL" (emit::rr 0) (emit::l "FOO" 14)) + (emit::j "PUSH" (emit::rr 5) (emit::imm 0)))) + (esrap:parse 'parse:str->ast (format nil ".DATA~%~%.TEXT~t~%JMP 3($3)~t JRL FOO~t~%PUSH $5~%"))))) (test esrap-data-singleton (is (equal - '(parse::p - (parse::d - 1)) - (esrap:parse 'parse:str->ast (format nil ".DATA~%~tA 1~%"))))) + '(emit::p + (emit::d + 1) + (emit::x)) + (esrap:parse 'parse:str->ast (format nil ".DATA~%~tA 1~%.TEXT~%"))))) (test esrap-data-loaded (is (equal - '(parse::p - (parse::d - 1 2 3 4 5 6 7 8)) - (esrap:parse 'parse:str->ast (format nil ".DATA~%~tB 1 2 3 4 5 6 7 8~%"))))) + '(emit::p + (emit::d + 1 2 3 4 5 6 7 8) + (emit::x)) + (esrap:parse 'parse:str->ast (format nil ".DATA~%~tB 1 2 3 4 5 6 7 8 +.TEXT~%"))))) (test esrap-data-triple (is (equal - '(parse::p - (parse::d - 5 6 7 8 4 3 5)) + '(emit::p + (emit::d + 5 6 7 8 4 3 5) + (emit::x)) (esrap:parse 'parse:str->ast (format nil ".DATA~%~tC 5 6 7 8~%~tD 4 -~tE 3 5~%"))))) +~tE 3 5~%.TEXT~%"))))) (test esrap-data-lazy-spaces (is (equal - '(parse::p - (parse::d - 5 6 7 8 4 3 5)) + '(emit::p + (emit::d + 5 6 7 8 4 3 5) + (emit::x)) (esrap:parse 'parse:str->ast (format nil "~%~t.DATA~t~%F 5 6 7 8~t~%G 4 -H 3 5~%"))))) +H 3 5~%.TEXT~%"))))) (test esrap-data-full (is (equal - '(parse::p - (parse::d + '(emit::p + (emit::d 1 2 3 4 3 0) - (parse::x - (parse::i "LOAD" (parse::rr 5) (parse::rr 0) (parse::var "S")) - (parse::i "LOAD" (parse::rr 10) (parse::rr 0) (parse::var "ARR")) - (parse::i "LOAD" (parse::rr 6) (parse::rr 0) (parse::var "I")) - (parse::j "JRL" (parse::rr 0) (parse::l "CMP")) - (parse::r "ADD" (parse::rr 10) (parse::rr 6) (parse::rr 9)) - (parse::i "ADDI" (parse::rr 6) (parse::rr 6) (parse::imm 1)) - (parse::r "CMP" (parse::rr 6) (parse::rr 5) (parse::rr 0)) - (parse::j "BGT" (parse::rr 0) (parse::l "L")))) + (emit::x + (emit::i "LOAD" (emit::rr 5) (emit::rr 0) (emit::var "S")) + (emit::i "LOAD" (emit::rr 10) (emit::rr 0) (emit::var "ARR")) + (emit::i "LOAD" (emit::rr 6) (emit::rr 0) (emit::var "I")) + (emit::j "JRL" (emit::rr 0) (emit::l "CMP" 19)) + (emit::r "ADD" (emit::rr 10) (emit::rr 6) (emit::rr 9)) + (emit::i "ADDI" (emit::rr 6) (emit::rr 6) (emit::imm 1)) + (emit::r "CMP" (emit::rr 6) (emit::rr 5) (emit::rr 0)) + (emit::j "BGT" (emit::rr 0) (emit::l "L" 23)))) (esrap:parse 'parse:str->ast (format nil " .DATA ARR 1 2 3 4 diff --git a/t/util.lisp b/t/util.lisp index c2dafab..e15e142 100644 --- a/t/util.lisp +++ b/t/util.lisp @@ -16,13 +16,17 @@ (is (util:asm-extension? "quux.asm"))) (test format-as-binary-unsigned-no-pad - (is (string= (util:format-as-binary 0 0) - "0"))) + (is (string= "0" + (util:format-as-binary 0 0)))) (test format-as-binary-unsigned-no-pad-fourty-two - (is (string= (util:format-as-binary 42 0) - "101010"))) + (is (string= "101010" + (util:format-as-binary 42 6)))) (test format-as-binary-unsigned-pad-fourty-two - (is (string= (util:format-as-binary 42 10) - "0000101010"))) + (is (string= "0000101010" + (util:format-as-binary 42 10)))) + +(test format-as-binary-overflow + (is (string= "10" + (util:format-as-binary 10 2)))) |