Merge pull request #9 from bdunahu/bdunahu

Let displacement for JAL+JMP be the absolute file position of label

5 files changed, 85 insertions, 48 deletions

diff --git a/README.md b/README.md
index d0f1a19..4314d58 100644
--- a/README.md
+++ b/README.md
@@ -16,6 +16,14 @@ A common-lisp implementation (SBCL) and the following libraries are required to
 
 Run `make` to produce a binary file in `/bin/`. To run the unit tests, run `make test`. See the make file for further options.
 
+## Todo
+
+- add named register aliases
+- add 'mov'', 'leave' pseudo-instructions
+- allow .text and .data to appear anywhere, any number of times
+- rewrite tests to be independent of each other
+- write negative test cases
+
 # About
 
 Created at the University of Massachusetts, Amherst
diff --git a/input/dominative-functions.asm b/input/dominative-functions.asm
index 530717d..d11ddcb 100644
--- a/input/dominative-functions.asm
+++ b/input/dominative-functions.asm
@@ -13,7 +13,7 @@ MAIN:
 	addi $6 $0 -11
 
 	push $6
-	;; jal SUB23
+	jal SUB23
 	pop $6
 	store $6 answer($0)
 SUB23:
@@ -29,7 +29,7 @@ SUB23:
 
 	add  $6 $6 $7
 	push $6
-	;; jal ADD76
+	jal ADD76
 	pop $6		; retrieve and pass along
 	store $6 +4($5)
 
diff --git a/src/emit.lisp b/src/emit.lisp
index 78a41ed..85214c2 100644
--- a/src/emit.lisp
+++ b/src/emit.lisp
@@ -48,8 +48,8 @@ concatenated with TYPE."
 
 (defun x (&rest lst)
   (append lst
-	  ;; add a halt to the end of the instructions list
-	  (list (r "QUOT" (rr 0) (rr 0) (rr 0)))))
+          ;; 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
@@ -68,9 +68,9 @@ concatenated with TYPE."
       (util:format-as-binary val 5)
       (error (format nil "~a is not a valid register id!~%" val))))
 
-(defun l (l s)
+(defun l (l &optional (pos 0))
   (let ((d (util:get-label l)))
-    (- d s)))
+    (- d pos)))
 
 (defun var (s)
   (let ((pos (util:get-variable s)))
diff --git a/src/parse.lisp b/src/parse.lisp
index 6607265..4e9cd5c 100644
--- a/src/parse.lisp
+++ b/src/parse.lisp
@@ -54,7 +54,7 @@
   (:lambda (e) (parse-integer (esrap:text (cddr e)) :radix 16)))
 
 (esrap:defrule integer (and (esrap:? sign) (or binary-number octal-number
-					   hexadecimal-number decimal-number))
+                                           hexadecimal-number decimal-number))
   (:destructure (s i)
     (if (and s (string= s "-")) (- i) i)))
 
@@ -78,6 +78,9 @@
 ;;; defines rules to parse labels
 
 (esrap:defrule label alphanumeric
+  (:lambda (e) (list 'emit::l e)))
+
+(esrap:defrule label+pos alphanumeric
   (:lambda (e) (list 'emit::l e line-number)))
 
 (esrap:defrule label-declaration (and alphanumeric #\:)
@@ -93,21 +96,35 @@
     (esrap:add-rule
      name (make-instance 'esrap:rule :expression expr))))
 
-;; define special cases first
-(generate-mnemonic 'r-type-1-m '("NOT"))
-(generate-mnemonic 'r-type-2-m '("CMP" "CEV"))
-(generate-mnemonic 'i-type-1-m '("LOADV" "LOAD"))
-(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-4-m (reverse util:j-type))
+(let* ((lst (reverse util:r-type))
+       (type-1 '("NOT"))
+       (type-2 '("CMP" "CEV"))
+       (type-3 (remove-if (lambda (x) (member x (append type-1 type-2))) lst)))
+  (generate-mnemonic 'r-type-1-m type-1)
+  (generate-mnemonic 'r-type-2-m type-2)
+  (generate-mnemonic 'r-type-3-m type-3))
+
+(let* ((lst (reverse util:i-type))
+       (type-1 '("LOADV" "LOAD"))
+       (type-2 '("STOREV" "STORE"))
+       (type-3 (remove-if (lambda (x) (member x (append type-1 type-2))) lst)))
+  (generate-mnemonic 'i-type-1-m type-1)
+  (generate-mnemonic 'i-type-2-m type-2)
+  (generate-mnemonic 'i-type-3-m type-3))
+
+(let* ((lst (reverse util:j-type))
+       (type-1 '("JMP" "JAL"))
+       (type-2 '("PUSH" "POP"))
+       (type-3 '("RET" "NOP"))
+       (type-4 (remove-if (lambda (x) (member x (append type-1 type-2 type-3))) lst)))
+  (generate-mnemonic 'j-type-1-m type-1)
+  (generate-mnemonic 'j-type-2-m type-2)
+  (generate-mnemonic 'j-type-3-m type-3)
+  (generate-mnemonic 'j-type-4-m type-4))
 
 ;; TODO this is pretty gross
+;; while I'm at it, make a macro for the above too
 (defmacro defrule-instr (name type-id order &rest destructure-pattern)
   "Defines the boilerplate for a common esrap instruction rule.
 NAME is the name of the non-terminal symbol.
@@ -120,15 +137,15 @@ DESTRUCTURE-PATTERN is the list of non-terminals on the right side of the gramma
     `(esrap:defrule ,name
          (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) ''(emit::rr 0))) order))))))
+                     (declare (ignore ,@spaces))
+                     (list ,type-id m ,@(mapcar (lambda (x) (or (nth x vars) ''(emit::rr 0))) order))))))
 
 (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 (1 0 2) register register immediate)
-(defrule-instr j-type-1 'emit::j (0 1) label)
-(defrule-instr j-type-4 'emit::j (1 0) label)
+(defrule-instr j-type-1 'emit::j (1 0) label)
+(defrule-instr j-type-4 'emit::j (1 0) label+pos)
 
 (esrap:defrule i-type-1 (and i-type-1-m space register space dereference)
   (:destructure (m w1 s w2 di)
diff --git a/t/parse.lisp b/t/parse.lisp
index 2612f45..2cb5b42 100644
--- a/t/parse.lisp
+++ b/t/parse.lisp
@@ -4,14 +4,23 @@
   :description "Test functions exported from the parser."
   :in all-tests)
 
+(defmacro expect-parse-error (body)
+  `(handler-case
+       (progn ,body
+              (fail))
+     (esrap::parse-error ())))
+
 ;;; these tests are not exhaustive, and are meant to test basic functionality
 ;;; under correct circumstances.
+;;; TODO add negative test cases
+;;; TODO undesirably, these tests are setup in a way where the previous tests
+;;; affect the succeeding ones (line labels)
 
 (in-suite parse-tests)
 
 (test esrap-register-bases
       (is (equal '(emit::p
-		   (emit::d)
+                   (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~%")))))
@@ -19,7 +28,7 @@
 (test esrap-instr-all-type-r
       (is (equal
            '(emit::p
-	     (emit::d)
+             (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))
@@ -30,7 +39,7 @@
 (test esrap-instr-all-type-i
       (is (equal
            '(emit::p
-	     (emit::d)
+             (emit::d)
              (emit::x
               (emit::i "LOADV" (emit::rr 8) (emit::rr 9) 1)
               (emit::i "STORE" (emit::rr 3) (emit::rr 5) 3)
@@ -41,19 +50,19 @@
 (test esrap-instr-type-all-type-j
       (is (equal
            '(emit::p
-	     (emit::d)
+             (emit::d)
              (emit::x
-              (emit::j "JMP" (emit::rr 3) 3)
+              (emit::j "JMP" (emit::rr 0) (emit::l "FOO"))
               (emit::j "JRL" (emit::rr 0) (emit::l "FOO" 8))
-	      (emit::j "RET" (emit::rr 0) 0)
+              (emit::j "RET" (emit::rr 0) 0)
               (emit::j "PUSH" (emit::rr 5) 0)))
-           (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tJMP 3($3)
+           (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tJMP FOO
 ~tJRL FOO~%~tRET~%~tPUSH $5~%")))))
 
 (test esrap-instr-type-i-negative
       (is (equal
            '(emit::p
-	     (emit::d)
+             (emit::d)
              (emit::x
               (emit::i "LOADV" (emit::rr 8) (emit::rr 3) -3)))
            (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tLOADV $8 -3($3)~%")))))
@@ -61,7 +70,7 @@
 (test esrap-instr-type-i-vars
       (is (equal
            '(emit::p
-	     (emit::d)
+             (emit::d)
              (emit::x
               (emit::i "LOADV" (emit::rr 8) (emit::rr 4) 2)
               (emit::i "STORE" (emit::rr 1) (emit::rr 5) 2)))
@@ -71,32 +80,35 @@
 (test esrap-instr-type-all-lazy-spaces
       (is (equal
            '(emit::p
-	     (emit::d)
+             (emit::d)
              (emit::x
-              (emit::j "JMP" (emit::rr 3) 3)
+              (emit::j "JMP" (emit::rr 0) (emit::l "FOO"))
               (emit::j "JRL" (emit::rr 0) (emit::l "FOO" 15))
               (emit::j "PUSH" (emit::rr 5) 0)))
-           (esrap:parse 'parse:str->ast (format nil ".DATA~%~%.TEXT~t~%JMP 3($3)~t
+           (esrap:parse 'parse:str->ast (format nil ".DATA~%~%.TEXT~t~%JMP FOO~t
 JRL FOO~t~%PUSH $5~%")))))
 
 (test esrap-instr-type-comments
       (is (equal
            '(emit::p
-	     (emit::d)
+             (emit::d)
              (emit::x
-              (emit::j "JMP" (emit::rr 3) 3)
+              (emit::j "JMP" (emit::rr 0) (emit::l "FOO"))
               (emit::j "JRL" (emit::rr 0) (emit::l "FOO" 18))
               (emit::j "PUSH" (emit::rr 5) 0)))
            (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT;; dot dot dot
-~tJMP 3($3) ;; this does things
+~tJMP FOO ;; this does things
 ~tJRL FOO~%~tPUSH $5~%")))))
 
+(test esrap-instr-bad-not
+      (expect-parse-error (esrap:parse 'parse:str->ast (format nil ".DATA~%.TEXT~%~tNOT $5 $5 $5~%"))))
+
 (test esrap-data-singleton
       (is (equal
            '(emit::p
              (emit::d
               1)
-	     (emit::x))
+             (emit::x))
            (esrap:parse 'parse:str->ast (format nil ".DATA~%~tA 1~%.TEXT~%")))))
 
 (test esrap-data-loaded
@@ -104,7 +116,7 @@ JRL FOO~t~%PUSH $5~%")))))
            '(emit::p
              (emit::d
               1 2 3 4 5 6 7 8)
-	     (emit::x))
+             (emit::x))
            (esrap:parse 'parse:str->ast (format nil ".DATA~%~tB 1 2 3 4 5 6 7 8
 .TEXT~%")))))
 
@@ -113,7 +125,7 @@ JRL FOO~t~%PUSH $5~%")))))
            '(emit::p
              (emit::d
               5 6 7 8 4 3 5)
-	     (emit::x))
+             (emit::x))
            (esrap:parse 'parse:str->ast (format nil ".DATA~%~tC 5 6 7 8~%~tD 4
 ~tE 3 5~%.TEXT~%")))))
 
@@ -122,18 +134,18 @@ JRL FOO~t~%PUSH $5~%")))))
            '(emit::p
              (emit::d
               5 6 7 8 4 3 5)
-	     (emit::x))
+             (emit::x))
            (esrap:parse 'parse:str->ast (format nil "~%~t.DATA~t~%F 5 6 7 8~t~%G 4
 H 3 5~%.TEXT~%")))))
 
 (test esrap-negative-ints
       (is (equal
-	   '(emit::p
-	     (emit::d
-	      -1)
-	     (emit::x
-	      (emit::i "LOADV" (emit::rr -8) (emit::rr -3) -3)))
-	   (esrap:parse 'parse:str->ast (format nil ".DATA~%~tm -1~%.TEXT~%~tLOADV $-8 -3($-3)~%")))))
+           '(emit::p
+             (emit::d
+              -1)
+             (emit::x
+              (emit::i "LOADV" (emit::rr -8) (emit::rr -3) -3)))
+           (esrap:parse 'parse:str->ast (format nil ".DATA~%~tm -1~%.TEXT~%~tLOADV $-8 -3($-3)~%")))))
 
 (test esrap-data-full
       (is (equal