Merge pull request #8 from bdunahu/bdunahu

Add write raw bytes stage

5 files changed, 118 insertions, 71 deletions

diff --git a/src/emit.lisp b/src/emit.lisp
index acc2772..213eb1a 100644
--- a/src/emit.lisp
+++ b/src/emit.lisp
@@ -2,7 +2,7 @@
 
 (defun fits-in-X-bits (n)
   "Returns the number of bits required to represent N"
-  (ceiling (/ (log (ceiling n (log 2))) (log 2))))
+  (ceiling (/ (log n) (log 2))))
 
 (defmacro generate-type-map (ops)
   "Generates an alist where the key corresponds to an element in
@@ -11,8 +11,7 @@ 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)
+     (mapcar (lambda (x) (incf i)
                (cons x (util:format-as-binary i opsize)))
              ,ops)))
 
@@ -32,7 +31,9 @@ concatenated with TYPE."
   (mapcar (lambda (x) (util:format-as-binary x 32)) lst))
 
 (defun x (&rest lst)
-  lst)
+  (append lst
+	  ;; add a halt to the end of the instructions list
+	  (list (r "QUOT" (rr 0) (rr 0) (rr 0)))))
 
 (defun r (mnemonic s1 s2 d)
   (concatenate
@@ -51,16 +52,16 @@ concatenated with TYPE."
       (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)))
+    (+ pos parse:line-number 1)))
 
 (defun emit (p)
-  (format t "~a~%" p)
   (eval p))
+
+(defun ast->str (p)
+  (format nil "~a" p))
diff --git a/src/main.lisp b/src/main.lisp
index f20b022..f1f3021 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -23,27 +23,51 @@ _/_/                                  _/_/  "
     :long-name "parse"
     :short-name #\p
     :required nil
-    :key :parse)))
+    :key :parse)
+   (clingon:make-option
+    :flag
+    :description "run the emitter, but stop before writing"
+    :long-name "emit"
+    :short-name #\e
+    :required nil
+    :key :emit)))
+
+(defun postprocess (out file)
+  "Given OUT, a list of words, writes the raw bytes to FILE."
+  (let ((file (util:generate-file-name file))
+        (bytes (alexandria:flatten
+                (mapcar (lambda (x)
+                          (util:word-to-bytes (parse-integer x :radix 2)))
+                        out))))
+    (with-open-file (stream file
+                            :direction :output
+                            :if-exists :supersede
+                            :if-does-not-exist :create
+                            :element-type '(unsigned-byte 8))
+      (loop for byte in bytes do (write-byte byte stream)))
+    (format t "File written! Check ~a~%" file)))
 
 (defun driver (cmd)
   "Reads in a file and directs lexing, parsing, and binary emission."
   (print-splash)
   (let* ((args (clingon:command-arguments cmd))
          (file (car args))
-         (emit? (not (clingon:getopt cmd :parse))))
+         (emit? (not (clingon:getopt cmd :parse)))
+         (write? (not (clingon:getopt cmd :emit))))
     (cond
-      ;; complain about num arguments
       ((/= (length args) 1) (error "Wrong number of arguments.~%"))
       ((not (util:asm-extension? file))
        (error "The file is not an asm source code file.~%"))
       (t (let ((str (uiop:read-file-string file)))
            (if str
-	       (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~%"))))))
-
+               (let ((ast (esrap:parse 'parse::str->ast (string-upcase str))))
+                 (if emit?
+                     (let ((words (emit:emit ast)))
+                       (if write?
+                           (postprocess words file)
+                           (format t "Emission successful, got: ~%~a~%" words)))
+                     (format t "Parse successful, got:~%~a~%" (emit:ast->str ast))))
+               (error "The file does not exist, or it could not be opened.~%")))))))
 
 (defun cli/command ()
   "Returns a clingon command."
@@ -51,7 +75,7 @@ _/_/                                  _/_/  "
    :name "rva"
    :description "generates a binary compatible with the RISC V[ECTOR] simulator"
    :usage "[options] file"
-   :version(asdf:component-version
+   :version (asdf:component-version
             (asdf:find-system "rva" nil))
    :options (cli/options)
    :handler #'driver))
diff --git a/src/package.lisp b/src/package.lisp
index bbb45a3..d016501 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -6,22 +6,25 @@
   (:use #:cl)
   (:export #:asm-extension?
            #:format-as-binary
-	   #:insert-in-middle
-	   #:iota
-	   #:riffle
-	   #:add-variable
-	   #:add-label
-	   #:get-variable
-	   #:get-label
-	   #:r-type
-	   #:i-type
-	   #:j-type))
+           #:generate-file-name
+           #:word-to-bytes
+           #:insert-in-middle
+           #:iota
+           #:riffle
+           #:add-variable
+           #:add-label
+           #:get-variable
+           #:get-label
+           #:r-type
+           #:i-type
+           #:j-type))
 
 (defpackage #:parse
   (:use #:cl)
   (:export #:str->ast
-	   #:line-number))
+           #:line-number))
 
 (defpackage #:emit
   (:use #:cl)
-  (:export #:emit))
+  (:export #:emit
+           #:ast->str))
diff --git a/src/parse.lisp b/src/parse.lisp
index d971444..0ea6c0d 100644
--- a/src/parse.lisp
+++ b/src/parse.lisp
@@ -9,60 +9,62 @@
     (+ (or #\space #\tab))
   (:constant nil))
 
-(esrap:defrule nl (+ #\newline)
+(esrap:defrule eol (and (esrap:? space) (esrap:? (and #\; (* (not #\newline)))) #\newline)
   (:constant nil))
 
-(esrap:defrule nl-inc (+ #\newline)
-  (:lambda (n)
-    (declare (ignore n))
-    (incf line-number)
-    nil))
+(esrap:defrule newline (+ eol)
+  (:constant nil))
 
-(esrap:defrule alpha (+ (alphanumericp character))
+(esrap:defrule sign (or #\+ #\-))
+
+(esrap:defrule alphanumeric (+ (alphanumericp character))
   (:text t))
 
 ;;; defines rules to parse an integer in various bases
 
 (defmacro define-number-rule ())
 
-(esrap:defrule binary (and #\0 #\B (+ (or "0" "1")))
+(esrap:defrule binary-number (and #\0 #\B (+ (or "0" "1")))
   (:lambda (e) (parse-integer (esrap:text (cddr e)) :radix 2)))
 
-(esrap:defrule octal (and #\0 #\O (+ (or (esrap:character-ranges (#\0 #\7)))))
+(esrap:defrule octal-number (and #\0 #\O (+ (or (esrap:character-ranges (#\0 #\7)))))
   (:lambda (e) (parse-integer (esrap:text (cddr e)) :radix 8)))
 
-(esrap:defrule decimal (+ (or (esrap:character-ranges (#\0 #\9))))
+(esrap:defrule decimal-number (+ (or (esrap:character-ranges (#\0 #\9))))
   (:lambda (e) (parse-integer (esrap:text e) :radix 10)))
 
-(esrap:defrule hex (and #\0 #\X (+ (or (esrap:character-ranges (#\0 #\9))
+(esrap:defrule hexadecimal-number (and #\0 #\X (+ (or (esrap:character-ranges (#\0 #\9))
                                        "A" "B" "C" "D" "E" "F")))
   (:lambda (e) (parse-integer (esrap:text (cddr e)) :radix 16)))
 
-(esrap:defrule int (or binary octal hex decimal))
+(esrap:defrule integer (and (esrap:? sign) (or binary-number octal-number
+					   hexadecimal-number decimal-number))
+  (:destructure (s i)
+    (if (and s (string= s "-")) (- i) i)))
 
 ;;; defines rules to parse an operand
 
-(esrap:defrule register (and #\$ int)
+(esrap:defrule register (and #\$ integer)
   (:function cadr)
   (:lambda (e) (list 'emit::rr e)))
 
-(esrap:defrule var alpha
-  (:lambda (e) (list (list 'emit::rr 0) (list 'emit::var e))))
+(esrap:defrule variable alphanumeric
+  (:lambda (e) (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 'emit::imm (if (and s (string= s "-")) (- i1) i1)))))
+(esrap:defrule immediate (or integer variable)
+  (:lambda (e) e))
 
-(esrap:defrule immediate int
-  (:lambda (e) (list 'emit::imm e)))
+(esrap:defrule dereference (and immediate #\( register #\))
+  (:destructure (i1 w1 r w2)
+    (declare (ignore w1 w2))
+    (list r i1)))
 
 ;;; defines rules to parse labels
 
-(esrap:defrule label alpha
+(esrap:defrule label alphanumeric
   (:lambda (e) (list 'emit::l e line-number)))
 
-(esrap:defrule label-decl (and alpha #\:)
+(esrap:defrule label-declaration (and alphanumeric #\:)
   (:function car)
   (:lambda (e)
     (util:add-label e line-number)
@@ -82,11 +84,12 @@
 (generate-mnemonic 'i-type-2-m '("STOREV" "STORE"))
 (generate-mnemonic 'j-type-1-m '("JMP" "JAL"))
 (generate-mnemonic 'j-type-2-m '("PUSH" "POP"))
+(generate-mnemonic 'j-type-3-m '("RET" "NOP"))
 
 ;; we need to reverse to ensure rules like "ADDV" are matched before "ADD"
 (generate-mnemonic 'r-type-3-m (reverse util:r-type))
 (generate-mnemonic 'i-type-3-m (reverse util:i-type))
-(generate-mnemonic 'j-type-3-m (reverse util:j-type))
+(generate-mnemonic 'j-type-4-m (reverse util:j-type))
 
 ;; TODO this is pretty gross
 (defmacro defrule-instr (name type-id order &rest destructure-pattern)
@@ -107,15 +110,15 @@ DESTRUCTURE-PATTERN is the list of non-terminals on the right side of the gramma
 (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)
+(defrule-instr i-type-3 'emit::i (1 0 2) register register immediate)
+(defrule-instr j-type-4 'emit::j (1 0) label)
 
-(esrap:defrule i-type-1 (and i-type-1-m space register space (or dereference var))
+(esrap:defrule i-type-1 (and i-type-1-m space register space dereference)
   (:destructure (m w1 s w2 di)
     (declare (ignore w1 w2))
     `(emit::i ,m ,s ,@di)))
 
-(esrap:defrule i-type-2 (and i-type-2-m space register space (or dereference var))
+(esrap:defrule i-type-2 (and i-type-2-m space register space dereference)
   (:destructure (m w1 s w2 di)
     (declare (ignore w1 w2))
     `(emit::i ,m ,@(util:insert-in-middle di s))))
@@ -128,47 +131,52 @@ DESTRUCTURE-PATTERN is the list of non-terminals on the right side of the gramma
 (esrap:defrule j-type-2 (and j-type-2-m space register)
   (:destructure (m w r)
     (declare (ignore w))
-    `(emit::j ,m ,r (emit::imm 0))))
+    `(emit::j ,m ,r 0)))
+
+(esrap:defrule j-type-3 j-type-3-m
+  (:lambda (m)
+    `(emit::j ,m (emit::rr 0) 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))
+                         i-type-3 j-type-1 j-type-2 j-type-3 j-type-4))
 
 ;;; defines rules to parse the .text segment
 
-(esrap:defrule instr-clean (and (esrap:? space) instr (esrap:? space) nl-inc)
-  (:function cadr))
+(esrap:defrule instr-clean (and (esrap:? space) instr newline)
+  (:function cadr)
+  (:lambda (i) (incf line-number) i))
 
-(esrap:defrule label-clean (and label-decl (esrap:? space) nl)
+(esrap:defrule label-clean (and label-declaration newline)
   (:function car))
 
 (esrap:defrule text-line (or instr-clean label-clean))
 
-(esrap:defrule text (and ".TEXT" (esrap:? space) nl (* text-line))
+(esrap:defrule text (and ".TEXT" (esrap:? space) newline (* text-line))
   (:function cadddr)
   (:lambda (e) `(emit::x ,@(remove nil e))))
 
 ;;; defines rules to parse the .data segment
 
-(esrap:defrule data-word (and (esrap:? space) int)
+(esrap:defrule data-word (and (esrap:? space) integer)
   (:function cadr)
   (:lambda (e)
     (incf var-offset)
     e))
 
-(esrap:defrule var-decl alpha
+(esrap:defrule var-declaration alphanumeric
   (:lambda (e)
     (util:add-variable e var-offset)
     nil))
 
-(esrap:defrule data-line (and (esrap:? space) var-decl (+ data-word) (esrap:? space) nl)
+(esrap:defrule data-line (and (esrap:? space) var-declaration (+ data-word) newline)
   (:function caddr))
 
-(esrap:defrule data (and ".DATA" (esrap:? space) nl (* data-line))
+(esrap:defrule data (and ".DATA" (esrap:? space) newline (* data-line))
   (:function cadddr)
   (:lambda (e) `(emit::d ,@(apply #'append e))))
 
 ;;; defines rules to parse a program
 
-(esrap:defrule str->ast (and (* (or space nl)) data text)
+(esrap:defrule str->ast (and (* (or space newline)) data text)
   (:function cdr)
   (:lambda (e) `(emit::p ,@e)))
diff --git a/src/util.lisp b/src/util.lisp
index f3035fe..e52d7aa 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -4,6 +4,9 @@
   "Returns t if FILE is extended with .asm, nil otherwise."
   (string= (pathname-type file) "asm"))
 
+(defun generate-file-name (file)
+  "Given a .asm file, generates an identically named .rv file."
+  (subseq file 0 (- (length file) 4)))
 
 (defun format-as-binary (num len)
   "Formats NUM as a binary number, and pads to LEN with zeros."
@@ -12,7 +15,15 @@
   (let ((max-val (1- (expt 2 len))))
     (format nil "~V,'0b" len (logand num max-val))))
 
+(defun word-to-bytes (int)
+  "Given a 32-bit integer, outputs a list of 4 bytes."
+  (list (logand #xff (ash int -24))
+        (logand #xff (ash int -16))
+        (logand #xff (ash int -8))
+        (logand #xff int)))
+
 (defun insert-in-middle (list element)
+  "Inserts ELEMENT in the second slot of LIST."
   (append (list (car list)) (list element) (cdr list)))
 
 (defun iota (n)
@@ -48,7 +59,7 @@ of the elements from both lists. Returns nil if the lists are not equal size."
   (alexandria:if-let ((value (gethash name variable-table)))
     value
     (progn (maphash #'(lambda (k v) (format t "~A => ~A~%" k v)) variable-table)
-	   (error "~@<Variable ~S not declared.~@:>" name))))
+           (error "~@<Variable ~S not declared.~@:>" name))))
 
 (defun get-label (name)
   (alexandria:if-let ((value (gethash name label-table)))
@@ -65,5 +76,5 @@ of the elements from both lists. Returns nil if the lists are not equal size."
   "I-type instructions.")
 
 (defvar j-type
-  '("JMP" "JRL" "JAL" "BEQ" "BGT" "BUF" "BOF" "PUSH" "POP")
+  '("JMP" "JRL" "JAL" "BEQ" "BGT" "BUF" "BOF" "PUSH" "POP" "RET" "NOP")
   "J-type instructions.")