Add untested (but works on the single input file) code emission

8 files changed, 193 insertions, 120 deletions

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 "~@<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))))