]> Joshua Wise's Git repositories - snipe.git/commitdiff
Initial import of l2c
authorJoshua Wise <joshua@h2so4.joshuawise.com>
Thu, 14 May 2009 01:57:57 +0000 (21:57 -0400)
committerJoshua Wise <joshua@h2so4.joshuawise.com>
Thu, 14 May 2009 01:57:57 +0000 (21:57 -0400)
28 files changed:
Makefile
README
bin/l1c [deleted file]
bin/l2c [new file with mode: 0755]
codegen/codegen.sml
codegen/coloring.sml
codegen/colororder.sml
codegen/igraph.sml
codegen/liveness.sml
codegen/peephole.sml
codegen/solidify.sml
codegen/stringifier.sml
codegen/x86.sml
compile-l2c.sml [moved from compile-l1c.sml with 72% similarity]
parse/ast.sml
parse/l1.grm [deleted file]
parse/l1.lex.sml [deleted file]
parse/l2.grm [new file with mode: 0644]
parse/l2.lex [moved from parse/l1.lex with 66% similarity]
parse/parse.sml
sources.cm
top/top.sml
trans/label.sml [new file with mode: 0644]
trans/temp.sml
trans/trans.sml
trans/tree.sml
type/typechecker.sml
util/symbol.sml

index ca58a0b4247cebd8edb6c2f5b7dde8ac8c0e1b4d..8829383e8760975fc37c6ed9e5d112442d030309 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,14 +1,14 @@
 # the following are SML-NJ specific defines
 SML = sml
 
-l1c: FORCE
-       echo 'use "compile-l1c.sml";' | ${SML}
+l2c: FORCE
+       echo 'use "compile-l2c.sml";' | ${SML}
 
 clean:
        find . -type d -name .cm | xargs rm -rf
        ${RM} parse/*.lex.* parse/*.grm.*
        find . -type f | grep '~$$' | xargs ${RM}
-       ${RM} bin/l1c.heap.*
+       ${RM} bin/l2c.heap.*
 
 TAGS: clean
        ${RM} TAGS
diff --git a/README b/README
index 0e3bf3da60d20ade4382a58905e607f906ee0afc..66a2e239e1769abfc350a7c1424d9808f9015427 100644 (file)
--- a/README
+++ b/README
-(* README
- * Author: Frank Pfenning <fp@cs.cmu.edu>
- *)
-
------------------------------------------------------------------------
-Welcome to 15-411 F08!
------------------------------------------------------------------------
-
-This is some starter code for the L1 compiler you have to build for
-the Lab1.  It contains a lexer, parser, translator, and even a code
-generator, except that the code generator creates pseudo assembly
-language with fictitious instructions and an unlimited number of
-registers.  We took some care to use good style (according to the
-instructor); you may consider this a model for your own coding.  Feel
-free to modify any and all of this code as you see fit.
-
-Bug reports to the instructor Frank Pfenning <fp@cs.cmu.edu> are
-particularly welcome and will be noted in the extra credit category.
-
------------------------------------------------------------------------
-SML Notes
------------------------------------------------------------------------
-There are many different compilers for SML, perhaps the most
-popular ones are
-
-  SML/NJ  -- http://www.smlnj.org/
-  MLton   -- http://www.mlton.org/
-  Poly/ML -- http://www.polyml.org/
-
-In this class we will be using SML/NJ v110.59.  Please make sure your
-code compiles under specifically this version on the lab machines
-where it is the default and can be invoked simply with "sml" in a
-shell.
-
-If you develop your implementation on other machines, similar versions
-of SML/NJ are likely to be compatible, but you should certainly check
-your code on the lab machines.
-
-For (almost universal) Standard Basis Libraries, see
-http://www.standardml.org/Basis/index.html.  Further resources, such
-as documentation for ML-Lex and ML-Yacc, and documentation for the SML/NJ
-specific libraries which are used in the starter code, can be found at
-
-  http://www.cs.cmu.edu/~fp/courses/15411-f08/resources.html
-
-------------------------------------------------------------------------
-Source Files
-------------------------------------------------------------------------
-The following are the source files for the L1 compiler
-
-README               -- this file
-
-Makefile             -- makefile for the compiler
-                        For a quick test
-
-    % make l1c          (generates file bin/l1c.heap.<os-tag>)
-    % bin/l1c --verbose ../tests/test1.c
-
-                       should generate ../tests/test1.s in pseudo assembly
-
-    % make clean        (removes generated files)
-    % make TAGS         (creates file TAGS, for Emacs tags commands)
-
-compile-l1c.sml      -- SML commands that will create bin/l1c.heap.<os-tag>
-bin/l1c              -- the script that will run the exported SML heap
-
-sources.cm           -- lists all source files, including libraries,
-                        and lexer and grammar specifications
-                       For a quick test
-
-    % sml
-    - CM.make "sources.cm";
-    - Top.test "--verbose ../tests/test1.c";
-
-                        should generate ../tests/test1.s in pseudo assembly
-
-parse/ast.sml        -- definition and printer for abstract syntax trees (AST's)
-parse/l1.lex         -- L1 lexer
-parse/l1.grm         -- L1 grammar
-parse/parse.sml      -- L1 parser
-parse/parsestate.sml -- L1 parser support for error messages
-
-type/typechecker.sml -- (trivial) type-checker for AST
-
-trans/temp.sml       -- functions to generate and track temp's
-trans/tree.sml       -- definition and pretty printer for IR trees
-trans/trans.sml      -- translation from AST to IR trees
-
-codegen/assem.sml    -- pseudo assembly format for this starter code
-codegen/codegen.sml  -- pseudo code generator
-
-util/errormsg.sml    -- error message utilities
-util/flag.sml        -- library for defining flags
-util/mark.sml        -- library for tracking source file positions
-util/safe-io.sml     -- I/O utilities
-util/symbol.sml      -- symbol table library
-util/word32.sml      -- machine word utilities for two's complement interpretation
-
-top/top.sml          -- top level function for export to binary and testing
-
-------------------------------------------------------------------------
-Debugging Hints
-------------------------------------------------------------------------
-You can use
-
-  - Top.test "--verbose --dump-ast --dump-ir --dump-assem file.l1";
-
-to print information from all the phases of the current compiler.
-
-If you want to see the internal representations, you can call directly
-on SML's top level:
-
-  - val ast = Parse.parse "file.l1";
-  - val ir = Trans.translate ast;
-  - val assem = Codegen.codgen ir;
-
-This will use SML's internal printing function to print the data
-structures.  However, not everything will show.
-
-"-" means that the type is opaque.  Sometimes you can replace an opaque
-    signature ascription ":>" with a transparent one ":" to see the info.
-    For reasons of general hygiene, however, you should change it back
-    before handing in.
-
-"#" means that the printing depth is exceeded.  Use
-
-      - Control.Print.printDepth := 100;
-
-    to increase the depth if you need to see more.
-
-"..." means that the printing length is exceeded.  Use
-
-      - Control.Print.printLength := 1000;
-
-    to increase the length if you need to see more.
-
-------------------------------------------------------------------------
-Library Hints
-------------------------------------------------------------------------
-See util/symbol.sml for some uses of libraries provided with SML/NJ
-(and some other SML implementations).  BinaryMapFn and
-BinarySetFn are likely of general use.  To see their interface,
-you can check http://www.smlnj.org/doc/smlnj-lib/Manual/toc.html.
-I found binary maps and binary sets to be occasionally helpful.
+README
+------
+
+This compiler is a big long chain of modules that transform l2 code into
+x86_64 assembly.
+
+These modules include:
+
+  * The parser.  The parser was mainly brought in from lab 1, and mainly
+    just a straight-forward extension of the l1 parser.  We continued to
+    mark expressions, and pass marking through as needed so that we could
+    produce reasonable error messages up through translation stage.  We
+    introduced all needed grammar with no shift/reduce conflicts, but for
+    one in the IF/ELSE stage, with a construct such as:
+      if (x)
+      if (z)
+      a
+      else
+      b
+    (indentation intentionally omitted; there are at least two legitimate
+    ways to parse that!)
+  * The typechecker.  This module was completely rewritten since lab1.  Three
+    checks are instituted: a check to see if the program has misplaced break
+    or continue statements, a check to see that the program returns in all
+    control paths, and a check that all variables are initialized in all
+    control paths before usage.
+    
+    The return and break check is essentially implemented per the rules; the
+    only thing of interest for the variable initialization routine is that
+    there is a helper that computes all assigns to extend contexts from
+    block contents.  It was determined that returning 2 accumulators from
+    varcheck would lead to returning 17 accumulators, which would lead to
+    1984193248148132 accumulators; and 238547854478 accumulators leads to
+    the foldl, and foldl leads to anger, anger leads to hate, and hate leads
+    to the Dark Side.
+  * The translator is mainly intact; it was determined that the IR will have
+    basic control flow instructions of labels, jumps, and jump if not
+    conditional, which we deemed sufficient to implement all forms of l2
+    control.
+  * The munch module was fully rewritten; we now munch directly to
+    pseudo-x86_64, in that it has temporaries allowed in it as well.  We
+    believe that this allows us to generate much more optimal code than
+    munching into three op, converting from three to two, then converting
+    two to x86_64; in particular, we can run liveness on the x86_64
+    directions directly, which makes translation significantly easier (we do
+    not have to worry about mashing necessary registers).
+  * The liveness analyzer was also fully rewritten; it is now fully
+    def-use-succ, giving us very pretty rules, and a lot of very ugly code
+    to mash them together.  Luckily, the ugly code need not be touched ever
+    again.
+  * The grapher had about 4 characters of inconsequential change that had
+    the useful property of speeding it up by two orders of magnitude.  You
+    need not worry about it.
+  * The orderer and colorer had no changes.
+  * A new module was introduced -- in particular, the solidifier.  The
+    solidifier takes pseudo-x86_64 that is annotated with register locations
+    and emits needed spill and unspill operations to get everything into
+    real registers that the x86_64 chips can access.
+  * The peepholer remains pretty simple; redundant moves are optimized out,
+    and hence the code size drops by a factor of 1.5 or so.
+  * The stringifier is of no interest to you, for it does real things that
+    interact with the real world, and that is not of interest to people who
+    write in ML.
+
+We believe that it's fully functional; we have not had a case in quite some
+time that caused us to generate incorrect code (at least, when we should
+generate code).  The internal debug mechanisms are very useful; often a
+line-by-line examination of dumps after each translation phase can narrow
+bugs down into single lines of ML code.
diff --git a/bin/l1c b/bin/l1c
deleted file mode 100755 (executable)
index f86abd5..0000000
--- a/bin/l1c
+++ /dev/null
@@ -1 +0,0 @@
-sml @SMLcmdname=$0 @SMLload=bin/l1c.heap.x86-linux $*
diff --git a/bin/l2c b/bin/l2c
new file mode 100755 (executable)
index 0000000..4b7579c
--- /dev/null
+++ b/bin/l2c
@@ -0,0 +1 @@
+sml @SMLcmdname=$0 @SMLload=bin/l2c.heap.x86-linux $*
index 0297b9ff8524e5f561301717dd2f2cdb12373b83..9b99ef723ec9f60bc30aeb3279dd3655775373a8 100644 (file)
@@ -1,10 +1,7 @@
-(* L1 Compiler
- * Assembly Code Generator for FAKE assembly
- * Author: Alex Vaynberg <alv@andrew.cmu.edu>
- * Based on code by: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
- * Modified: Frank Pfenning <fp@cs.cmu.edu>
- *
- * Implements a "convenient munch" algorithm
+(* L2 Compiler
+ * Assembly code generator for fake x86 assembly
+ * Author: Joshua Wise <jwise@andrew.cmu.edu>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
  *)
 
 signature CODEGEN =
@@ -26,22 +23,146 @@ struct
     | munch_exp d (T.TEMP(t)) = [X.MOVL(d, X.TEMP t)]
     | munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = (munch_exp d e1) @ [X.ADDL(d, X.CONST n)]
     | munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = (munch_exp d e1) @ [X.ADDL(d, X.CONST n)]
-    | munch_exp d (T.BINOP(T.ADD, e1, e2)) = let val t1 = Temp.new () in (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ADDL(d, X.TEMP t1)] end
+    | munch_exp d (T.BINOP(T.ADD, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ADDL(d, X.TEMP t1)]
+        end
     | munch_exp d (T.BINOP(T.SUB, T.CONST 0w0, e1)) = (munch_exp d e1) @ [X.NEG d]
     | munch_exp d (T.BINOP(T.SUB, e1, T.CONST(n))) = (munch_exp d e1) @ [X.SUBL(d, X.CONST n)]
-    | munch_exp d (T.BINOP(T.SUB, e1, e2)) = let val t1 = Temp.new () in (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.SUBL(d, X.TEMP t1)] end
+    | munch_exp d (T.BINOP(T.SUB, e1, e2)) =
+        let val
+          t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.SUBL(d, X.TEMP t1)]
+        end
     | munch_exp d (T.BINOP(T.MUL, T.TEMP t, T.CONST n)) = [X.IMUL3(d, X.TEMP t, n)]
     | munch_exp d (T.BINOP(T.MUL, T.CONST n, T.TEMP t)) = [X.IMUL3(d, X.TEMP t, n)]
     | munch_exp d (T.BINOP(T.MUL, e1, T.CONST n)) = (munch_exp d e1) @ [X.IMUL(d, X.CONST n)]
     | munch_exp d (T.BINOP(T.MUL, T.CONST n, e1)) = (munch_exp d e1) @ [X.IMUL(d, X.CONST n)]
-    | munch_exp d (T.BINOP(T.MUL, e1, e2)) = let val t1 = Temp.new () in (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.IMUL(d, X.TEMP t1)] end
-    | munch_exp d (T.BINOP(T.DIV, e1, e2)) = let val t1 = Temp.new () in (munch_exp (X.TEMP t1) e1) @ (munch_exp d e2) @ [X.MOVL (X.REG X.EAX, X.TEMP t1), X.CLTD, X.IDIVL d, X.MOVL (d, X.REG X.EAX)] end
-    | munch_exp d (T.BINOP(T.MOD, e1, e2)) = let val t1 = Temp.new () in (munch_exp (X.TEMP t1) e1) @ (munch_exp d e2) @ [X.MOVL (X.REG X.EAX, X.TEMP t1), X.CLTD, X.IDIVL d, X.MOVL (d, X.REG X.EDX)] end
+    | munch_exp d (T.BINOP(T.MUL, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.IMUL(d, X.TEMP t1)]
+        end
+    | munch_exp d (T.BINOP(T.DIV, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp (X.TEMP t1) e1) @ (munch_exp d e2) @
+          [X.MOVL (X.REG X.EAX, X.TEMP t1), X.CLTD, X.IDIVL d, X.MOVL (d, X.REG X.EAX)]
+        end
+    | munch_exp d (T.BINOP(T.MOD, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp (X.TEMP t1) e1) @ (munch_exp d e2) @
+          [X.MOVL (X.REG X.EAX, X.TEMP t1), X.CLTD, X.IDIVL d, X.MOVL (d, X.REG X.EDX)]
+        end
+    | munch_exp d (T.BINOP(T.LSH, e1, T.CONST n)) = (munch_exp d e1) @ [X.SALL (d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.LSH, e1, e2)) =
+        let
+          val t1 = Temp.new()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.MOVL (X.REG X.ECX, X.TEMP t1), X.SALL (d, X.REG X.ECX)]
+        end
+    | munch_exp d (T.BINOP(T.RSH, e1, T.CONST n)) = (munch_exp d e1) @ [X.SARL (d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.RSH, e1, e2)) =
+        let
+          val t1 = Temp.new()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.MOVL (X.REG X.ECX, X.TEMP t1), X.SARL (d, X.REG X.ECX)]
+        end
+    | munch_exp d (T.BINOP(T.LOGOR, e1, e2)) =
+        let
+          val l1 = Label.new()
+        in
+          (munch_exp d e1) @ [X.CMPL (d, X.CONST(0w0)), X.JNE l1] @ (munch_exp d e2) @ [X.CMPL (d, X.CONST(0w0)), X.LABEL l1, X.SETNE d, X.MOVZBL(d,d)]
+        end
+    | munch_exp d (T.BINOP(T.LOGAND, e1, e2)) =
+        let
+          val l1 = Label.new()
+        in
+          (munch_exp d e1) @ [X.CMPL (d, X.CONST(0w0)), X.JE l1] @ (munch_exp d e2) @ [X.CMPL (d, X.CONST(0w0)), X.LABEL l1, X.SETNE d, X.MOVZBL(d,d)]
+        end
+    | munch_exp d (T.BINOP(T.BITAND, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ANDL(d, X.TEMP t1)]
+        end
+    | munch_exp d (T.BINOP(T.BITOR, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ORL(d, X.TEMP t1)]
+        end
+    | munch_exp d (T.BINOP(T.BITXOR, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.XORL(d, X.TEMP t1)]
+        end
+    | munch_exp d (T.BINOP(T.NEQ, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.CMPL(d, X.TEMP t1), X.SETNE(d), X.MOVZBL(d, d)]
+        end
+    | munch_exp d (T.BINOP(T.EQ, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.CMPL(d, X.TEMP t1), X.SETE(d), X.MOVZBL(d, d)]
+        end
+    | munch_exp d (T.BINOP(T.LE, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.CMPL(d, X.TEMP t1), X.SETLE(d), X.MOVZBL(d, d)]
+        end
+    | munch_exp d (T.BINOP(T.LT, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.CMPL(d, X.TEMP t1), X.SETL(d), X.MOVZBL(d, d)]
+        end
+    | munch_exp d (T.BINOP(T.GE, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.CMPL(d, X.TEMP t1), X.SETGE(d), X.MOVZBL(d, d)]
+        end
+    | munch_exp d (T.BINOP(T.GT, e1, e2)) =
+        let
+          val t1 = Temp.new ()
+        in
+          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
+          [X.CMPL(d, X.TEMP t1), X.SETG(d), X.MOVZBL(d, d)]
+        end
+    | munch_exp d (T.UNOP(T.NEG, e1)) = (munch_exp d e1) @ [X.NEG d]
+    | munch_exp d (T.UNOP(T.BITNOT, e1)) = (munch_exp d e1) @ [X.NOTL d]
+    | munch_exp d (T.UNOP(T.BANG, e1)) = (munch_exp d e1) @
+                                         [X.TEST(d,d), X.SETE(d), X.MOVZBL(d, d)]
 
-  (* munch_stm : T.stm -> AS.instr list *)
+  (* munch_stm : T.stm -> X.insn list *)
   (* munch_stm stm generates code to execute stm *)
   fun munch_stm (T.MOVE(T.TEMP(t1), e2)) =
-        munch_exp (X.TEMP t1) e2
+        let
+          val t = Temp.new ()
+        in
+          munch_exp (X.TEMP t) e2
+          @ [X.MOVL(X.TEMP t1, X.TEMP t)]
+        end
     | munch_stm (T.MOVE(_, _)) =
         raise ErrorMsg.InternalError "Incorrect first operand for T.MOVE?"
     | munch_stm (T.RETURN(e)) =
@@ -51,6 +172,15 @@ struct
           munch_exp (X.TEMP t) e
           @ [X.MOVL(X.REG X.EAX, X.TEMP t), X.RET]
         end
+    | munch_stm (T.LABEL(l)) = [X.LABEL l]
+    | munch_stm (T.JUMP(l)) = [X.JMP l]
+    | munch_stm (T.JUMPIFN(e, l)) =
+       let
+         val t = Temp.new ()
+       in
+         munch_exp (X.TEMP t) e
+         @ [X.TEST(X.TEMP t, X.TEMP t), X.JE l]
+       end
 
   fun codegen nil = nil
     | codegen (stm::stms) = munch_stm stm @ codegen stms
index e1c2bcd1045f73bf535bc30ae1a689a54039ba06..eeca849b5d10a68ef91e0079a374ba4545dffb8b 100644 (file)
@@ -1,21 +1,22 @@
-(* colorizer
- * Gathers tiberium, fires rockets
+(* L2 compiler
+ * colorizer
  * colors a graph and returns a list of nodes with associated colors
- * Author: Chris Lu <czl@andrew>
+ * Author: Joshua Wise <jwise@andrew.cmu.edu>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
  *)
 
 signature COLORIZER =
 sig
-  type tiberium = Temp.temp list
+  type temps = Temp.temp list
   type colorlist = (Temp.temp * int) list
   type igraph = (Temp.temp * x86.oper list) list
 
-  val colorize : tiberium -> igraph -> colorlist
+  val colorize : temps -> igraph -> colorlist
 end
 
 structure Colorizer :> COLORIZER =
 struct
-  type tiberium = Temp.temp list
+  type temps = Temp.temp list
   type colorlist = (Temp.temp * int) list
   type igraph = (Temp.temp * x86.oper list) list
   
@@ -58,6 +59,7 @@ struct
         @ (List.map
           (fn X.REG X.EAX => 0
             | X.REG X.EDX => 3
+            | X.REG X.ECX => 2
             | _ => raise ErrorMsg.InternalError "Bad kind of specreg")
           fixeds)
       (* Greedy-colorize -- pick the lowest number that isn't used by a neighbor *)
@@ -67,12 +69,12 @@ struct
           else i
       
       val newcolor = greedy 0 ints
-      val () = print ("  Assigned color "^(Int.toString newcolor)^" to temp "^(Temp.name temp)^"\n")
+      (* val () = print ("  Assigned color "^(Int.toString newcolor)^" to temp "^(Temp.name temp)^"\n") *)
     in
        (temp, (greedy 0 ints)) :: regs
     end
 
-  (* val colorize : tiberium -> igraph -> colorlist
+  (* val colorize : temps -> igraph -> colorlist
    * colorizes a graph given the graph representation and the order in which to color
    * nodes, returns a list of nodes numbered with their respective color *)
   fun colorize order graph = foldl (color_single graph) nil order
index 588086dd64b988082272ddc49b10c9f8d624c4a5..f533cead3e680c51c4a88d9e7f37b60f5097cba4 100644 (file)
@@ -1,15 +1,15 @@
-(* L1 Compiler
- * Gathers tiberium, fires rockets
+(* L2 Compiler
  * Takes a interference graph and generates an ordering for coloring
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
+ * Author: Chris Lu <czl@aundrew.cmu.edu>
  *)
 
 signature COLORORDER =
 sig
-  type tiberium = (Temp.temp * x86.oper list) list
-  type rockets = Temp.temp list
+  type igraph = (Temp.temp * x86.oper list) list
+  type ordering = Temp.temp list
   
-  val colororder : tiberium -> rockets
+  val colororder : igraph -> ordering
 end
 
 structure ColorOrder :> COLORORDER =
@@ -17,34 +17,26 @@ struct
   structure T = Temp
   structure X = x86
   
-  type tiberium = (Temp.temp * x86.oper list) list
-  type rockets = Temp.temp list
+  type igraph = (Temp.temp * x86.oper list) list
+  type ordering = Temp.temp list
   
-  fun colororder (graph : tiberium) : rockets =
+  fun colororder graph =
     let
-      val () = print ("Ordering colors...\n");
       val initialWeights = map (fn (t, _) => (t, 0)) graph
       
       fun sortWeights weights =        (* Sort the weights such that the largest is at left, ready to be grabbed. *)
         ListMergeSort.sort (fn ((_, a), (_, b)) => a < b) weights
-      
+
       (* Chooses one temporary to pick, and updates the weights. *)
       fun orderOne (weights : (Temp.temp * int) list) : Temp.temp * (Temp.temp * int) list =
         let
           val sorted = sortWeights weights
           val (chosen, w) = List.hd sorted     (* Grab the temp with the highest weight. *)
-          val () = print ("  Chose "^(Temp.name chosen)^" with weight "^(Int.toString w)^"\n");
           val remaining = List.tl sorted
-          val neighbors =      (* Grab all the neighbors for some given temp. *)
+          val neighbors =                      (* Grab all the neighbors for some given temp. *)
             List.hd
               (List.map (fn (_, neighbors) => neighbors)
                 (List.filter (fn (t, _) => T.compare (t, chosen) = EQUAL) graph))
-          val () = List.app
-                     (fn (X.TEMP t) => (print ("    Neighbor "^(Temp.name t)^"\n"))
-                       | (X.REG X.EAX) => (print "    Fixed color EAX\n")
-                       | (X.REG X.EDX) => (print "    Fixed color EDX\n")
-                       | _ => raise ErrorMsg.InternalError "Unknown neighbor type -- const?"
-                     ) neighbors;
           val newWeights =
             List.map
               (fn (t, wt) =>
index b11fd0d006c689bed2dd39101f8081d43882aef5..9fe50a00ff23ee8360a8b819c63b94d53fce0f2b 100644 (file)
@@ -1,37 +1,37 @@
-(* interference graph generator
- * Gathers tiberium, fires rockets
+(* L2 compiler
+ * interference graph generator
  * Takes a list of interfering temps and generates the interference graph
- * Author: Chris Lu <czl@andrew>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
  *)
 
 signature IGRAPH =
 sig
-  type tiberium = x86.oper list list
-  type rockets = (Temp.temp * x86.oper list) list
-  val gengraph : tiberium -> rockets
+  type interferences = x86.oper list list
+  type graph = (Temp.temp * x86.oper list) list
+  val gengraph : interferences -> graph
 end
 
 structure Igraph :> IGRAPH =
 struct
-  type tiberium = x86.oper list list
-  type rockets = (Temp.temp * x86.oper list) list
+  type interferences = x86.oper list list
+  type graph = (Temp.temp * x86.oper list) list
   structure X = x86
   
-  (* val canonicalize : rockets -> rockets
+  (* val canonicalize : graph -> graph
    * canonicalize a => puts a in the canonical form by eliminating repeat nodes and edges
    * does so by sorting them first, then eliminating consecutive temps
    *)
   fun canonicalize orig =
     let
       val sorig = ListMergeSort.sort (fn ((a,_),(b,_)) => X.cmpoper (a,b) = LESS) orig
-      fun merge ((x, xl)::(y, yl)::rl) = (case X.cmpoper (x,y) of EQUAL => merge ((x, xl @ yl)::rl) | _ => (x, xl) :: merge ((y, yl)::rl))
+      fun merge ((x, xl)::(y, yl)::rl) = (if X.opereq (x,y) then merge ((x, List.revAppend(yl,xl))::rl) else (x, xl) :: merge ((y, yl)::rl))
         | merge (a::nil) = [a]
         | merge nil = nil
       val ml = merge sorig
       fun uniq l =
         let
           val sl = ListMergeSort.sort (fn (a,b) => X.cmpoper (a,b) = LESS) l
-          fun merge' (x::y::rl) = (case X.cmpoper (x,y) of EQUAL => merge' (x::rl) | _ => x :: merge' (y::rl))
+          fun merge' (x::y::rl) = (if X.opereq (x,y) then merge' (x::rl) else x :: merge' (y::rl))
             | merge' (x::nil) = [x]
             | merge' nil = nil
         in
@@ -41,15 +41,15 @@ struct
       List.map (fn (a, x) => (a, uniq x)) ml
     end
 
-  (* val proc_one : Temp.temp list * rockets -> rockets
+  (* val proc_one : Temp.temp list * graph -> graph
    * helper function to convert a list of interfering registers to a graph
    *)
   fun proc_one x =
         List.map
-          (fn item1 => (item1, (List.filter (fn item2 => X.cmpoper(item1, item2) <> EQUAL) x)))
+          (fn item1 => (item1, (List.filter (fn item2 => not (X.opereq(item1, item2))) x)))
           x
 
-  (* val gengraph : tiberium -> rockets
+  (* val gengraph : interferences -> graph
    * generates the interference graph from a list of interfering temps
    * by creating separate interference graphs for each line, concatenating them,
    * and putting them in canonical form
@@ -62,7 +62,7 @@ struct
         (fn ((a,l),b) => case a
           of X.REG(_) => b
            | X.TEMP(t) => (t,l)::b 
-           | _ => raise ErrorMsg.InternalError "I'm a doooodyyyheaadddd"
+           | _ => raise ErrorMsg.InternalError "Non-live register type found in igraph"
         )
         nil
         igraph'
index 34f5d478aa90bfa50252b63820505f9e6dbdba12..95f1f90ce3b35f13ebcd217154ffc1825bf915f3 100644 (file)
-(* L1 Compiler
- * Gathers tiberium, fires rockets
+(* L2 Compiler
  * Turns pseudoasm into liveness-annotated pseudoasm
+ * Author: Chris Lu <czl@andrew.cmu.edu>
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  *)
 
 signature LIVENESS =
 sig
-  type tiberium = x86.insn list
-  type rockets = x86.oper list list
 
-  val liveness : tiberium -> rockets
+  type live = int * x86.oper list
+  type pseudoasm = x86.insn list
+  type livenesses = x86.oper list list
+
+  type ident = int
+  datatype pred = DEF of x86.oper | USE of x86.oper | SUCC of ident
+
+  val liveness : pseudoasm -> livenesses
+  val prettyprint : x86.oper list -> string
 end
 
 structure Liveness :> LIVENESS =
 struct
   structure T = Temp
   structure X = x86
-  
-  type tiberium = x86.insn list
-  type rockets = x86.oper list list
 
-  (* This does not 'follow the rules'.
+
+  type live = int * x86.oper list
+  type pseudoasm = X.insn list
+  type numasm = (int * X.insn) list
+  type livenesses = X.oper list list
+
+  type ident = int
+  datatype pred = DEF of X.oper | USE of X.oper | SUCC of ident
+
+  (* val number : pseudoasm -> numasm
+   * numbers the instructions!
+   *)
+
+  fun number instrs =
+    let
+      val nums = List.tabulate (List.length instrs, (fn i => i))
+    in
+      ListPair.zip (nums,instrs)
+    end
+
+  (* val defusesucc : numasm -> (ident * pred list) list
+   * generates def/use/succ predicates according to rules
+   *)
+
+  fun defusesucc l =
+    let
+      fun findlabel (lb) =
+            Option.valOf
+              (foldr (fn ((n, X.LABEL lb'), NONE) => if (Label.compare (lb, lb') = EQUAL) then SOME n else NONE
+                       | (_, old) => old) NONE l)
+      
+      (* val defhit/usehit : X.oper -> pred list
+       * helper functions to discard constant operands *)
+      fun defhit (a as X.CONST(_)) = nil
+        | defhit (a) = [DEF(a)]
+
+      fun usehit (a as X.CONST(_)) = nil
+        | usehit (a) = [USE(a)]
+
+      (* val gendef : ident * X.insn -> ident * pred list
+       * generates the def/use/succ predicates for a single insn
+       *)
+      fun gendef (n, X.DIRECTIVE(_))           = (n, nil)
+        | gendef (n, X.COMMENT(_))             = (n, nil)
+        | gendef (n, X.MOVL(dest, src))        = (n, defhit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.SUBL(dest, src))        = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.IMUL(dest, src))        = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.IMUL3(dest, src, _))    = (n, defhit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.ADDL(dest, src))        = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.IDIVL(src))             = (n, usehit src @ [DEF(X.REG(X.EAX)), DEF(X.REG(X.EDX)),
+                                                                   USE(X.REG(X.EAX)), USE(X.REG(X.EDX)),
+                                                                   SUCC(n+1)])
+        | gendef (n, X.CLTD)                   = (n, [USE(X.REG(X.EAX)), DEF(X.REG(X.EDX)), SUCC(n+1)])
+        | gendef (n, X.SALL(dest, shft))       = (n, defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)])
+        | gendef (n, X.SARL(dest, shft))       = (n, defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)])
+        | gendef (n, X.NEG(src))               = (n, defhit src @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.NOTL(src))              = (n, defhit src @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.ANDL(dest, src))        = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.ORL(dest, src))         = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.XORL(dest, src))        = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.CMPL(dest, src))        = (n, usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.TEST(dest, src))        = (n, usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.SETNE(dest))            = (n, defhit dest @ [SUCC(n+1)])
+        | gendef (n, X.SETE(dest))             = (n, defhit dest @ [SUCC(n+1)])
+        | gendef (n, X.SETLE(dest))            = (n, defhit dest @ [SUCC(n+1)])
+        | gendef (n, X.SETL(dest))             = (n, defhit dest @ [SUCC(n+1)])
+        | gendef (n, X.SETGE(dest))            = (n, defhit dest @ [SUCC(n+1)])
+        | gendef (n, X.SETG(dest))             = (n, defhit dest @ [SUCC(n+1)])
+        | gendef (n, X.MOVZBL(dest, src))      = (n, defhit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.RET)                    = (n, nil)
+        | gendef (n, X.LABEL l)                = (n, [SUCC (n+1)])
+        | gendef (n, X.JMP l)                  = (n, [SUCC (findlabel l)])
+        | gendef (n, X.JE l)                   = (n, [SUCC (n+1), SUCC (findlabel l)])
+        | gendef (n, X.JNE l)                  = (n, [SUCC (n+1), SUCC (findlabel l)])
+    in
+        List.map gendef l
+    end
+
+  (* val uselive : (ident * pred list) list -> live list
+   * generates liveness for 'use' rules to get the iterative analyzer started
+   *)
+  fun uselive preds =
+    List.map
+      (fn (n, l) => (n, List.foldr 
+        (fn (a,b) => case a of USE(x) => x::b | _ => b)
+        nil
+        l
+      )
+    )
+    preds
+
+  (* val subsetlive : (ident * pred list) * (ident * pred list) -> bool
+   * true if first is subset of second
+   *)
+
+  fun subsetlive (l1,l2) =
+    ListPair.all
+      (fn ((n1,a),(n2,b)) => (n1 = n2) andalso List.all
+        (fn x => List.exists (fn y => X.opereq (x,y)) b)
+        a
+      )
+      (l1,l2)
+
+  (* val liveiter : live list -> (ident * pred list) list -> live list
+   * iteratively generates livenesses from def/use/succ rules
+   * it must be fed a liveness list generated from the use rule as it only
+   * processes the second rule :
    *
-   * Since this is a straight line, we can just fold starting at the right,
-   * and accumulate variables.  Thus, the accumulator has two parts: one to
-   * represent all of the line / liveness pairs that we've accumulated so far;
-   * and one to represent what was live at the previous line.
+   *    use(l',x)
+   *   !def(l,x)
+   *   succ(l,l')
+   * --------------
+   *   live(l,x)
    *)
-  fun mashinstr ((instr : x86.insn), (curtemps, output) : x86.oper list * rockets) : x86.oper list * rockets =
+
+  fun liveiter l p =
     let
+      (* val succs : pred list -> l
+       * generates a list of lines that succeed a line given the predicates
+       * for that line
+       *)
+      fun succs (SUCC(a)::l) = a::(succs l)
+        | succs (_::l) = succs l
+        | succs nil = nil
+
+      (* val lives : ident list -> live list -> X.oper list
+       * scans l for live variables in succeeding lines *)
+      fun lives l' idents =
+        List.foldr
+          (fn ((_,a),b) => a @ b)
+          nil
+          (List.filter (fn (n,_) => List.exists (fn a => a = n) idents) l')
 
-      (* Removes an element from a list. *)
-      fun blast (X.TEMP(elt)) l =
-            List.filter (fn a => case a of X.TEMP(b) => (T.compare (b, elt)) <> EQUAL | _ => true) l
-        | blast (X.REG(reg)) l =
-            List.filter (fn a => case a of X.REG(b) => b <> reg | _ => true) l
-        | blast _ l = raise ErrorMsg.InternalError "Why have we declared a CONST as live?"
-
-      (* Adds an element to a list iff the element doesn't exist already. *)
-      fun addonce (X.CONST(_)) l = l
-        | addonce oper l = oper :: blast oper l
-
-      val newtemps =
-        case instr
-        of X.DIRECTIVE(_)           => curtemps
-         | X.COMMENT(_)             => curtemps
-         | X.MOVL(dest, src)        => addonce src (blast dest curtemps)
-         | X.SUBL(dest, src)        => addonce src (addonce dest curtemps)
-         | X.IMUL(dest, src)        => addonce src (addonce dest curtemps)
-         | X.IMUL3(dest, src, _)    => addonce src (blast dest curtemps)
-         | X.ADDL(dest, src)        => addonce src (addonce dest curtemps)
-         | X.LEAL(dest, src1, src2) => addonce src1 (addonce src2 (blast dest curtemps))
-         | X.IDIVL(src)             => addonce src (addonce (X.REG X.EAX) (addonce (X.REG X.EDX) curtemps))
-         | X.CLTD                   => blast (X.REG X.EDX) (addonce (X.REG X.EAX) curtemps)
-         | X.NEG(src)               => (* meh *) curtemps
-         | X.RET                    => addonce (X.REG X.EAX) curtemps
-(*         | _                        => raise ErrorMsg.InternalError "Unable to compute liveness for unused instruction form";*)
+      (* val isndef : X.oper -> pred list -> bool
+       * checks to see if x is defined in a predicate list *)
+      fun isndef x (DEF(y)::l) = not (X.opereq (x,y)) andalso isndef x l
+        | isndef x (a::l) = isndef x l
+        | isndef x nil = true
+
+      (* val addonce : X.oper list -> X.oper -> X.oper list
+       * eliminates duplicates, which speeds up compilation
+       *)
+      fun addonce l oper =
+        if (List.exists (fn x => X.opereq (x,oper)) l)
+        then l
+        else oper::l
+
+      (* val liveadd : live -> live list -> live list *)
+      fun liveadd (n,oper) lives = List.map
+        (fn (x,a) => if (x = n) then (x,addonce a oper) else (x,a))
+        lives
+
+      (* this does the dirty work!
+       * for each line, checks if the live variables in succeeding lines are
+       * not defined here; if so, it accumulates them onto the inital list
+       *
+       * changing the first foldr to a foldl slows down liveness by a factor
+       * of at least 100 on cedar-anastulate.l2
+       *)
+      val newl = List.foldr
+        (fn ((n, a), b) => List.foldr
+          (fn (a',b') => if (isndef a' a) then liveadd (n, a') b' else b')
+          b
+          (lives b (succs a))
+        )
+        l
+        p
     in
-      (newtemps, newtemps :: output)
+      if subsetlive (newl, l) then l else liveiter newl p
     end
-  
-  fun liveness (instrs : tiberium) : rockets =
+
+  (* val liveness : pseudoasm -> livenesses
+   * analyzes liveness of variables in the given pseudo-asm
+   *)
+
+  fun liveness instrs =
     let
-      val (_, livelist) = foldr mashinstr (nil, nil) instrs
+      val preds = defusesucc (number instrs)
+      val init = uselive preds
+      val (_,lives) = ListPair.unzip (liveiter init preds)
     in
-      livelist
+      lives
     end
+
+  fun prettyprint (a::l) = (X.prettyprint_oper a) ^ ", " ^ prettyprint l
+    | prettyprint nil = "-\n"
+
 end
index cdbba9c09c486165488b55618188d8fc7d20fc1e..7880a4532a5744d1c0f9a13fdcbb47cbacdcdb6b 100644 (file)
@@ -1,5 +1,5 @@
-(* peephole optimizer
- * Gathers tiberium, fires rockets
+(* L2 compiler
+ * peephole optimizer
  * optimizes away redundant insns such as:
      mov a, b
      mov a, b
      
      neg a
      neg a
- * Author: Chris Lu <czl@andrew>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
  *)
 
 signature PEEPHOLE =
 sig
-  type tiberium = x86.insn list
-  type rockets = x86.insn list
-  val peephole : tiberium -> rockets
+  val peephole : x86.insn list -> x86.insn list
 end
 
 structure Peephole :> PEEPHOLE =
 struct
-  type tiberium = x86.insn list
-  type rockets = x86.insn list
   structure X = x86
 
-  (* val peephole : tiberium -> rockets *)
+  (* val peephole : x86.insn list -> x86.insn list *)
 
   fun peephole ((insn1 as X.MOVL(a1,b1))::(insn2 as X.MOVL(a2,b2))::l) =
         if(x86.opereq(a1, b1) orelse (x86.opereq(a1, a2) andalso x86.opereq(b1, b2))) then
index 9d6269d996ae35e5547b9248bc5e96e2279c70c7..48fad3986f434dd5fe82ab1842cd11ef7ce8781a 100644 (file)
@@ -1,7 +1,7 @@
-(* L1 Compiler
- * Gathers tiberium, fires rockets
+(* L2 Compiler
  * Takes a list of mappings of temporaries to colors and a pseudoasm listing,
  * then produces x86 code.
+ * Author: Chris Lu <czl@andrew.cmu.edu>
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  *)
 
@@ -40,14 +40,10 @@ struct
       fun temptoreg (t: T.temp) : x86.reg =
         numtoreg (temptonum t)          
         handle Empty =>
-          (let
-            val () = print ("  Uncolored temp "^(Temp.name t)^" -- dead code?\n")
-          in
-            X.R15D (*If we don't care about the output, then it is cool to explode this; R15D is guaranteed not to be used across builtin blocks.*)
-          end)
+          (ErrorMsg.warn NONE ("Uncolored temp "^(Temp.name t)^" -- dead code?") ;
+            X.R15D) (*If we don't care about the output, then it is cool to explode this; R15D is guaranteed not to be used across builtin blocks.*)
       
       val spillreg1 = X.R14D
-      val spillreg2 = X.R15D
       
       val prologue = [X.DIRECTIVE "\tpush %rbx\n\tpush %r12\n\tpush %r13\n\tpush %r14\n\tpush %r15"]   (* Could be done better. *)
       val epilogue = [X.DIRECTIVE "\tpop %r15\n\tpop %r14\n\tpop %r13\n\tpop %r12\n\tpop %rbx"]
@@ -91,11 +87,9 @@ struct
                   realoper src handle Spilled => stackoper src)]
         | transform (X.SUBL (dest, src)) =
             unspill (src, spillreg1) @
-            unspill (dest, spillreg2) @
             [ X.SUBL(
-                realoper dest handle Spilled => X.REG spillreg2,
-                realoper src handle Spilled => X.REG spillreg1)] @
-            spill (dest, spillreg2)
+                realoper dest handle Spilled => stackoper dest,
+                realoper src handle Spilled => X.REG spillreg1)]
         | transform (X.IMUL (dest, src)) =
             unspill (dest, spillreg1) @
             [ X.IMUL(
@@ -119,18 +113,59 @@ struct
               [ X.ADDL(
                   realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
                   realoper src handle Spilled => stackoper src)]
-        | transform (X.LEAL (dest, src1, src2)) =
-            unspill (src1, spillreg1) @
-            unspill (src2, spillreg2) @
-            [ X.LEAL(
-                realoper dest handle Spilled => X.REG spillreg1,
-                realoper src1 handle Spilled => X.REG spillreg1,
-                realoper src2 handle Spilled => X.REG spillreg2)] @
-            spill (dest, spillreg1)
         | transform (X.IDIVL (src)) = [ X.IDIVL(realoper src handle Spilled => stackoper src)]
         | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
+        | transform (X.NOTL (src)) = [ X.NOTL(realoper src handle Spilled => stackoper src)]
+        | transform (X.SALL (dest, shft)) =
+            [ X.SALL (
+                realoper dest handle Spilled => stackoper dest,
+                shft)]
+        | transform (X.SARL (dest, shft)) =
+            [ X.SARL (
+                realoper dest handle Spilled => stackoper dest,
+                shft)]
         | transform (X.CLTD) = [ X.CLTD ]
+        | transform (X.ANDL (dest, src)) =
+            unspill (src, spillreg1) @
+            [ X.ANDL(
+                realoper dest handle Spilled => stackoper dest,
+                realoper src handle Spilled => X.REG spillreg1)]
+        | transform (X.ORL (dest, src)) =
+            unspill (src, spillreg1) @
+            [ X.ORL(
+                realoper dest handle Spilled => stackoper dest,
+                realoper src handle Spilled => X.REG spillreg1)]
+        | transform (X.XORL (dest, src)) =
+            unspill (src, spillreg1) @
+            [ X.XORL(
+                realoper dest handle Spilled => stackoper dest,
+                realoper src handle Spilled => X.REG spillreg1)]
+        | transform (X.CMPL (op1, op2)) =
+            unspill (op2, spillreg1) @
+            [ X.CMPL(
+                realoper op1 handle Spilled => stackoper op1,
+                realoper op2 handle Spilled => X.REG spillreg1)]
+        | transform (X.TEST (op1, op2)) =
+            unspill (op2, spillreg1) @
+            [ X.TEST(
+                realoper op1 handle Spilled => stackoper op1,
+                realoper op2 handle Spilled => X.REG spillreg1)]
+        | transform (X.SETNE (src)) = [ X.SETNE(realoper src handle Spilled => stackoper src)]
+        | transform (X.SETE (src)) = [ X.SETE(realoper src handle Spilled => stackoper src)]
+        | transform (X.SETLE (src)) = [ X.SETLE(realoper src handle Spilled => stackoper src)]
+        | transform (X.SETL (src)) = [ X.SETL(realoper src handle Spilled => stackoper src)]
+        | transform (X.SETGE (src)) = [ X.SETGE(realoper src handle Spilled => stackoper src)]
+        | transform (X.SETG (src)) = [ X.SETG(realoper src handle Spilled => stackoper src)]
+        | transform (X.MOVZBL (dest, src)) =
+            [ X.MOVZBL(
+                realoper dest handle Spilled => X.REG spillreg1,
+                realoper src handle Spilled => stackoper src)]
+            @ spill (dest, spillreg1)
         | transform (X.RET) = epilogue @ [X.RET]
+        | transform (X.LABEL l) = [ X.LABEL l ]
+        | transform (X.JMP l) = [ X.JMP l ]
+        | transform (X.JE l) = [ X.JE l]
+        | transform (X.JNE l) = [ X.JNE l]
 (*        | transform _ = raise ErrorMsg.InternalError ("Unimplemented transform")*)
     in
       List.concat (prologue :: (map transform instrs))
index 1f21babf2e793055386eb910a95693a40316ea5f..5cb2113e75072f683e95f1879ae50f9ea92b29e8 100644 (file)
@@ -1,39 +1,59 @@
-(* stringifier
- * Gathers tiberium, fires rockets
+(* L2 compiler
+ * stringifier
  * turns a list of x86 insns into the assembly code to generate them
- * Author: Chris Lu <czl@andrew>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
  *)
 
 signature STRINGIFY =
 sig
-  type tiberium = x86.insn list
-  type rockets = string
-  val stringify : tiberium -> rockets
+  type asm = x86.insn list
+  val stringify : asm -> string
 end
 
 structure Stringify :> STRINGIFY =
 struct
-  type tiberium = x86.insn list
-  type rockets = string
+  type asm = x86.insn list
   structure X = x86
 
-  (* val stringify : tiberium -> rockets
+  (* val stringify : asm -> string
    * turns a x86 instruction list into a string of assembly code for these instructions *)
 
-  fun stringify' (X.MOVL     (r1, r2))     = "\tmovl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.SUBL     (r1, r2))     = "\tsubl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.IMUL     (r1, r2))     = "\timul " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.IMUL3    (r1, r2, k))  = "\timul " ^ X.prettyprint_oper (X.CONST k) ^ ", " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.ADDL     (r1, r2))     = "\taddl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.LEAL     (r1, r2, r3)) = "\tleal (" ^ X.prettyprint_oper r2 ^ "," ^ X.prettyprint_oper r3 ^ "), " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.IDIVL    (r1))         = "\tidivl " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.NEG      (r1))         = "\tneg " ^ X.prettyprint_oper r1 ^ "\n"
-    | stringify' (X.RET)                   = "\tret\n"
-    | stringify' (X.CLTD)                  = "\tcltd\n"
-    | stringify' (X.DIRECTIVE(s))          = s ^ "\n"
-    | stringify' (X.COMMENT(s))            = "\t// " ^ s ^ "\n"
+  fun stringify' (X.MOVL   (r1, r2))          = "\tmovl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.SUBL   (r1, r2))          = "\tsubl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.IMUL   (r1, r2))          = "\timul " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.IMUL3  (r1, r2, k))       = "\timul " ^ X.prettyprint_oper (X.CONST k) ^ ", " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.ADDL   (r1, r2))          = "\taddl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.IDIVL  (r1))              = "\tidivl " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.NEG    (r1))              = "\tnegl " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.NOTL   (r1))              = "\tnotl " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.RET)                      = "\tret\n"
+    | stringify' (X.CLTD)                     = "\tcltd\n"
+    | stringify' (X.SALL   (r1, X.REG X.ECX)) = "\tsall %cl, " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.SALL   (r1, X.CONST k))   = "\tsall " ^ X.prettyprint_operb (X.CONST k) ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.SALL   _)                 = raise ErrorMsg.InternalError "Invalid operand generated for SALL"
+    | stringify' (X.SARL   (r1, X.REG X.ECX)) = "\tsarl %cl, " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.SARL   (r1, X.CONST k))   = "\tsarl " ^ X.prettyprint_operb (X.CONST k) ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.SARL   _)                 = raise ErrorMsg.InternalError "Invalid operand generated for SARL"
+    | stringify' (X.ANDL   (r1, r2))          = "\tandl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.ORL    (r1, r2))          = "\torl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.XORL   (r1, r2))          = "\txorl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.CMPL   (r1, r2))          = "\tcmpl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.TEST   (r1, r2))          = "\ttest " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.SETNE  (r1))              = "\tsetne " ^ X.prettyprint_operb r1 ^ "\n"
+    | stringify' (X.SETE   (r1))              = "\tsete " ^ X.prettyprint_operb r1 ^ "\n"
+    | stringify' (X.SETLE  (r1))              = "\tsetle " ^ X.prettyprint_operb r1 ^ "\n"
+    | stringify' (X.SETL   (r1))              = "\tsetl " ^ X.prettyprint_operb r1 ^ "\n"
+    | stringify' (X.SETGE  (r1))              = "\tsetge " ^ X.prettyprint_operb r1 ^ "\n"
+    | stringify' (X.SETG   (r1))              = "\tsetg " ^ X.prettyprint_operb r1 ^ "\n"
+    | stringify' (X.MOVZBL (r1, r2))          = "\tmovzbl " ^ X.prettyprint_operb r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
+    | stringify' (X.DIRECTIVE(s))             = s ^ "\n"
+    | stringify' (X.COMMENT(s))               = "\t// " ^ s ^ "\n"
+    | stringify' (X.LABEL  l)                 = Label.name l ^ ":\n"
+    | stringify' (X.JMP    l)                 = "\tjmp " ^ Label.name l ^ "\n"
+    | stringify' (X.JE     l)                 = "\tje " ^ Label.name l ^ "\n"
+    | stringify' (X.JNE    l)                 = "\tjne " ^ Label.name l ^ "\n"
 
-  (* val stringify : tiberium -> rockets *)
+  (* val stringify : asm -> string *)
   fun stringify l = foldr (fn (a,b) => (stringify' a) ^ b) ("") l
 
 end
index b7055f6f326189da2c4bf471beeb4ca3a7b02c14..33ddd60914bbe880e36904ace59226e6a7edf097 100644 (file)
@@ -1,28 +1,60 @@
+(* L2 compiler
+ * X86 instruction/operand internal representation and manipulation
+ * Author: Joshua Wise <jwise@andrew.cmu.edu>
+ * Author: Chris Lu <czl@andrew.cmu.edu>
+ *)
+
 signature X86 =
 sig
+  (* register type *)
   datatype reg =
     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
+  (* operands to instructions *)
   datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int)
+  (* instructions
+   * a better way to do SET would be SET of cc * oper,
+   * same with JMP
+   *)
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
+    LABEL of Label.label |
     MOVL of oper * oper |
     SUBL of oper * oper |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
     ADDL of oper * oper |
-    LEAL of oper * oper * oper |
     IDIVL of oper |
     NEG of oper |
+    NOTL of oper |
+    SALL of oper * oper |
+    SARL of oper * oper |
+    ANDL of oper * oper |
+    ORL of oper * oper |
+    XORL of oper * oper |
+    CMPL of oper * oper |
+    TEST of oper * oper |
+    SETNE of oper |
+    SETE of oper |
+    SETLE of oper |
+    SETL of oper |
+    SETGE of oper |
+    SETG of oper |
+    JMP of Label.label |
+    JE of Label.label |
+    JNE of Label.label |
+    MOVZBL of oper * oper |
     CLTD |
     RET
   
   val cmpoper : oper * oper -> order
   val opereq : oper * oper -> bool
   val regname : reg -> string
+  val regnameb : reg -> string
   val regtonum : reg -> int
   val numtoreg : int -> reg
   val prettyprint_oper : oper -> string
+  val prettyprint_operb : oper -> string
   val prettyprint : insn -> string
 end
 
@@ -34,17 +66,36 @@ struct
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
+    LABEL of Label.label |
     MOVL of oper * oper |
     SUBL of oper * oper |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
     ADDL of oper * oper |
-    LEAL of oper * oper * oper |
     IDIVL of oper |
     NEG of oper |
+    NOTL of oper |
+    SALL of oper * oper |
+    SARL of oper * oper |
+    ANDL of oper * oper |
+    ORL of oper * oper |
+    XORL of oper * oper |
+    CMPL of oper * oper |
+    TEST of oper * oper |
+    SETNE of oper |
+    SETE of oper |
+    SETLE of oper |
+    SETL of oper |
+    SETGE of oper |
+    SETG of oper |
+    JMP of Label.label |
+    JE of Label.label |
+    JNE of Label.label |
+    MOVZBL of oper * oper |
     CLTD |
     RET
-  
+
+  (* gives name of reg *)
   fun regname EAX = "eax"
     | regname EBX = "ebx"
     | regname ECX = "ecx"
@@ -61,7 +112,26 @@ struct
     | regname R13D = "r13d"
     | regname R14D = "r14d"
     | regname R15D = "r15d"
-  
+
+  (* like regname, but for the byte name *)
+  fun regnameb EAX = "al"
+    | regnameb EBX = "bl"
+    | regnameb ECX = "cl"
+    | regnameb EDX = "dl"
+    | regnameb ESI = "sil"
+    | regnameb EDI = "dil"
+    | regnameb EBP = "bpl"
+    | regnameb RSP = "spl"
+    | regnameb R8D = "r8b"
+    | regnameb R9D = "r9b"
+    | regnameb R10D = "r10b"
+    | regnameb R11D = "r11b"
+    | regnameb R12D = "r12b"
+    | regnameb R13D = "r13b"
+    | regnameb R14D = "r14b"
+    | regnameb R15D = "r15b"
+
+  (* gives number (color) associated with reg *)
   fun regtonum EAX = 0
     | regtonum EBX = 1
     | regtonum ECX = 2
@@ -78,7 +148,8 @@ struct
     | regtonum R15D = 13
     | regtonum EBP = 14                (* Dummy numbers -- not permitted for allocation, but there so that we can compare *)
     | regtonum RSP = 15
-  
+
+  (* gives reg associated with number (color) *)
   fun numtoreg 0 = EAX
     | numtoreg 1 = EBX
     | numtoreg 2 = ECX
@@ -94,9 +165,13 @@ struct
     | numtoreg 12 = R14D
     | numtoreg 13 = R15D
     | numtoreg n = raise ErrorMsg.InternalError ("numtoreg: Unknown register "^(Int.toString n))
-  
+
+  (* register compare *)
   fun regcmp (r1, r2) = Int.compare (regtonum r1, regtonum r2)
 
+  (* operand compare; arbitrary order imposed to make
+   * various things easier (e.g. liveness, for sorting)
+   *)
   fun cmpoper (REG(reg1), REG(reg2)) = regcmp (reg1, reg2)
     | cmpoper (TEMP(temp1), TEMP(temp2)) = Temp.compare (temp1,temp2)
     | cmpoper (CONST(const1), CONST(const2)) = Word32.compare (const1, const2)
@@ -112,28 +187,55 @@ struct
     | cmpoper (REG _, _) = LESS
     | cmpoper (REL _, _) = LESS
     | cmpoper (_, _) = GREATER
-  
+
   fun opereq (a, b) = cmpoper (a, b) = EQUAL
-  
+
+  (* integer tostring, except with more - and less ~ *)
   fun moreDifferentToString (i) =
        if (i >= 0) then Int.toString i
        else "-" ^ (Int.toString (~i))
-  
+
+  (* pretty prints an operand *)  
   fun prettyprint_oper (REG r) = "%" ^ (regname r)
     | prettyprint_oper (TEMP t) = Temp.name t
     | prettyprint_oper (CONST c) = "$0x" ^ (Word32.toString c)
     | prettyprint_oper (REL (r, i)) = (moreDifferentToString i) ^ "(%" ^ (regname r) ^ ")"
 
+  (* pretty prints an operand as a byte *)
+  fun prettyprint_operb (REG r) = "%" ^ (regnameb r)
+    | prettyprint_operb (TEMP t) = Temp.name t ^ "b"
+    | prettyprint_operb (CONST c) = "$0x" ^ (Word32.toString (c mod 0w32))
+    | prettyprint_operb x = prettyprint_oper x
+
+  (* pretty prints (no...) *)
   fun prettyprint (DIRECTIVE(str)) = str ^ "\n"
     | prettyprint (COMMENT(str)) = "// " ^ str ^ "\n"
+    | prettyprint (LABEL(l)) = Label.name l ^ "\n"
     | prettyprint (MOVL(src, dst)) = "\tMOVL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
     | prettyprint (SUBL(src, dst)) = "\tSUBL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
     | prettyprint (IMUL(src, dst)) = "\tIMUL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
     | prettyprint (IMUL3(dst, tmp, const)) = "\tIMUL\t" ^ (prettyprint_oper (CONST const)) ^ ", " ^ (prettyprint_oper tmp) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
     | prettyprint (ADDL(src, dst)) = "\tADDL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
-    | prettyprint (LEAL(src1, src2, dst)) = "\tLEAL\t(" ^ (prettyprint_oper src1) ^ "," ^ (prettyprint_oper src2) ^ ")," ^ (prettyprint_oper dst) ^ "\n"
     | prettyprint (IDIVL(src)) = "\tIDIVL\t" ^ (prettyprint_oper src) ^ "\n"
     | prettyprint (NEG (src)) = "\tNEG\t" ^ (prettyprint_oper src) ^ "\n"
+    | prettyprint (NOTL (src)) = "\tNOTL\t" ^ (prettyprint_oper src) ^ "\n"
+    | prettyprint (SALL (dst, shft)) = "\tSALL\t" ^ (prettyprint_oper dst) ^ ", " ^ (prettyprint_operb shft) ^ "\n"
+    | prettyprint (SARL (dst, shft)) = "\tSARL\t" ^ (prettyprint_oper dst) ^ ", " ^ (prettyprint_operb shft) ^ "\n"
+    | prettyprint (ANDL(src, dst)) = "\tANDL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
+    | prettyprint (ORL(src, dst)) = "\tORL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
+    | prettyprint (XORL(src, dst)) = "\tXORL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
+    | prettyprint (CMPL(src, dst)) = "\tCMPL\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
+    | prettyprint (TEST(src, dst)) = "\tTEST\t" ^ (prettyprint_oper src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
+    | prettyprint (SETNE(dst)) = "\tSETNE\t" ^ (prettyprint_operb dst) ^ "\n"
+    | prettyprint (SETE(dst)) = "\tSETE\t" ^ (prettyprint_operb dst) ^ "\n"
+    | prettyprint (SETLE(dst)) = "\tSETLE\t" ^ (prettyprint_operb dst) ^ "\n"
+    | prettyprint (SETL(dst)) = "\tSETL\t" ^ (prettyprint_operb dst) ^ "\n"
+    | prettyprint (SETGE(dst)) = "\tSETGE\t" ^ (prettyprint_operb dst) ^ "\n"
+    | prettyprint (SETG(dst)) = "\tSETG\t" ^ (prettyprint_operb dst) ^ "\n"
+    | prettyprint (JMP(label)) = "\tJMP\t" ^ (Label.name label) ^ "\n"
+    | prettyprint (JE(label)) = "\tJE\t" ^ (Label.name label) ^ "\n"
+    | prettyprint (JNE(label)) = "\tJNE\t" ^ (Label.name label) ^ "\n"
+    | prettyprint (MOVZBL(src, dst)) = "\tMOVZBL\t" ^ (prettyprint_operb src) ^ ", " ^ (prettyprint_oper dst) ^ "\n"
     | prettyprint (CLTD) = "\tCLTD\n"
     | prettyprint (RET) = "\tRET\n"
 (*    | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: unknown instruction")*)
similarity index 72%
rename from compile-l1c.sml
rename to compile-l2c.sml
index 35284dbd34babffec85dde77463de04ca655ed1f..651b99f45646fe62248f52e8755f9228f4cf9ca7 100644 (file)
@@ -4,4 +4,4 @@
  *)
 
 CM.make "sources.cm";
-SMLofNJ.exportFn ("bin/l1c.heap", Top.main);
+SMLofNJ.exportFn ("bin/l2c.heap", Top.main);
index bd121e1753f15c8bf1a82f08ea03e0dc8945d82f..ec538808be4c0eb5b40555154de402072cc8cba6 100644 (file)
@@ -1,7 +1,9 @@
-(* L1 Compiler
+(* L2 Compiler
  * Abstract Syntax Trees
  * Author: Alex Vaynberg
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
+ * Modified: Joshua Wise <jwise@andrew.cmu.edu>
+ * Modified: Chris Lu <czl@andrew.cmu.edu>
  *
  * Uses pretty printing library
  * structure PP  -- see util/pp.sml
@@ -18,15 +20,37 @@ sig
    | DIVIDEDBY
    | MODULO
    | NEGATIVE                  (* unary minus *)
+   | LSH
+   | RSH
+   | LOGOR
+   | LOGAND
+   | BITAND
+   | BITXOR
+   | BITOR
+   | BITNOT
+   | BANG                       (* logical not *)
+   | NEQ
+   | EQ
+   | LT
+   | LE
+   | GE
+   | GT
 
   datatype exp =
      Var of ident
    | ConstExp of Word32.word
    | OpExp of oper * exp list
-   | Marked of exp Mark.marked
+   | Marked of (* Kane *) exp Mark.marked
   and stm =
      Assign of ident * exp
    | Return of exp
+   | Nop
+   | Break
+   | Continue
+   | If of exp * stm list * stm list option
+   | For of stm option * exp * stm option * stm list
+   | While of exp * stm list
+   | MarkedStm of stm Mark.marked
 
   type program = stm list
 
@@ -51,6 +75,21 @@ struct
    | DIVIDEDBY
    | MODULO
    | NEGATIVE                  (* unary minus *)
+   | LSH
+   | RSH
+   | LOGOR
+   | LOGAND
+   | BITAND
+   | BITXOR
+   | BITOR
+   | BITNOT
+   | BANG
+   | NEQ
+   | EQ
+   | LT
+   | LE
+   | GE
+   | GT
 
   datatype exp =
      Var of ident
@@ -59,7 +98,14 @@ struct
    | Marked of exp Mark.marked
   and stm =
      Assign of ident * exp
-   | Return of exp  
+   | Return of exp
+   | Nop
+   | Break
+   | Continue
+   | If of exp * stm list * stm list option
+   | For of stm option * exp * stm option * stm list
+   | While of exp * stm list
+   | MarkedStm of stm Mark.marked
 
   type program = stm list
 
@@ -76,6 +122,21 @@ struct
       | pp_oper DIVIDEDBY = "/"
       | pp_oper MODULO = "%"
       | pp_oper NEGATIVE = "-"
+      | pp_oper LSH = "<<"
+      | pp_oper RSH = ">>"
+      | pp_oper LOGAND = "&&"
+      | pp_oper LOGOR = "||"
+      | pp_oper BITAND = "&"
+      | pp_oper BITXOR = "^"
+      | pp_oper BITOR = "|"
+      | pp_oper BITNOT = "~"
+      | pp_oper BANG = "!"
+      | pp_oper NEQ = "!="
+      | pp_oper EQ = "=="
+      | pp_oper LT = "<"
+      | pp_oper LE = "<="
+      | pp_oper GT = ">"
+      | pp_oper GE = ">="
 
     fun pp_exp (Var(id)) = pp_ident id
       | pp_exp (ConstExp(c)) = Word32Signed.toString c
@@ -84,6 +145,8 @@ struct
       | pp_exp (OpExp(oper, [e1,e2])) =
          "(" ^ pp_exp e1 ^ " " ^ pp_oper oper
          ^ " " ^ pp_exp e2 ^ ")"
+      | pp_exp (OpExp(oper, _)) =
+          pp_oper oper
       | pp_exp (Marked(marked_exp)) =
          pp_exp (Mark.data marked_exp)
 
@@ -91,6 +154,22 @@ struct
        pp_ident id ^ " = " ^ pp_exp e ^ ";"
       | pp_stm (Return e) =
          "return " ^ pp_exp e ^ ";"
+      | pp_stm Nop = ";"
+      | pp_stm Break = "break;"
+      | pp_stm Continue = "continue;"
+      | pp_stm (If (e, s, NONE)) = "if ("^pp_exp e^")"^pp_block s
+      | pp_stm (If (e, s, SOME s2)) = "if ("^pp_exp e^")"^pp_block s^" else "^pp_block s2
+      | pp_stm (While (e, s)) = "while ("^pp_exp e^") "^pp_block s
+      | pp_stm (For (so1, e, so2, s)) = "for ("^ (if (isSome so1) then pp_stm (valOf so1) else "") ^ pp_exp e ^ (if(isSome so2) then pp_stm (valOf so2) else "") ^ ")" ^ pp_block s
+      | pp_stm (MarkedStm m) = pp_stm (Mark.data m)
+
+    and pp_block (nil) = ";"
+      | pp_block (a::nil) = pp_stm a
+      | pp_block (l) = let
+          val contents = map pp_stm l
+        in
+          "{" ^ String.concat contents ^ "}"
+        end
 
     fun pp_stms nil = ""
       | pp_stms (s::ss) = pp_stm s ^ "\n" ^ pp_stms ss
diff --git a/parse/l1.grm b/parse/l1.grm
deleted file mode 100644 (file)
index 41af15b..0000000
+++ /dev/null
@@ -1,99 +0,0 @@
-(* L1 Compiler
- * L1 grammar
- * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
- * Modified: Frank Pfenning <fp@cs.cmu.edu>
- *)
-
-structure A = Ast
-
-(* for simplicity, we only mark expressions, not statements *)
-
-(* mark e with region (left, right) in source file *)
-fun mark (e, (left, right)) = A.Marked (Mark.mark' (e, ParseState.ext (left, right)))
-
-(* create lval from expression; here just an id *)
-(* generates error if not an identifier *)
-fun make_lval (A.Var(id)) ext = id
-  | make_lval (A.Marked(marked_exp)) ext =
-      make_lval (Mark.data marked_exp) (Mark.ext marked_exp)
-  | make_lval _ ext = ( ErrorMsg.error ext "not a variable" ;
-                       Symbol.bogus )
-
-(* expand_asnop (exp1, "op=", exp2) region = "exp1 = exp1 op exps"
- * or = "exp1 = exp2" if asnop is "="
- * generates error if exp1 is an lval (identifier)
- * syntactically expands a compound assignment operator
- *)
-fun expand_asnop (exp1, NONE, exp2) (left, right) =
-      A.Assign(make_lval exp1 NONE, exp2)
-  | expand_asnop (exp1, SOME(oper), exp2) (left, right) =
-      A.Assign(make_lval exp1 NONE,
-              mark(A.OpExp(oper, [exp1, exp2]), (left, right)))
-
-%%
-%header (functor L1LrValsFn (structure Token : TOKEN))
-
-%term 
-   EOF
- | SEMI
- | INTNUM of Word32.word
- | IDENT of Symbol.symbol
- | RETURN
- | PLUS | MINUS | STAR | SLASH | PERCENT
- | ASSIGN | PLUSEQ | MINUSEQ | STAREQ | SLASHEQ | PERCENTEQ
- | LBRACE | RBRACE
- | LPAREN | RPAREN
- | UNARY | ASNOP (* dummy *)
-
-%nonterm 
-   program of A.program
- | stms of A.stm list
- | stm of A.stm
- | simp of A.stm
- | return of A.stm
- | exp of A.exp
- | asnop of A.oper option
-
-%verbose                                (* print summary of errors *)
-%pos int                                (* positions *)
-%start program
-%eop EOF
-%noshift EOF
-
-%name L1
-
-%left PLUS MINUS
-%left STAR SLASH PERCENT
-%right UNARY
-%left LPAREN
-
-%%
-
-program    : LBRACE stms return RBRACE
-                                   (stms@[return])
-
-return     : RETURN exp SEMI       (A.Return exp)
-
-stms       :                       ([])
-           | stm stms              (stm :: stms)
-
-stm        : simp SEMI             (simp)
-simp       : exp asnop exp %prec ASNOP
-                                   (expand_asnop (exp1, asnop, exp2) (exp1left, exp2right))
-
-exp        : LPAREN exp RPAREN     (exp)
-           | INTNUM                (mark (A.ConstExp(INTNUM),(INTNUMleft,INTNUMright)))
-           | IDENT                 (mark (A.Var(IDENT), (IDENTleft,IDENTright)))
-           | exp PLUS exp          (mark (A.OpExp (A.PLUS, [exp1,exp2]), (exp1left,exp2right)))
-           | exp MINUS exp         (mark (A.OpExp (A.MINUS, [exp1,exp2]), (exp1left,exp2right)))
-           | exp STAR exp          (mark (A.OpExp (A.TIMES, [exp1,exp2]), (exp1left,exp2right)))
-           | exp SLASH exp         (mark (A.OpExp (A.DIVIDEDBY, [exp1,exp2]), (exp1left,exp2right)))
-           | exp PERCENT exp       (mark (A.OpExp (A.MODULO, [exp1,exp2]), (exp1left,exp2right)))
-           | MINUS exp %prec UNARY (mark (A.OpExp (A.NEGATIVE, [exp]), (MINUSleft,expright)))
-
-asnop      : ASSIGN                (NONE)
-           | PLUSEQ                (SOME(A.PLUS))
-           | MINUSEQ               (SOME(A.MINUS))
-           | STAREQ                (SOME(A.TIMES))
-           | SLASHEQ               (SOME(A.DIVIDEDBY))
-           | PERCENTEQ             (SOME(A.MODULO))
diff --git a/parse/l1.lex.sml b/parse/l1.lex.sml
deleted file mode 100644 (file)
index 70eb999..0000000
+++ /dev/null
@@ -1,581 +0,0 @@
-functor L1LexFn(structure Tokens : L1_TOKENS)=
-   struct
-    structure UserDeclarations =
-      struct
-(* L1 Compiler
- * Lexer
- * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
- * Modified: Frank Pfenning <fp@cs.cmu.edu>
- *)
-
-structure A = Ast
-structure S = Symbol
-
-type pos = int
-type svalue = Tokens.svalue
-type ('a,'b) token = ('a,'b) Tokens.token
-type lexresult = (svalue,pos) Tokens.token
-
-local
-  val commentLevel = ref 0
-  val commentPos = ref 0
-in
-  fun enterComment yypos =
-      ( commentLevel := !commentLevel + 1 ;
-       commentPos := yypos )
-    
-  fun exitComment () =
-      ( commentLevel := !commentLevel - 1 ;
-       !commentLevel = 0 )
-
-  fun number (yyt, yyp) =
-      let
-        val ext = ParseState.ext (yyp, yyp + size yyt)
-       val numOpt = Word32Signed.fromString yyt
-                     handle Overflow =>
-                           ( ErrorMsg.error ext
-                                ("integral constant `" ^ yyt ^ "' too large") ;
-                             NONE )
-      in
-       case numOpt
-         of NONE => ( ErrorMsg.error ext
-                         ("cannot parse integral constant `" ^ yyt ^ "'");
-                      Tokens.INTNUM (Word32Signed.ZERO, yyp, yyp + size yyt) )
-          | SOME n => Tokens.INTNUM (n,yyp,yyp + size yyt)
-      end
-
-  fun eof () = 
-      ( if (!commentLevel > 0)
-          then (ErrorMsg.error (ParseState.ext (!commentPos,!commentPos)) "unterminated comment")
-          else ();
-       Tokens.EOF (0,0) )              (* bogus position information; unused *)
-
-end
-
-end (* end of user routines *)
-exception LexError (* raised if illegal leaf action tried *)
-structure Internal =
-       struct
-
-datatype yyfinstate = N of int
-type statedata = {fin : yyfinstate list, trans: string}
-(* transition & final state table *)
-val tab = let
-val s = [ 
- (0, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (1, 
-"\007\007\007\007\007\007\007\007\007\038\040\007\038\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\038\007\007\037\007\035\007\007\034\033\030\028\007\026\007\022\
-\\020\020\020\020\020\020\020\020\020\020\007\019\007\018\007\007\
-\\007\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
-\\010\010\010\010\010\010\010\010\010\010\010\007\007\007\007\010\
-\\007\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\
-\\010\010\012\010\010\010\010\010\010\010\010\009\007\008\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\
-\\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007"
-),
- (3, 
-"\041\041\041\041\041\041\041\041\041\041\046\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\044\041\041\041\041\042\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\
-\\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041\041"
-),
- (5, 
-"\047\047\047\047\047\047\047\047\047\047\048\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\
-\\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047\047"
-),
- (10, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (12, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
-\\000\011\011\011\011\013\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (13, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\014\011\011\011\011\011\011\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (14, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\015\011\011\011\011\011\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (15, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\016\011\011\011\011\011\011\011\011\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (16, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\000\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\011\
-\\000\011\011\011\011\011\011\011\011\011\011\011\011\011\017\011\
-\\011\011\011\011\011\011\011\011\011\011\011\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (20, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\021\021\021\021\021\021\021\021\021\021\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (22, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\025\000\000\000\000\024\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\023\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (26, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\027\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (28, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\029\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (30, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\032\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\031\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (35, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (38, 
-"\000\000\000\000\000\000\000\000\000\039\000\000\039\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\039\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (42, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\043\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
- (44, 
-"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\045\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
-\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-),
-(0, "")]
-fun f x = x 
-val s = map f (rev (tl (rev s))) 
-exception LexHackingError 
-fun look ((j,x)::r, i: int) = if i = j then x else look(r, i) 
-  | look ([], i) = raise LexHackingError
-fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} 
-in Vector.fromList(map g 
-[{fin = [], trans = 0},
-{fin = [], trans = 1},
-{fin = [], trans = 1},
-{fin = [], trans = 3},
-{fin = [], trans = 3},
-{fin = [], trans = 5},
-{fin = [], trans = 5},
-{fin = [(N 67)], trans = 0},
-{fin = [(N 8),(N 67)], trans = 0},
-{fin = [(N 6),(N 67)], trans = 0},
-{fin = [(N 54),(N 67)], trans = 10},
-{fin = [(N 54)], trans = 10},
-{fin = [(N 54),(N 67)], trans = 12},
-{fin = [(N 54)], trans = 13},
-{fin = [(N 54)], trans = 14},
-{fin = [(N 54)], trans = 15},
-{fin = [(N 54)], trans = 16},
-{fin = [(N 48),(N 54)], trans = 10},
-{fin = [(N 16),(N 67)], trans = 0},
-{fin = [(N 14),(N 67)], trans = 0},
-{fin = [(N 51),(N 67)], trans = 20},
-{fin = [(N 51)], trans = 20},
-{fin = [(N 39),(N 67)], trans = 22},
-{fin = [(N 28)], trans = 0},
-{fin = [(N 63)], trans = 0},
-{fin = [(N 57)], trans = 0},
-{fin = [(N 35),(N 67)], trans = 26},
-{fin = [(N 22)], trans = 0},
-{fin = [(N 33),(N 67)], trans = 28},
-{fin = [(N 19)], trans = 0},
-{fin = [(N 37),(N 67)], trans = 30},
-{fin = [(N 25)], trans = 0},
-{fin = [(N 60)], trans = 0},
-{fin = [(N 12),(N 67)], trans = 0},
-{fin = [(N 10),(N 67)], trans = 0},
-{fin = [(N 41),(N 67)], trans = 35},
-{fin = [(N 31)], trans = 0},
-{fin = [(N 65),(N 67)], trans = 0},
-{fin = [(N 2),(N 67)], trans = 38},
-{fin = [(N 2)], trans = 38},
-{fin = [(N 4)], trans = 0},
-{fin = [(N 77)], trans = 0},
-{fin = [(N 77)], trans = 42},
-{fin = [(N 70)], trans = 0},
-{fin = [(N 77)], trans = 44},
-{fin = [(N 73)], trans = 0},
-{fin = [(N 75)], trans = 0},
-{fin = [(N 81)], trans = 0},
-{fin = [(N 79)], trans = 0}])
-end
-structure StartStates =
-       struct
-       datatype yystartstate = STARTSTATE of int
-
-(* start state definitions *)
-
-val COMMENT = STARTSTATE 3;
-val COMMENT_LINE = STARTSTATE 5;
-val INITIAL = STARTSTATE 1;
-
-end
-type result = UserDeclarations.lexresult
-       exception LexerError (* raised if illegal leaf action tried *)
-end
-
-fun makeLexer yyinput =
-let    val yygone0=1
-       val yyb = ref "\n"              (* buffer *)
-       val yybl = ref 1                (*buffer length *)
-       val yybufpos = ref 1            (* location of next character to use *)
-       val yygone = ref yygone0        (* position in file of beginning of buffer *)
-       val yydone = ref false          (* eof found yet? *)
-       val yybegin = ref 1             (*Current 'start state' for lexer *)
-
-       val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
-                yybegin := x
-
-fun lex () : Internal.result =
-let fun continue() = lex() in
-  let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
-       let fun action (i,nil) = raise LexError
-       | action (i,nil::l) = action (i-1,l)
-       | action (i,(node::acts)::l) =
-               case node of
-                   Internal.N yyk => 
-                       (let fun yymktext() = substring(!yyb,i0,i-i0)
-                            val yypos = i0+ !yygone
-                       open UserDeclarations Internal.StartStates
- in (yybufpos := i; case yyk of 
-
-                       (* Application actions *)
-
-  10 => let val yytext=yymktext() in Tokens.LPAREN (yypos, yypos + size yytext) end
-| 12 => let val yytext=yymktext() in Tokens.RPAREN (yypos, yypos + size yytext) end
-| 14 => let val yytext=yymktext() in Tokens.SEMI (yypos, yypos + size yytext) end
-| 16 => let val yytext=yymktext() in Tokens.ASSIGN (yypos, yypos + size yytext) end
-| 19 => let val yytext=yymktext() in Tokens.PLUSEQ (yypos, yypos + size yytext) end
-| 2 => (lex ())
-| 22 => let val yytext=yymktext() in Tokens.MINUSEQ (yypos, yypos + size yytext) end
-| 25 => let val yytext=yymktext() in Tokens.STAREQ (yypos, yypos + size yytext) end
-| 28 => let val yytext=yymktext() in Tokens.SLASHEQ (yypos, yypos + size yytext) end
-| 31 => let val yytext=yymktext() in Tokens.PERCENTEQ (yypos, yypos + size yytext) end
-| 33 => let val yytext=yymktext() in Tokens.PLUS (yypos, yypos + size yytext) end
-| 35 => let val yytext=yymktext() in Tokens.MINUS (yypos, yypos + size yytext) end
-| 37 => let val yytext=yymktext() in Tokens.STAR (yypos, yypos + size yytext) end
-| 39 => let val yytext=yymktext() in Tokens.SLASH (yypos, yypos + size yytext) end
-| 4 => (ParseState.newline(yypos); lex())
-| 41 => let val yytext=yymktext() in Tokens.PERCENT (yypos, yypos + size yytext) end
-| 48 => let val yytext=yymktext() in Tokens.RETURN (yypos, yypos + size yytext) end
-| 51 => let val yytext=yymktext() in number (yytext, yypos) end
-| 54 => let val yytext=yymktext() in let
-                            val id = Symbol.symbol yytext
-                          in 
-                            Tokens.IDENT (id, yypos, yypos + size yytext)
-                          end end
-| 57 => (YYBEGIN COMMENT; enterComment yypos; lex())
-| 6 => let val yytext=yymktext() in Tokens.LBRACE (yypos, yypos + size yytext) end
-| 60 => (ErrorMsg.error (ParseState.ext (yypos, yypos)) "unbalanced comments";
-                          lex())
-| 63 => (YYBEGIN COMMENT_LINE; lex())
-| 65 => (YYBEGIN COMMENT_LINE; lex())
-| 67 => let val yytext=yymktext() in ErrorMsg.error (ParseState.ext (yypos,yypos))
-                              ("illegal character: \"" ^ yytext ^ "\"");
-                          lex () end
-| 70 => (enterComment yypos; lex())
-| 73 => (if exitComment () then YYBEGIN INITIAL else (); lex())
-| 75 => (ParseState.newline yypos; lex ())
-| 77 => (lex())
-| 79 => (ParseState.newline yypos; YYBEGIN INITIAL; lex())
-| 8 => let val yytext=yymktext() in Tokens.RBRACE (yypos, yypos + size yytext) end
-| 81 => (lex())
-| _ => raise Internal.LexerError
-
-               ) end )
-
-       val {fin,trans} = Unsafe.Vector.sub(Internal.tab, s)
-       val NewAcceptingLeaves = fin::AcceptingLeaves
-       in if l = !yybl then
-            if trans = #trans(Vector.sub(Internal.tab,0))
-              then action(l,NewAcceptingLeaves
-) else     let val newchars= if !yydone then "" else yyinput 1024
-           in if (size newchars)=0
-                 then (yydone := true;
-                       if (l=i0) then UserDeclarations.eof ()
-                                 else action(l,NewAcceptingLeaves))
-                 else (if i0=l then yyb := newchars
-                    else yyb := substring(!yyb,i0,l-i0)^newchars;
-                    yygone := !yygone+i0;
-                    yybl := size (!yyb);
-                    scan (s,AcceptingLeaves,l-i0,0))
-           end
-         else let val NewChar = Char.ord(Unsafe.CharVector.sub(!yyb,l))
-               val NewState = Char.ord(Unsafe.CharVector.sub(trans,NewChar))
-               in if NewState=0 then action(l,NewAcceptingLeaves)
-               else scan(NewState,NewAcceptingLeaves,l+1,i0)
-       end
-       end
-(*
-       val start= if substring(!yyb,!yybufpos-1,1)="\n"
-then !yybegin+1 else !yybegin
-*)
-       in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
-    end
-end
-  in lex
-  end
-end
diff --git a/parse/l2.grm b/parse/l2.grm
new file mode 100644 (file)
index 0000000..6376e1c
--- /dev/null
@@ -0,0 +1,156 @@
+(* L2 Compiler
+ * L2 grammar
+ * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
+ * Modified: Frank Pfenning <fp@cs.cmu.edu>
+ * Modified: Joshua Wise <jwise@andrew.cmu.edu>
+ * Modified: Chris Lu <czl@andrew.cmu.edu>
+ *)
+
+structure A = Ast
+
+(* for simplicity, we only mark expressions, not statements *)
+
+(* mark e with region (left, right) in source file *)
+fun mark (e, (left, right)) = A.Marked (Mark.mark' (e, ParseState.ext (left, right)))
+fun markstm (e, (left, right)) = A.MarkedStm (Mark.mark' (e, ParseState.ext (left, right)))
+
+(* create lval from expression; here just an id *)
+(* generates error if not an identifier *)
+fun make_lval (A.Var(id)) ext = id
+  | make_lval (A.Marked(marked_exp)) ext =
+      make_lval (Mark.data marked_exp) (Mark.ext marked_exp)
+  | make_lval _ ext = ( ErrorMsg.error ext "not a variable" ;
+                       Symbol.bogus )
+
+(* expand_asnop (exp1, "op=", exp2) region = "exp1 = exp1 op exps"
+ * or = "exp1 = exp2" if asnop is "="
+ * generates error if exp1 is an lval (identifier)
+ * syntactically expands a compound assignment operator
+ *)
+fun expand_asnop (exp1, NONE, exp2) (left, right) =
+      A.Assign(make_lval exp1 NONE, exp2)
+  | expand_asnop (exp1, SOME(oper), exp2) (left, right) =
+      A.Assign(make_lval exp1 NONE,
+              mark(A.OpExp(oper, [exp1, exp2]), (left, right)))
+
+%%
+%header (functor L2LrValsFn (structure Token : TOKEN))
+
+%term 
+   EOF
+ | SEMI
+ | INTNUM of Word32.word
+ | IDENT of Symbol.symbol
+ | RETURN
+ | PLUS | MINUS | STAR | SLASH | PERCENT | LSH | RSH | LOGOR | LOGAND | BITAND | BITXOR | BITOR | BITNOT | BANG
+ | ASSIGN | PLUSEQ | MINUSEQ | STAREQ | SLASHEQ | PERCENTEQ | LSHEQ | RSHEQ | BITANDEQ | BITXOREQ | BITOREQ
+ | EQ | NEQ | LT | LE | GT | GE
+ | IF | ELSE | WHILE | FOR | CONTINUE | BREAK
+ | LBRACE | RBRACE
+ | LPAREN | RPAREN
+ | UNARY | ASNOP (* dummy *)
+
+%nonterm 
+   program of A.program
+ | stms of A.stm list
+ | stm of A.stm
+ | simp of A.stm
+ | return of A.stm
+ | exp of A.exp
+ | control of A.stm
+ | asnop of A.oper option
+ | block of A.stm list
+ | simpoption of A.stm option
+ | elseoption of A.stm list option
+
+%verbose                                (* print summary of errors *)
+%pos int                                (* positions *)
+%start program
+%eop EOF
+%noshift EOF
+
+%name L2
+
+%left LOGOR
+%left LOGAND
+%left BITOR
+%left BITXOR
+%left BITAND
+%left EQ NEQ
+%left LT LE GT GE
+%left LSH RSH
+%left PLUS MINUS
+%left STAR SLASH PERCENT
+%right UNARY
+%left LPAREN
+
+%%
+
+program    : LBRACE stms RBRACE
+                                    (stms)
+
+stms       :                        ([])
+           | stm stms               (stm :: stms)
+
+stm        : simp SEMI (simp)
+           | control (control)
+           | SEMI (A.Nop)
+
+simp       : exp asnop exp %prec ASNOP
+                                    (expand_asnop (exp1, asnop, exp2) (exp1left, exp2right))
+
+control    : IF LPAREN exp RPAREN block elseoption
+                                    (markstm ((A.If (exp, block, elseoption)), (IFleft, elseoptionright)))
+           | WHILE LPAREN exp RPAREN block
+                                    (markstm ((A.While (exp, block)), (WHILEleft, blockright)))
+           | FOR LPAREN simpoption SEMI exp SEMI simpoption RPAREN block
+                                    (markstm ((A.For (simpoption1, exp, simpoption2, block)), (FORleft, blockright)))
+           | CONTINUE SEMI          (markstm ((A.Continue), (CONTINUEleft, SEMIright)))
+           | BREAK SEMI             (markstm ((A.Break), (BREAKleft, SEMIright)))
+           | RETURN exp SEMI        (markstm ((A.Return exp), (RETURNleft, SEMIright)))
+
+elseoption : ELSE block             (SOME block)
+           |                        (NONE)
+
+simpoption :                        (NONE)
+           | simp                   (SOME simp)
+
+block      : stm                    ([stm])
+           | LBRACE stms RBRACE     (stms)
+
+exp        : LPAREN exp RPAREN      (exp)
+           | INTNUM                 (mark (A.ConstExp(INTNUM),(INTNUMleft,INTNUMright)))
+           | IDENT                  (mark (A.Var(IDENT), (IDENTleft,IDENTright)))
+           | exp PLUS exp           (mark (A.OpExp (A.PLUS, [exp1,exp2]), (exp1left,exp2right)))
+           | exp MINUS exp          (mark (A.OpExp (A.MINUS, [exp1,exp2]), (exp1left,exp2right)))
+           | exp STAR exp           (mark (A.OpExp (A.TIMES, [exp1,exp2]), (exp1left,exp2right)))
+           | exp SLASH exp          (mark (A.OpExp (A.DIVIDEDBY, [exp1,exp2]), (exp1left,exp2right)))
+           | exp PERCENT exp        (mark (A.OpExp (A.MODULO, [exp1,exp2]), (exp1left,exp2right)))
+           | exp LSH exp            (mark (A.OpExp (A.LSH, [exp1,exp2]), (exp1left,exp2right)))
+           | exp RSH exp            (mark (A.OpExp (A.RSH, [exp1,exp2]), (exp1left,exp2right)))
+           | exp LOGOR exp          (mark (A.OpExp (A.LOGOR, [exp1,exp2]), (exp1left,exp2right)))
+           | exp LOGAND exp         (mark (A.OpExp (A.LOGAND, [exp1,exp2]), (exp1left,exp2right)))
+           | exp BITOR exp          (mark (A.OpExp (A.BITOR, [exp1,exp2]), (exp1left,exp2right)))
+           | exp BITAND exp         (mark (A.OpExp (A.BITAND, [exp1,exp2]), (exp1left,exp2right)))
+           | exp BITXOR exp         (mark (A.OpExp (A.BITXOR, [exp1,exp2]), (exp1left,exp2right)))
+           | exp EQ exp             (mark (A.OpExp (A.EQ, [exp1,exp2]), (exp1left,exp2right)))
+           | exp NEQ exp            (mark (A.OpExp (A.NEQ, [exp1,exp2]), (exp1left,exp2right)))
+           | exp LT exp             (mark (A.OpExp (A.LT, [exp1,exp2]), (exp1left,exp2right)))
+           | exp LE exp             (mark (A.OpExp (A.LE, [exp1,exp2]), (exp1left,exp2right)))
+           | exp GT exp             (mark (A.OpExp (A.GT, [exp1,exp2]), (exp1left,exp2right)))
+           | exp GE exp             (mark (A.OpExp (A.GE, [exp1,exp2]), (exp1left,exp2right)))
+           | MINUS exp %prec UNARY  (mark (A.OpExp (A.NEGATIVE, [exp]), (MINUSleft,expright)))
+           | BITNOT exp %prec UNARY (mark (A.OpExp (A.BITNOT, [exp]), (BITNOTleft,expright)))
+           | BANG exp %prec UNARY   (mark (A.OpExp (A.BANG, [exp]), (BANGleft,expright)))
+
+asnop      : ASSIGN                (NONE)
+           | PLUSEQ                (SOME(A.PLUS))
+           | MINUSEQ               (SOME(A.MINUS))
+           | STAREQ                (SOME(A.TIMES))
+           | SLASHEQ               (SOME(A.DIVIDEDBY))
+           | PERCENTEQ             (SOME(A.MODULO))
+           | LSHEQ                 (SOME(A.LSH))
+           | RSHEQ                 (SOME(A.RSH))
+           | BITOREQ               (SOME(A.BITOR))
+           | BITANDEQ              (SOME(A.BITAND))
+           | BITXOREQ              (SOME(A.BITXOR))
similarity index 66%
rename from parse/l1.lex
rename to parse/l2.lex
index a80f9369e8809fe8412f79a1aefe9ea4284a2d64..9caa8e1a829e4fc91469f47a958c4002372af63a 100644 (file)
@@ -1,7 +1,9 @@
-(* L1 Compiler
+(* L2 Compiler
  * Lexer
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
+ * Modified: Chris Lu <czl@andrew.cmu.edu>
+ * Modified: Joshua Wise <jwise@andrew.cmu.edu>
  *)
 
 structure A = Ast
@@ -49,7 +51,7 @@ in
 end
 
 %%
-%header (functor L1LexFn(structure Tokens : L1_TOKENS));
+%header (functor L2LexFn(structure Tokens : L2_TOKENS));
 %full
 %s COMMENT COMMENT_LINE;
 
@@ -76,14 +78,40 @@ ws = [\ \t\012];
 <INITIAL> "*="        => (Tokens.STAREQ (yypos, yypos + size yytext));
 <INITIAL> "/="        => (Tokens.SLASHEQ (yypos, yypos + size yytext));
 <INITIAL> "%="        => (Tokens.PERCENTEQ (yypos, yypos + size yytext));
+<INITIAL> "<<="       => (Tokens.LSHEQ (yypos, yypos + size yytext));
+<INITIAL> ">>="       => (Tokens.RSHEQ (yypos, yypos + size yytext));
+<INITIAL> "&="        => (Tokens.BITANDEQ (yypos, yypos + size yytext));
+<INITIAL> "^="        => (Tokens.BITXOREQ (yypos, yypos + size yytext));
+<INITIAL> "|="        => (Tokens.BITOREQ (yypos, yypos + size yytext));
 
 <INITIAL> "+"         => (Tokens.PLUS (yypos, yypos + size yytext));
 <INITIAL> "-"         => (Tokens.MINUS (yypos, yypos + size yytext));
+<INITIAL> "!"         => (Tokens.BANG (yypos, yypos + size yytext));
 <INITIAL> "*"         => (Tokens.STAR (yypos, yypos + size yytext));
 <INITIAL> "/"         => (Tokens.SLASH (yypos, yypos + size yytext));
 <INITIAL> "%"         => (Tokens.PERCENT (yypos, yypos + size yytext));
+<INITIAL> "<<"        => (Tokens.LSH (yypos, yypos + size yytext));
+<INITIAL> ">>"        => (Tokens.RSH (yypos, yypos + size yytext));
+<INITIAL> "||"        => (Tokens.LOGOR (yypos, yypos + size yytext));
+<INITIAL> "&&"        => (Tokens.LOGAND (yypos, yypos + size yytext));
+<INITIAL> "&"         => (Tokens.BITAND (yypos, yypos + size yytext));
+<INITIAL> "^"         => (Tokens.BITXOR (yypos, yypos + size yytext));
+<INITIAL> "|"         => (Tokens.BITOR (yypos, yypos + size yytext));
+<INITIAL> "~"         => (Tokens.BITNOT (yypos, yypos + size yytext));
+<INITIAL> "=="        => (Tokens.EQ (yypos, yypos + size yytext));
+<INITIAL> "!="        => (Tokens.NEQ (yypos, yypos + size yytext));
+<INITIAL> "<"         => (Tokens.LT (yypos, yypos + size yytext));
+<INITIAL> "<="        => (Tokens.LE (yypos, yypos + size yytext));
+<INITIAL> ">="        => (Tokens.GE (yypos, yypos + size yytext));
+<INITIAL> ">"         => (Tokens.GT (yypos, yypos + size yytext));
 
 <INITIAL> "return"    => (Tokens.RETURN (yypos, yypos + size yytext));
+<INITIAL> "if"        => (Tokens.IF (yypos, yypos + size yytext));
+<INITIAL> "while"     => (Tokens.WHILE (yypos, yypos + size yytext));
+<INITIAL> "for"       => (Tokens.FOR (yypos, yypos + size yytext));
+<INITIAL> "continue"  => (Tokens.CONTINUE (yypos, yypos + size yytext));
+<INITIAL> "break"     => (Tokens.BREAK (yypos, yypos + size yytext));
+<INITIAL> "else"      => (Tokens.ELSE (yypos, yypos + size yytext));
 
 <INITIAL> {decnum}    => (number (yytext, yypos));
 
index 5981be1131aba92d1647216e40291925104a8609..1fc612f9727fba19963e2f91548cbb76a0cd9e0a 100644 (file)
@@ -17,10 +17,10 @@ end
 structure Parse :> PARSE =
 struct 
 
-  structure L1LrVals = L1LrValsFn (structure Token = LrParser.Token)
-  structure L1Lex = L1LexFn (structure Tokens = L1LrVals.Tokens)
-  structure L1Parse = Join (structure ParserData = L1LrVals.ParserData
-                            structure Lex = L1Lex
+  structure L2LrVals = L2LrValsFn (structure Token = LrParser.Token)
+  structure L2Lex = L2LexFn (structure Tokens = L2LrVals.Tokens)
+  structure L2Parse = Join (structure ParserData = L2LrVals.ParserData
+                            structure Lex = L2Lex
                             structure LrParser = LrParser)
 
   (* Main parsing function *)
@@ -31,17 +31,17 @@ struct
          val _ = ParseState.setfile filename (* start at position 0 in filename *)
          fun parseerror (s, p1, p2) = ErrorMsg.error (ParseState.ext (p1,p2)) s
          val lexer = LrParser.Stream.streamify
-                         (L1Lex.makeLexer (fn _ => TextIO.input instream))
+                         (L2Lex.makeLexer (fn _ => TextIO.input instream))
          (* 0 = no error correction, 15 = reasonable lookahead for correction *)
-         val (absyn, _) = L1Parse.parse(0, lexer, parseerror, ())
+         val (absyn, _) = L2Parse.parse(0, lexer, parseerror, ())
           val _ = if !ErrorMsg.anyErrors
                  then raise ErrorMsg.Error
                  else ()
        in
          absyn
        end)
-      handle L1Lex.LexError => ( ErrorMsg.error NONE "lexer error" ;
-                              raise ErrorMsg.Error )
+      handle Fail s => ( ErrorMsg.error NONE ("lexer error: "^s) ;
+                        raise ErrorMsg.Error )
           | LrParser.ParseError => raise ErrorMsg.Error (* always preceded by msg *)
            | e as IO.Io _ => ( ErrorMsg.error NONE (exnMessage e);
                                raise ErrorMsg.Error )
index 5ad3d61134951ada315d843246ce645c6053e438..fb9b604320e73f4902cb5b9ff55629cd78a23502 100644 (file)
@@ -12,18 +12,18 @@ Group is
 
        parse/ast.sml
        parse/parsestate.sml
-       parse/l1.lex
-       parse/l1.grm
+       parse/l2.lex
+       parse/l2.grm
        parse/parse.sml
 
        type/typechecker.sml
 
        trans/temp.sml
+        trans/label.sml
        trans/tree.sml
        trans/trans.sml
 
        codegen/x86.sml
-       codegen/liveness.sml
        codegen/igraph.sml
        codegen/colororder.sml
        codegen/solidify.sml
@@ -31,5 +31,6 @@ Group is
        codegen/stringifier.sml
        codegen/peephole.sml
        codegen/codegen.sml
+       codegen/liveness.sml
 
        top/top.sml
index cb409bf0c8377e1079da3a956d871accfd9ee7eb..35e03a68e287b9d92ec19dfa73066c2592df825a 100644 (file)
@@ -30,87 +30,93 @@ struct
 
   (* see flag explanations below *)
   val flag_verbose = Flag.flag "verbose"
+  val flag_liveness = Flag.flag "liveness"
   val flag_ast = Flag.flag "ast"
   val flag_ir = Flag.flag "ir"
   val flag_assem = Flag.flag "assem"
 
   fun reset_flags () =
       List.app Flag.unset [flag_verbose, flag_ast,
-                          flag_ir, flag_assem];
+                           flag_ir, flag_assem, flag_liveness];
 
   val options = [{short = "v", long=["verbose"], 
-                 desc=G.NoArg (fn () => Flag.set flag_verbose),
-                 help="verbose messages"},
-                {short = "", long=["dump-ast"],
-                 desc=G.NoArg (fn () => Flag.set flag_ast),
-                 help="pretty print the AST"},
-                {short = "", long=["dump-ir"],
-                 desc=G.NoArg (fn () => Flag.set flag_ir),
-                 help="pretty print the IR"},
-                {short = "", long=["dump-assem"],
-                 desc=G.NoArg (fn () => Flag.set flag_assem),
-                 help="pretty print the assembly before register allocaction"}
-               ]
+                  desc=G.NoArg (fn () => Flag.set flag_verbose),
+                  help="verbose messages"},
+                 {short = "a", long=["dump-ast"],
+                  desc=G.NoArg (fn () => Flag.set flag_ast),
+                  help="pretty print the AST"},
+                 {short = "i", long=["dump-ir"],
+                  desc=G.NoArg (fn () => Flag.set flag_ir),
+                  help="pretty print the IR"},
+                 {short = "l", long=["dump-liveness"],
+                  desc=G.NoArg (fn () => Flag.set flag_liveness),
+                  help="pretty print the liveness results"},
+                 {short = "s", long=["dump-assem"],
+                  desc=G.NoArg (fn () => Flag.set flag_assem),
+                  help="pretty print the assembly before register allocaction"}
+                ]
 
 
   fun stem s =
       let
-         val (prefix, suffix) =
-             Substring.splitr (fn c => c <> #".") (Substring.full s)
+          val (prefix, suffix) =
+              Substring.splitr (fn c => c <> #".") (Substring.full s)
       in
-         if Substring.isEmpty prefix (* no "." in string s *)
-            then s (* return whole string *)
-         else Substring.string (Substring.trimr 1 prefix)
+          if Substring.isEmpty prefix (* no "." in string s *)
+             then s (* return whole string *)
+          else Substring.string (Substring.trimr 1 prefix)
       end
 
   fun main (name, args) =
       let
-       val header = "Usage: compile [OPTION...] SOURCEFILE\nwhere OPTION is"
-       val usageinfo = G.usageInfo {header = header, options = options}
-       fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
-
-       val _ = Temp.reset (); (* reset temp variable counter *)
-       val _ = reset_flags (); (* return all flags to default value *)
-
-       val _ = if List.length args = 0 then
-                   (say usageinfo; raise EXIT)
-               else ()
-
-       val (opts, files) =
-           G.getOpt {argOrder = G.Permute,
-                     options = options,
-                     errFn = errfn}
-                    args
-
-       val source =
-           case files
-             of [] => errfn "Error: no input file"
-              | [filename] => filename
-              | _ => errfn "Error: more than one input file"
-
-       val _ = Flag.guard flag_verbose say ("Parsing... " ^ source)
-       val ast = Parse.parse source
-       val _ = Flag.guard flag_ast
-                 (fn () => say (Ast.Print.pp_program ast)) ()
-
-       val _ = Flag.guard flag_verbose say "Checking..."
-       val _ = TypeChecker.typecheck ast
-
-       val _ = Flag.guard flag_verbose say "Translating..."
-       val ir = Trans.translate ast
-       val _ = Flag.guard flag_ir (fn () => say (Tree.Print.pp_program ir)) ()
-
-       val _ = Flag.guard flag_verbose say "Generating proto-x86_64 code..."
-       val assem = Codegen.codegen ir
-       val _ = Flag.guard flag_assem
-                 (fn () => List.app (TextIO.print o x86.prettyprint) assem) ()
+        val header = "Usage: compile [OPTION...] SOURCEFILE\nwhere OPTION is"
+        val usageinfo = G.usageInfo {header = header, options = options}
+        fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
+
+        val _ = Temp.reset (); (* reset temp variable counter *)
+        val _ = reset_flags (); (* return all flags to default value *)
+
+        val _ = if List.length args = 0 then
+                    (say usageinfo; raise EXIT)
+                else ()
+
+        val (opts, files) =
+            G.getOpt {argOrder = G.Permute,
+                      options = options,
+                      errFn = errfn}
+                     args
+
+        val source =
+            case files
+              of [] => errfn "Error: no input file"
+               | [filename] => filename
+               | _ => errfn "Error: more than one input file"
+
+        val _ = Flag.guard flag_verbose say ("Parsing... " ^ source)
+        val ast = Parse.parse source
+        val _ = Flag.guard flag_ast
+                  (fn () => say (Ast.Print.pp_program ast)) ()
+
+        val _ = Flag.guard flag_verbose say "Checking..."
+        val ast = TypeChecker.typecheck ast
+
+        val _ = Flag.guard flag_verbose say "Translating..."
+        val ir = Trans.translate ast
+        val _ = Flag.guard flag_ir (fn () => say (Tree.Print.pp_program ir)) ()
+
+        val _ = Flag.guard flag_verbose say "Generating proto-x86_64 code..."
+        val assem = Codegen.codegen ir
+        val _ = Flag.guard flag_assem
+                  (fn () => List.app (TextIO.print o x86.prettyprint) assem) ()
 
         val _ = Flag.guard flag_verbose say "Analyzing liveness..."
         val liveness = Liveness.liveness assem;
-        
+        val _ = Flag.guard flag_liveness
+                  (fn () => List.app (TextIO.print o Liveness.prettyprint) liveness) ()
+
         val _ = Flag.guard flag_verbose say "Graphing..."
         val igraph = Igraph.gengraph liveness;
-        
+
         val _ = Flag.guard flag_verbose say "Ordering..."
         val order = ColorOrder.colororder igraph;
         
@@ -122,25 +128,25 @@ struct
 
         val _ = Flag.guard flag_verbose say "Peepholing..."
         val x86p = Peephole.peephole x86;
-        
+
         val _ = Flag.guard flag_verbose say "Stringifying..."
-       val x86d = [x86.DIRECTIVE(".file\t\"" ^ source ^ "\""),
-                    x86.DIRECTIVE(".globl _l1_main"),
-                   x86.DIRECTIVE("_l1_main:")]
-                   @ x86p
-                   @ [x86.DIRECTIVE ".ident\t\"15-411 L1 compiler v2 by czl@ and jwise@\""]
-       val code = Stringify.stringify x86d
-
-       val afname = stem source ^ ".s"
-       val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
-       val _ = SafeIO.withOpenOut afname (fn afstream =>
-                  TextIO.output (afstream, code))
+        val x86d = [x86.DIRECTIVE(".file\t\"" ^ source ^ "\""),
+                    x86.DIRECTIVE(".globl _l2_main"),
+                    x86.DIRECTIVE("_l2_main:")]
+                    @ x86p
+                    @ [x86.DIRECTIVE ".ident\t\"15-411 L2 compiler by czl@ and jwise@\""]
+        val code = Stringify.stringify x86d
+
+        val afname = stem source ^ ".s"
+        val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
+        val _ = SafeIO.withOpenOut afname (fn afstream =>
+                   TextIO.output (afstream, code))
       in
-         OS.Process.success
+          OS.Process.success
       end
       handle ErrorMsg.Error => ( say "Compilation failed" ; OS.Process.failure )
-          | EXIT => OS.Process.failure
-          | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure)
+           | EXIT => OS.Process.failure
+           | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure)
            | e => (say ("Unrecognized exception " ^ exnMessage e); OS.Process.failure)
 
   fun test s = main ("", String.tokens Char.isSpace s)
diff --git a/trans/label.sml b/trans/label.sml
new file mode 100644 (file)
index 0000000..76041f4
--- /dev/null
@@ -0,0 +1,32 @@
+(* L2 Compiler
+ * Labeloraries
+ * Like temporaries, except more different
+ * Author: Joshua Wise <jwise@cs.cmu.edu>
+ *)
+
+signature LABEL = 
+sig
+  type label
+
+  val reset : unit -> unit     (* resets label numbering *)
+  val new : unit -> label      (* returns a unique new label *)
+  val name : label -> string   (* returns the name of a label *)
+  val compare : label * label -> order (* comparison function *)
+end
+
+structure Label :> LABEL = 
+struct
+  type label = int
+
+  local
+    val counter = ref 1
+  in
+    (* warning: calling reset() may jeopardize uniqueness of labels! *)
+    fun reset () = ( counter := 1 )
+    fun new () = !counter before ( counter := !counter + 1 )
+  end
+
+  fun name t = ".L" ^ Int.toString t
+                     
+  fun compare (t1,t2) = Int.compare (t1,t2)
+end
index 3f6c806232a4ef5eb094d4e9438fcace997a656e..13411f1ab76e16c38a986059439f3a45802009a7 100644 (file)
@@ -1,4 +1,4 @@
-(* L1 Compiler
+(* L2 Compiler
  * Temporaries
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
index 8ddf780ced21da624791a539b8869cb9efa426bd..57e5faa390eb894a12f3514a25164f4b82d376ff 100644 (file)
@@ -1,8 +1,10 @@
-(* L1 Compiler
+(* L2 Compiler
  * AST -> IR Translator
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified by: Alex Vaynberg <alv@andrew.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
+ * Modified: Chris Lu <czl@andrew.cmu.edu>
+ * Modified: Joshua Wise <jwise@andrew.cmu.edu>
  *)
 
 signature TRANS =
@@ -16,13 +18,31 @@ struct
 
   structure A = Ast
   structure T = Tree
-
+  
   fun trans_oper A.PLUS = T.ADD
     | trans_oper A.MINUS = T.SUB
     | trans_oper A.TIMES = T.MUL
     | trans_oper A.DIVIDEDBY = T.DIV
     | trans_oper A.MODULO = T.MOD
-    | trans_oper A.NEGATIVE = T.SUB (* unary to binary! *)
+    | trans_oper A.LSH = T.LSH
+    | trans_oper A.RSH = T.RSH
+    | trans_oper A.LOGOR = T.LOGOR
+    | trans_oper A.LOGAND = T.LOGAND
+    | trans_oper A.BITOR = T.BITOR
+    | trans_oper A.BITXOR = T.BITXOR
+    | trans_oper A.BITAND = T.BITAND
+    | trans_oper A.NEQ = T.NEQ
+    | trans_oper A.EQ = T.EQ
+    | trans_oper A.LT = T.LT
+    | trans_oper A.LE = T.LE
+    | trans_oper A.GE = T.GE
+    | trans_oper A.GT = T.GT
+    | trans_oper _ = raise ErrorMsg.InternalError "expected AST binop, got AST unop"
+  
+  and trans_unop A.NEGATIVE = T.NEG
+    | trans_unop A.BITNOT = T.BITNOT
+    | trans_unop A.BANG = T.BANG
+    | trans_unop _ = raise ErrorMsg.InternalError "expected AST unop, got AST binop"
 
   and trans_exp env (A.Var(id)) =
       (* after type-checking, id must be declared; do not guard lookup *)
@@ -30,25 +50,109 @@ struct
     | trans_exp env (A.ConstExp c) = T.CONST(c)
     | trans_exp env (A.OpExp(oper, [e1, e2])) =
        T.BINOP(trans_oper oper, trans_exp env e1, trans_exp env e2)
-    | trans_exp env (A.OpExp(A.NEGATIVE, [e])) =
-       T.BINOP(trans_oper A.NEGATIVE, T.CONST(Word32Signed.ZERO), trans_exp env e)
+    | trans_exp env (A.OpExp(oper, [e])) =
+        T.UNOP(trans_unop oper, trans_exp env e)
+    | trans_exp env (A.OpExp(oper, _)) =
+        raise ErrorMsg.InternalError "expected one or two operands, got it in the oven"
     | trans_exp env (A.Marked(marked_exp)) =
        trans_exp env (Mark.data marked_exp)
     (* anything else should be impossible *)
 
-  (* translate the statement *)
-  (* trans_stms : Temp.temp Symbol.table -> A.stm list -> Tree.stm list *)
-  fun trans_stms env (A.Assign(id,e)::stms) =
-      let val t = Temp.new()
+  (* trans_stms : Temp.temp Symbol.table -> (Label.label * Label.label) option -> A.stm list -> (Tree.stm list * Symbol.table)
+   * translates a statement to the corresponding IR
+   * we pass around the environment and the current loop context, if any
+   * (usually called ls, which contains a continue label and a break label)
+   *)
+  fun trans_stms env ls (A.Assign(id,e)::stms) =
+      let val t = Symbol.look' env id handle Option => Temp.new()
          val env' = Symbol.bind env (id, t)
+         val (remainder, env') = trans_stms env' ls stms
       in
-         T.MOVE(T.TEMP(t), trans_exp env e)
-         :: trans_stms env' stms
+         (T.MOVE(T.TEMP(t), trans_exp env e)
+         :: remainder, env')
+      end
+    | trans_stms env ls (A.Return e::stms) =
+      let val (remainder, env') = trans_stms env ls stms
+      in 
+        (T.RETURN (trans_exp env e)
+        :: remainder, env')
       end
-    | trans_stms env (A.Return e::nil) =
-       (* after type-checking, return must be last statement *)
-        T.RETURN (trans_exp env e) :: nil
+        
+    | trans_stms env ls (A.If(e, s, NONE)::stms) =
+        let val l = Label.new ()
+            val (strans, env') = trans_stms env ls s
+            val (remainder, env') = trans_stms env' ls stms
+        in
+            (T.JUMPIFN(trans_exp env e, l)
+            :: strans
+            @ [T.LABEL (l)]
+            @ remainder, env')
+        end
+    | trans_stms env ls (A.If(e, s, SOME s2)::stms) =
+        let val l = Label.new ()
+            val l2 = Label.new ()
+            val (s1trans, env') = trans_stms env ls s
+            val (s2trans, env') = trans_stms env' ls s2
+            val (remainder, env') = trans_stms env' ls stms
+        in
+            (T.JUMPIFN(trans_exp env e, l)
+            :: s1trans
+            @ [T.JUMP (l2), T.LABEL (l)]
+            @ s2trans
+            @ [T.LABEL (l2)]
+            @ remainder, env')
+        end
+    | trans_stms env ls (A.For(s1, e, s2, s)::stms) = 
+        let
+          val head = Label.new ()
+          val tail = Label.new ()
+          val loop = Label.new ()
+          val (stm1, env') = if isSome s1 then trans_stms env NONE [valOf s1] else (nil, env)
+          val (strans, env') = trans_stms env' (SOME(loop,tail)) s
+          val (stm2, env') = if isSome s2 then trans_stms env' NONE [valOf s2] else (nil, env')
+          val (remainder, env') = trans_stms env' ls stms
+        in
+          (stm1
+          @ [T.LABEL head, T.JUMPIFN(trans_exp env' e, tail)]
+          @ strans
+          @ [T.LABEL loop]
+          @ stm2
+          @ [T.JUMP head, T.LABEL tail]
+          @ remainder, env')
+        end
+    | trans_stms env ls (A.While(e, s)::stms) =
+       let
+         val head = Label.new ()
+         val tail = Label.new ()
+         val (strans, env') = trans_stms env (SOME(head,tail)) s
+         val (remainder, env') = trans_stms env' ls stms
+       in
+         (T.LABEL head
+         :: T.JUMPIFN(trans_exp env e, tail)
+         :: strans
+         @ [T.JUMP head, T.LABEL tail]
+         @ remainder, env')
+       end
+
+    | trans_stms env (SOME(b,e)) (A.Break::stms) =
+        let
+          val (remainder, env') = trans_stms env (SOME(b,e)) stms
+        in
+          ((T.JUMP e) :: remainder, env')
+        end
+    | trans_stms env  NONE       (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker"
+    | trans_stms env (SOME(b,e)) (A.Continue::stms) =
+        let
+          val (remainder, env') = trans_stms env (SOME(b,e)) stms
+        in
+          ((T.JUMP b) :: remainder, env')
+        end
+    | trans_stms env  NONE       (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker"
+
+    | trans_stms env ls (A.Nop::stms) = trans_stms env ls stms
+    | trans_stms env ls (A.MarkedStm m :: stms) = trans_stms env ls ((Mark.data m) :: stms)
+    | trans_stms env _ nil = (nil, env)
 
-  fun translate p = trans_stms Symbol.empty p
+  fun translate p = let val (trans, _) = trans_stms Symbol.empty NONE p in trans end
 
 end
index 1cfc4eb7670904079027a932209cfd46fa628633..f69cefb8a4026964c6e02062b54212dcd93bb2ab 100644 (file)
@@ -1,4 +1,4 @@
-(* L1 Compiler
+(* L2 Compiler
  * IR Trees
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
@@ -8,15 +8,20 @@
 signature TREE =
 sig
 
-  datatype binop = ADD | SUB | MUL | DIV | MOD
+  datatype binop = ADD | SUB | MUL | DIV | MOD | LSH | RSH | LOGOR | LOGAND | BITOR | BITAND | BITXOR | NEQ | EQ | LT | GT | LE | GE
+  datatype unop = NEG | BITNOT | BANG
 
   datatype exp = 
       CONST of Word32.word
     | TEMP of Temp.temp
     | BINOP of binop * exp * exp
+    | UNOP of unop * exp
   and stm =
       MOVE of exp * exp
     | RETURN of exp
+    | LABEL of Label.label
+    | JUMPIFN of exp * Label.label
+    | JUMP of Label.label
 
   type program = stm list
 
@@ -31,15 +36,20 @@ end
 structure Tree :> TREE =
 struct
 
-  datatype binop = ADD | SUB | MUL | DIV | MOD
+  datatype binop = ADD | SUB | MUL | DIV | MOD | LSH | RSH | LOGOR | LOGAND | BITOR | BITAND | BITXOR | NEQ | EQ | LT | GT | LE | GE
+  datatype unop = NEG | BITNOT | BANG
 
   datatype exp = 
       CONST of Word32.word
     | TEMP of Temp.temp
     | BINOP of binop * exp * exp
+    | UNOP of unop * exp
   and stm =
       MOVE of exp * exp
     | RETURN of exp
+    | LABEL of Label.label
+    | JUMPIFN of exp * Label.label
+    | JUMP of Label.label
 
   type program = stm list
 
@@ -51,16 +61,41 @@ struct
       | pp_binop MUL = "*"
       | pp_binop DIV = "/"
       | pp_binop MOD = "%"
+      | pp_binop LSH = "<<"
+      | pp_binop RSH = ">>"
+      | pp_binop LOGOR = "||"
+      | pp_binop LOGAND = "&&"
+      | pp_binop BITOR = "|"
+      | pp_binop BITAND = "&"
+      | pp_binop BITXOR = "^"
+      | pp_binop NEQ = "!="
+      | pp_binop EQ = "=="
+      | pp_binop LE = "<="
+      | pp_binop LT = "<"
+      | pp_binop GE = ">="
+      | pp_binop GT = ">"
+    
+    fun pp_unop NEG = "-"
+      | pp_unop BITNOT = "~"
+      | pp_unop BANG = "!"
 
     fun pp_exp (CONST(x)) = Word32Signed.toString x
       | pp_exp (TEMP(t)) = Temp.name t
       | pp_exp (BINOP (binop, e1, e2)) =
          "(" ^ pp_exp e1 ^ " " ^ pp_binop binop ^ " " ^ pp_exp e2 ^ ")"
+      | pp_exp (UNOP (unop, e1)) =
+          pp_unop unop ^ "(" ^ pp_exp e1 ^ ")"
 
     fun pp_stm (MOVE (e1,e2)) =
          pp_exp e1 ^ "  <--  " ^ pp_exp e2
       | pp_stm (RETURN e) =
          "return " ^ pp_exp e
+      | pp_stm (LABEL l) =
+          Label.name l ^ ":"
+      | pp_stm (JUMP l) = 
+          "jump "^Label.name l
+      | pp_stm (JUMPIFN (e, l)) =
+          "jump "^Label.name l^" if! "^pp_exp e
 
     fun pp_program (nil) = ""
       | pp_program (stm::stms) = pp_stm stm ^ "\n" ^ pp_program stms
index 699d15ab97693516210ef7dce8aa30ec06c83f8f..32f80a16e40b9cddb7abae4e82ee4332b457719a 100644 (file)
 signature TYPE_CHECK =
 sig
   (* prints error message and raises ErrorMsg.error if error found *)
-  val typecheck : Ast.program -> unit
+  val typecheck : Ast.program -> Ast.program
 end;
 
 structure TypeChecker :> TYPE_CHECK = 
 struct
   structure A = Ast
 
-  (* tc_exp : unit Symbol.table -> Ast.exp -> Mark.ext option -> unit *)
-  fun tc_exp env (A.Var(id)) ext =
-      (case Symbol.look env id
-       of NONE => ( ErrorMsg.error ext ("undefined variable `" ^ Symbol.name id ^ "'") ;
-                    raise ErrorMsg.Error )
-         | SOME _ => ())
-    | tc_exp env (A.ConstExp(c)) ext = ()
-    | tc_exp env (A.OpExp(oper,es)) ext =
-      (* Note: it is syntactically impossible in this language to
-       * apply an operator to an incorrect number of arguments
-       * so we only check each of the arguments
-       *)
-       List.app (fn e => tc_exp env e ext) es
-    | tc_exp env (A.Marked(marked_exp)) ext =
-        tc_exp env (Mark.data marked_exp) (Mark.ext marked_exp)
-
-  (* tc_stms : unit Symbol.table -> Ast.program -> unit *)
-  fun tc_stms env nil = ()
-    | tc_stms env (A.Assign(id,e)::stms) =
-        ( tc_exp env e NONE ;
-         tc_stms (Symbol.bind env (id, ())) stms )
-    | tc_stms env (A.Return(e)::nil) =
-        tc_exp env e NONE
-    | tc_stms env (A.Return _ :: _) =
-        ( ErrorMsg.error NONE ("`return' not last statement") ;
-         raise ErrorMsg.Error )
-
-  fun typecheck prog = tc_stms Symbol.empty prog
+  fun returns nil = false
+    | returns (A.Assign _ :: stms) = returns stms
+    | returns (A.Return _ :: stms) = true
+    | returns (A.Nop :: stms) = returns stms
+    | returns (A.Break :: stms) = true (* blah *)
+    | returns (A.Continue :: stms) = true (* blah *)
+    | returns (A.If (_, s1, NONE) :: stms) = returns stms
+    | returns (A.If (_, s1, SOME s2) :: stms) = (returns s1 andalso returns s2) orelse returns stms
+    | returns (A.For _ :: stms) = returns stms
+    | returns (A.While _ :: stms) = returns stms
+    | returns (A.MarkedStm m :: stms) = returns (Mark.data m :: stms)
+  
+  fun breakcheck nil mark = ()
+    | breakcheck (A.Break :: stms) mark = ( ErrorMsg.error mark ("Illegal break outside loop") ;
+                                             raise ErrorMsg.Error )
+    | breakcheck (A.Continue :: stms) mark = ( ErrorMsg.error mark ("Illegal continue outside loop") ;
+                                                raise ErrorMsg.Error )
+    | breakcheck (A.If (_, s1, NONE) :: stms) mark =
+        ( breakcheck s1 mark;
+          breakcheck stms mark)
+    | breakcheck (A.If (_, s1, SOME s2) :: stms) mark =
+        ( breakcheck s1 mark;
+          breakcheck s2 mark;
+          breakcheck stms mark)
+    | breakcheck (A.MarkedStm m :: stms) mark = (breakcheck [(Mark.data m)] (Mark.ext m); breakcheck stms mark)
+    | breakcheck (_ :: stms) mark = breakcheck stms mark
+  
+  fun varcheck_exp env (A.Var v) mark =
+        ( case Symbol.look env v
+          of NONE => ( ErrorMsg.error mark ("undefined variable `" ^ Symbol.name v ^ "'") ;
+                       raise ErrorMsg.Error )
+           | SOME _ => ())
+    | varcheck_exp env (A.ConstExp _) mark = ()
+    | varcheck_exp env (A.OpExp (_, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l
+    | varcheck_exp env (A.Marked m) mark = varcheck_exp env (Mark.data m) (Mark.ext m)
+  
+  fun computeassigns env nil = env
+    | computeassigns env (A.Assign (id,e) :: stms) =
+        computeassigns (Symbol.bind env (id, ())) stms
+    | computeassigns env (A.Return _ :: stms) = env
+    | computeassigns env (A.Nop :: stms) = computeassigns env stms
+    | computeassigns env (A.Break :: stms) = env
+    | computeassigns env (A.Continue :: stms) = env
+    | computeassigns env (A.If (e, s1, NONE) :: stms) = computeassigns env stms
+    | computeassigns env (A.If (e, s1, SOME s2) :: stms) =
+        let
+          val env1 = computeassigns env s1
+          val env2 = computeassigns env s2
+          val env' = Symbol.intersect (env1, env2)
+          val env' =
+            if (returns s1) then env2
+            else if (returns s2) then env1
+            else env'
+        in
+          computeassigns env' stms
+        end
+    | computeassigns env (A.While (e, s1) :: stms) = computeassigns env stms
+    | computeassigns env (A.For (sbegin, e, sloop, inner) :: stms) =
+       let
+         val env' = case sbegin
+                    of SOME(s) => computeassigns env [s]
+                     | NONE => env
+       in
+         computeassigns env' stms
+       end
+    | computeassigns env (A.MarkedStm m :: stms) = computeassigns env ((Mark.data m) :: stms)
+  
+  fun varcheck env nil mark = nil
+    | varcheck env (A.Assign (id, e) :: stms) mark =
+        ( varcheck_exp env e mark ;
+          A.Assign (id, e) :: (varcheck (Symbol.bind env (id, ())) stms mark) )
+    | varcheck env (A.Return (e) :: stms) mark =
+        ( varcheck_exp env e mark;
+          A.Return (e) :: nil )
+    | varcheck env (A.Nop :: stms) mark =
+        ( A.Nop :: (varcheck env stms mark))
+    | varcheck env (A.Break :: stms) mark =
+        ( A.Break :: nil )
+    | varcheck env (A.Continue :: stms) mark =
+        ( A.Continue :: nil )
+    | varcheck env (A.If (e, s1, NONE) :: stms) mark =
+        ( varcheck_exp env e mark ;
+          varcheck env s1 mark ;
+          A.If (e, s1, NONE) :: (varcheck env stms mark) )
+    | varcheck env ((i as A.If (e, s1, SOME s2)) :: stms) mark =
+        ( varcheck_exp env e mark ;
+          varcheck env s1 mark ; 
+          varcheck env s2 mark ;
+          A.If (e, s1, SOME s2) ::
+            (if (returns [i])
+             then nil
+             else varcheck (computeassigns env [i]) stms mark)  )
+    | varcheck env (A.While (e, s1) :: stms) mark =
+        ( varcheck_exp env e mark ;
+          varcheck env s1 mark ;
+          A.While (e, s1) :: (varcheck env stms mark) )
+    | varcheck env (A.For (sbegin, e, sloop, inner) :: stms) mark =
+        let
+          val sbegin = case sbegin
+                       of SOME(s) => SOME (hd (varcheck env [s] mark))
+                        | NONE => NONE
+          val env' = case sbegin
+                     of SOME(s) => computeassigns env [s]
+                      | NONE => env
+          val _ = varcheck_exp env' e
+          val inner = varcheck env' inner mark
+          val env'' = computeassigns env' inner
+          val sloop = case sloop
+                  of SOME(s) => SOME (hd (varcheck env'' [s] mark))
+                   | NONE => NONE
+        in
+          A.For (sbegin, e, sloop, inner) :: (varcheck env' stms mark)
+        end
+    | varcheck env (A.MarkedStm m :: stms) mark = varcheck env ((Mark.data m) :: stms) (Mark.ext m)
 
+  fun typecheck prog =
+      ( breakcheck prog NONE ;
+        if not (returns prog)
+        then (ErrorMsg.error NONE ("program does not return in all cases"); raise ErrorMsg.Error)
+        else varcheck Symbol.empty prog NONE)
 end
index 590f9be1ce2c45ea7459943ce8ca823a8dcd9ad3..77878b47cf329ecbdd979de4be4e32db2dfec64a 100644 (file)
@@ -38,6 +38,7 @@ sig
   val elems : 'a table -> 'a list (* return all the data as a list *)
   val elemsi : 'a table -> (symbol * 'a) list (* return the symbols with the associated data *)
   val keys : 'a table -> symbol list (* just the symbols *)
+  val intersect : 'a table * 'a table -> 'a table
 
   (* symbol set -- similar to a () Symbol.table, elements can be removed *)
   type set
@@ -103,6 +104,7 @@ struct
   fun elems t = Map.listItems t
   fun elemsi t = Map.listItemsi t
   fun keys t = Map.listKeys t
+  fun intersect (t1,t2) = Map.intersectWith (fn (a,_) => a) (t1,t2)
 
   fun delimit' [] s = s
     | delimit' [x] s = s ^ x
This page took 0.127978 seconds and 4 git commands to generate.