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

5 files changed, 60 insertions, 23 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..f73d9be 100644
--- a/src/emit.lisp
+++ b/src/emit.lisp
@@ -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..bd8a1f8 100644
--- a/src/parse.lisp
+++ b/src/parse.lisp
@@ -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 9e07dd5..29c313d 100644
--- a/t/parse.lisp
+++ b/t/parse.lisp
@@ -4,8 +4,17 @@
   :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)
 
@@ -43,7 +52,7 @@
            '(emit::p
 	     (emit::d)
              (emit::x
-	      (emit::j "JMP" (emit::l "FOO" 7) (emit::rr 0))
+	      (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 "PUSH" (emit::rr 5) 0)))
@@ -73,7 +82,7 @@
            '(emit::p
 	     (emit::d)
              (emit::x
-              (emit::j "JMP" (emit::l "FOO" 14) (emit::rr 0))
+              (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 FOO~t
@@ -84,13 +93,16 @@ JRL FOO~t~%PUSH $5~%")))))
            '(emit::p
 	     (emit::d)
              (emit::x
-	      (emit::j "JMP" (emit::l "FOO" 17) (emit::rr 0))
+	      (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 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