Add label processing, mnemonic and label lookup maps

7 files changed, 100 insertions, 11 deletions

diff --git a/README.md b/README.md
index 58c8201..aa61af6 100644
--- a/README.md
+++ b/README.md
@@ -1,14 +1,6 @@
 # rva
 
-	      _/_/                                  _/_/
-	     _/                                      _/
-	    _/    _/  _/_/  _/      _/    _/_/_/    _/
-	   _/    _/_/      _/      _/  _/    _/    _/
-	  _/    _/          _/  _/    _/    _/    _/
-	 _/    _/            _/        _/_/_/    _/
-	_/_/                                  _/_/
-
-This is an assembler for the custom ISA nicknamed "RISC V[ECTOR]". It takes in an assembly program syntactically similar to MIPS (see input) and outputs a list of binary numbers corresponding to the instructions. This the output is compatible with the [RISC V[ECTOR]](https://github.com/bdunahu/RISC-V-ECTOR-) simulator.
+This is an assembler for a custom ISA nicknamed "RISC V[ECTOR]". It takes in an assembly program syntactically similar to MIPS (see input) and outputs a list of binary numbers corresponding to the instructions. The output is compatible with the [RISC V[ECTOR]](https://github.com/bdunahu/RISC-V-ECTOR-) simulator.
 
 ## Dependencies
 
@@ -27,4 +19,5 @@ Run `make` to produce a binary file in `/bin/`. To run the unit tests, run `make
 # About
 
 Created at the University of Massachusetts, Amherst
+
 CS535 -- Computer Architecture and ISA Design
\ No newline at end of file
diff --git a/rva.asd b/rva.asd
index 75300a8..7fdb00b 100644
--- a/rva.asd
+++ b/rva.asd
@@ -16,6 +16,7 @@
                 :components ((:file "package")
                              (:file "util")
                              (:file "lex")
+                             (:file "parse")
                              (:file "main"))))
   :long-description
   #.(uiop:read-file-string
@@ -36,7 +37,8 @@
                 :components ((:file "package")
                              (:file "main")
                              (:file "util")
-                             (:file "lex"))))
+                             (:file "lex")
+                             (:file "parse"))))
   :perform (test-op (o s) (uiop:symbol-call :rva-tests :test-rva)))
 
 (defmethod asdf:perform ((o asdf:image-op) (c asdf:system))
diff --git a/src/package.lisp b/src/package.lisp
index 670ed02..d999783 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -4,7 +4,10 @@
 
 (defpackage #:util
   (:use #:cl)
-  (:export #:asm-extension?))
+  (:export #:asm-extension?
+           #:format-as-binary
+           #:label-loc
+           #:mnemonic-loc))
 
 (defpackage #:lex
   (:use #:cl)
@@ -12,3 +15,9 @@
            ;; exported for testing only
            #:read-token
            #:invalid-immediate-or-keyword))
+
+(defpackage #:parse
+  (:use #:cl)
+  (:export #:tokens->ast
+           ;; exported for testing only
+           #:extract-label))
diff --git a/src/parse.lisp b/src/parse.lisp
new file mode 100644
index 0000000..8bd8c50
--- /dev/null
+++ b/src/parse.lisp
@@ -0,0 +1,21 @@
+(in-package #:parse)
+
+(defun tokens->ast (program)
+  (let ((program (remove nil (mapcar #'extract-label program))))
+    ;; TODO
+    program))
+
+(let ((i 0))
+  (defun extract-label (line)
+    "Given a series of tokens LINE, determines if LINE is
+in the form STRING {colon}. If it is, then it is treated as a
+label, and pushed onto the stack with the line index.
+
+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))
+      (_ (progn (incf i) line)))))
diff --git a/src/util.lisp b/src/util.lisp
index 87e4df9..1ea6dfc 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -3,3 +3,35 @@
 (defun asm-extension? (file)
   "Returns t if FILE is extended with .asm, nil otherwise."
   (string= (pathname-type file) "asm"))
+
+;; TODO this won't work for negative numbers of odd sizes quite yet.
+(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))
+
+(defmacro generate-type-map (type opsize ops)
+  "Generates an alist where the key corresponds to an element in
+OPS, while the value is the index of that key (padded to OPSIZE)
+concatenated with TYPE."
+  `(let ((i 0))
+     (mapcar (lambda (x)
+               (incf i)
+               (cons x (concatenate 'string ,type
+                                    (format-as-binary i ,opsize))))
+             ,ops)))
+
+(defparameter label-loc '()
+  "A symbol table mapping label names to line indices.")
+
+(defparameter mnemonic-loc
+  `(,@(generate-type-map "00" 5
+                         '(ADD SUB MUL QUOT REM SFTR SFTL AND OR NOT
+                           XOR ADDV SUBV MULV DIVV CMP CEV))
+    ,@(generate-type-map "01" 4
+                         '(LOAD LOADV ADDI SUBI SFTRI SFTLI ANDI ORI
+                           XORI STORE STOREV))
+    ,@(generate-type-map "10" 4
+                         '(JMP JRL JAL BEQ BGT BUF BOF PUSH POP)))
+  "An alist mapping known mnemonics to their binary representation.")
diff --git a/t/parse.lisp b/t/parse.lisp
new file mode 100644
index 0000000..2ab3e76
--- /dev/null
+++ b/t/parse.lisp
@@ -0,0 +1,20 @@
+(in-package #:rva-tests)
+
+(def-suite parse-tests
+  :description "Test functions exported from the parser."
+  :in all-tests)
+
+(in-suite parse-tests)
+
+(test extract-label-is-a-label
+      (is (not (parse:extract-label '("LOOP" lex::colon)))))
+
+(test extract-label-not-a-label-one
+      (let ((lst '("NICE" "TRY")))
+	(is (equal lst
+		   (parse:extract-label lst)))))
+
+(test extract-label-not-a-label-two
+      (let ((lst '("LOOP" lex::colon lex::colon)))
+	(is (equal lst
+		   (parse:extract-label lst)))))
diff --git a/t/util.lisp b/t/util.lisp
index ef59fbb..c2dafab 100644
--- a/t/util.lisp
+++ b/t/util.lisp
@@ -14,3 +14,15 @@
 
 (test asm-extension?-returns-true-obvious-case
       (is (util:asm-extension? "quux.asm")))
+
+(test format-as-binary-unsigned-no-pad
+      (is (string= (util:format-as-binary 0 0)
+		   "0")))
+
+(test format-as-binary-unsigned-no-pad-fourty-two
+      (is (string= (util:format-as-binary 42 0)
+		   "101010")))
+
+(test format-as-binary-unsigned-pad-fourty-two
+      (is (string= (util:format-as-binary 42 10)
+		   "0000101010")))