Initial import of l3c

diff --git a/Makefile b/Makefile
index 8829383e8760975fc37c6ed9e5d112442d030309..88508a2cb4ec18fed6ed7ca0edb327040557f991 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,14 +1,24 @@
 # the following are SML-NJ specific defines
 SML = sml
 
 # the following are SML-NJ specific defines
 SML = sml
 

-l2c: FORCE
-       echo 'use "compile-l2c.sml";' | ${SML}
+l3c: FORCE
+       echo 'use "compile-l3c.sml";' | ${SML}
+
+l3c-mlton: FORCE
+       mllex parse/l3.lex
+       mlyacc parse/l3.grm
+       mlton -output bin/l3c-mlton sources.mlb
+       ${RM} parse/l3.lex.sml
+
+reallyclean: clean
+       ${RM} parse/*.lex.* parse/*.grm.*

 
 clean:
        find . -type d -name .cm | xargs rm -rf
 
 clean:
        find . -type d -name .cm | xargs rm -rf

-       ${RM} parse/*.lex.* parse/*.grm.*

        find . -type f | grep '~$$' | xargs ${RM}
        find . -type f | grep '~$$' | xargs ${RM}

-       ${RM} bin/l2c.heap.*
+       ${RM} bin/l3c.heap.*
+       ${RM} bin/l3c-mlton
+

 
 TAGS: clean
        ${RM} TAGS
 
 TAGS: clean
        ${RM} TAGS

diff --git a/README b/README
index 66a2e239e1769abfc350a7c1424d9808f9015427..4c6899bfe8efecada5501aa1411581720543f4be 100644 (file)
--- a/README
+++ b/README
@@ -1,69 +1,69 @@
 README
 ------
 
 README
 ------
 

-This compiler is a big long chain of modules that transform l2 code into
+This compiler is a big long chain of modules that transform l3 code into

 x86_64 assembly.
 
 x86_64 assembly.
 

-These modules include:
+Here is a breakdown of the modules and changes from l2:
+
+  * The parser.  The parser was mainly brought in from lab 2, and mainly
+    just a straight-forward extension of the l2 parser.  We added the
+    ability to parse functions, function calls, and variable declarations.
+
+  * The typechecker.  This module is mostly the same as that from l2. It
+    performs function-related typechecking as well now, such as ensuring
+    that the correct number of arguments is supplied in a function call,
+    that there are no multiple definitions of functions, and that there is a
+    main function that takes only one argument.
+
+  * The translator was extended with a CALL.
+
+  * The munch module was also extended with the ability to munch CALL; a
+    major improvement was made when we realized we could determine what
+    expressions had effects and what had fixed registers. Any expressions
+    that use no fixed registers and have no effects can be reordered during
+    evaluation of a function call's arguments. This enabled us to save a
+    bunch of register-register moves. Saving the caller save registers is
+    left to the liveness analyzer, which we believe results in substantially
+    better code than saving and restoring all caller saves.
+
+  * The liveness analyzer remains in more or less the same form, but with
+    substantial performance and cleanliness improvements by replacing lists
+    with maps (via BinaryMapFn) and sets (via ListSetFn). Also, a bug of
+    incredible type A was discovered through much pain and suffering, and
+    promptly fixed; it involved not realizing that a def on one line led to
+    an interference on any succeeding lines. Somehow we got away with this
+    for lab 2. Otherwise, we just explicitly state rules to generate
+    def/use/succ predicates which we then iterate over to find a fixed point
+    for livenesses using the standard rules.
+
+  * The grapher was changed to use the binary map and list set for
+    performance boosts (needed to pass certain large tests, like
+    pine-tree_print.l3). It generates an interference graph from a list of
+    livenesses at each source line.
+
+  * The color orderer had no changes.
+
+  * The coloring module was slightly updated to recognize more fixed-color
+    registers. It implements a greedy coloring algorithm.
+
+  * The solidifier was modified to change the callee save system. Now we
+    only save the registers we need to. This improvement was pushed by
+    excessively slow execution time on one of the tests.
+
+  * The peepholer is upgraded somewhat; it now eliminates more redundant
+    instructions (such as adding/subtracting 0).

 
 

-  * 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.
 
   * 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.
+  * Our internal representation of x86 assembly was changed. In particular,
+    conditional sets and jumps are now SETcc of cc * oper and Jcc of cc *
+    oper, instead of a separate SET or J for each condition code. This
+    simplifies other parts of the code as well.
+
+We believe that it is fully functional. We generate correct code whenever we
+are supposed to, and we pass every test that we can lay our hands on
+(including all of l2, and one of ours that killed the reference compiler).
+Of course, our last bug was caught by only one failing test, so...
\ No newline at end of file

diff --git a/bin/l2c b/bin/l2c
deleted file mode 100755 (executable)
index 4b7579c..0000000
--- a/bin/l2c
+++ /dev/null
@@ -1 +0,0 @@
-sml @SMLcmdname=$0 @SMLload=bin/l2c.heap.x86-linux $*

diff --git a/bin/l3c b/bin/l3c
new file mode 100755 (executable)
index 0000000..6350d67
--- /dev/null
+++ b/bin/l3c
@@ -0,0 +1 @@
+sml @SMLcmdname=$0 @SMLload=bin/l3c.heap.x86-linux $*

diff --git a/codegen/codegen.sml b/codegen/codegen.sml
index 9b99ef723ec9f60bc30aeb3279dd3655775373a8..8a5afe27965b552b3c6e7c4dcdc81abfe1f1a128 100644 (file)
--- a/codegen/codegen.sml
+++ b/codegen/codegen.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler

  * Assembly code generator for fake x86 assembly
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  * Author: Chris Lu <czl@andrew.cmu.edu>
  * Assembly code generator for fake x86 assembly
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  * Author: Chris Lu <czl@andrew.cmu.edu>


@@ -14,172 +14,421 @@ struct
   structure T = Tree
   structure X = x86
 
   structure T = Tree
   structure X = x86
 

+  (* effect : T.exp -> bool
+   * true iff the given expression has an effect.
+   *)
+  fun effect (T.BINOP(T.DIV, _, _)) = true
+    | effect (T.BINOP(T.MOD, _, _)) = true
+    | effect (T.CALL _) = true
+    | effect (T.BINOP(_, a, b)) = (effect a) orelse (effect b)
+    | effect (T.UNOP (_, a)) = effect a
+    | effect _ = false
+
+  (* hasfixed : T.exp -> bool
+   * true iff the given expression has an hasfixed. Somewhat like effect, hmm?
+   *)
+  fun hasfixed (T.BINOP(T.DIV, _, _)) = true
+    | hasfixed (T.BINOP(T.MOD, _, _)) = true
+    | hasfixed (T.BINOP(T.LSH, _, _)) = true
+    | hasfixed (T.BINOP(T.RSH, _, _)) = true
+    | hasfixed (T.CALL _) = true
+    | hasfixed (T.BINOP(_, a, b)) = (hasfixed a) orelse (hasfixed b)
+    | hasfixed (T.UNOP (_, a)) = hasfixed a
+    | hasfixed _ = false
+

   (* munch_exp : prex86oper -> T.exp -> prex86insn list *)
   (* munch_exp d e
    * generates instructions to achieve d <- e
    * d must be TEMP(t) or REG(r)
    *)
   (* munch_exp : prex86oper -> T.exp -> prex86insn list *)
   (* munch_exp d e
    * generates instructions to achieve d <- e
    * d must be TEMP(t) or REG(r)
    *)

-  fun munch_exp d (T.CONST(n)) = [X.MOVL(d, X.CONST n)]
-    | 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)]
+  fun munch_exp d (T.CONST(n)) = [X.MOV(d, X.CONST n)]
+    | munch_exp d (T.TEMP(t)) = [X.MOV(d, X.TEMP t)]
+    | munch_exp d (T.ARG(0)) = [X.MOV(d, X.REG X.EDI)]
+    | munch_exp d (T.ARG(1)) = [X.MOV(d, X.REG X.ESI)]
+    | munch_exp d (T.ARG(2)) = [X.MOV(d, X.REG X.EDX)]
+    | munch_exp d (T.ARG(3)) = [X.MOV(d, X.REG X.ECX)]
+    | munch_exp d (T.ARG(4)) = [X.MOV(d, X.REG X.R8D)]
+    | munch_exp d (T.ARG(5)) = [X.MOV(d, X.REG X.R9D)]
+    | munch_exp d (T.ARG(t)) = [X.MOV(d, X.STACKARG (t - 6))]
+    | munch_exp d (T.CALL(name, l)) =  (* Scary demons live here. *)
+        let
+          val nargs = length l
+          val nstack = if (nargs <= 6)
+                       then 0
+                       else nargs - 6
+          val stackb = nstack * 8
+          fun argdest 1 = X.REG X.EDI
+            | argdest 2 = X.REG X.ESI
+            | argdest 3 = X.REG X.EDX
+            | argdest 4 = X.REG X.ECX
+            | argdest 5 = X.REG X.R8D
+            | argdest 6 = X.REG X.R9D
+            | argdest n = X.REL (X.RSP, (~(stackb - 8 * (n - 7))))
+
+          val dests = List.tabulate (nargs, fn x => argdest (x+1))
+          val hf = List.map hasfixed l
+          val (d_hf, exps_hf) = ListPair.unzip (ListPair.foldr
+            (fn (a,b,c) => if b then a::c else c)
+            nil
+            (ListPair.zip (dests,l), hf)
+          )
+          val (d_nohf, exps_nohf) = ListPair.unzip (ListPair.foldr
+            (fn (a,b,c) => if b then c else a::c)
+            nil
+            (ListPair.zip (dests,l), hf)
+          )
+          val temps = List.tabulate (List.length d_hf, fn x => Temp.new(Int.toString x ^ " arg"))
+          val argevals_hf = List.map
+            (fn (t,exp) => munch_exp (X.TEMP t) exp)
+            (ListPair.zip (temps, exps_hf))
+          val argpushes = List.map
+            (fn (dest, t) => [(X.MOV (dest, X.TEMP t))])
+            (ListPair.zip (d_hf, temps))
+          val argevals_nohf = List.map
+            (fn (d,exp) => munch_exp d exp)
+            (ListPair.zip (d_nohf, exps_nohf))
+        in
+          List.concat argevals_hf @ 
+          List.concat argpushes @
+          List.concat argevals_nohf @
+          [ X.SIZE (X.Qword, X.SUB (X.REG X.RSP, X.CONST (Word32.fromInt stackb))),
+            X.CALL (name, nargs),
+            X.SIZE (X.Qword, X.ADD (X.REG X.RSP, X.CONST (Word32.fromInt stackb))),
+            X.MOV (d, X.REG X.EAX) ]   (* Finally! *)
+        end
+    | munch_exp d (T.BINOP(T.ADD, e1, T.CONST 0w0)) = munch_exp d e1
+    | munch_exp d (T.BINOP(T.ADD, T.CONST 0w0, e1)) = munch_exp d e1
+    | munch_exp d (T.BINOP(T.ADD, e1, T.CONST n)) = (munch_exp d e1) @ [X.ADD(d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.ADD, T.CONST n, e1)) = (munch_exp d e1) @ [X.ADD(d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.ADD, e1, T.TEMP t)) = (munch_exp d e1) @ [X.ADD(d, X.TEMP t)]
+    | munch_exp d (T.BINOP(T.ADD, T.TEMP t, e2)) = (munch_exp d e2) @ [X.ADD(d, X.TEMP t)]

     | munch_exp d (T.BINOP(T.ADD, e1, e2)) =
         let
     | munch_exp d (T.BINOP(T.ADD, e1, e2)) =
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("add"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ADDL(d, X.TEMP t1)]
+          (munch_exp d e1) @ (munch_exp t1 e2) @ [X.ADD(d, t1)]

         end
     | munch_exp d (T.BINOP(T.SUB, T.CONST 0w0, e1)) = (munch_exp d e1) @ [X.NEG d]
         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, T.CONST 0w0)) = munch_exp d e1
+    | munch_exp d (T.BINOP(T.SUB, e1, T.CONST(n))) = (munch_exp d e1) @ [X.SUB(d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.SUB, e1, T.TEMP t)) = (munch_exp d e1) @ [X.SUB(d, X.TEMP t)]

     | munch_exp d (T.BINOP(T.SUB, e1, e2)) =
     | munch_exp d (T.BINOP(T.SUB, e1, e2)) =

-        let val
-          t1 = Temp.new ()
+        let
+          val t1 = X.TEMP (Temp.new ("sub"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.SUBL(d, X.TEMP t1)]
+          (munch_exp d e1) @ (munch_exp t1 e2) @ [X.SUB(d, 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)]
         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 0w1)) = munch_exp d e1
+    | munch_exp d (T.BINOP(T.MUL, T.CONST 0w1, e1)) = munch_exp d e1

     | 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
     | 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 ()
+          val t1 = X.TEMP (Temp.new ("mul"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.IMUL(d, X.TEMP t1)]
+          (munch_exp d e1) @ (munch_exp t1 e2) @ [X.IMUL(d, t1)]

         end
     | munch_exp d (T.BINOP(T.DIV, e1, e2)) =
         let
         end
     | munch_exp d (T.BINOP(T.DIV, e1, e2)) =
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("div"))

         in
         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)]
+          (munch_exp t1 e1) @ (munch_exp d e2) @
+          [X.MOV (X.REG X.EAX, t1), X.CLTD, X.IDIV d, X.MOV (d, X.REG X.EAX)]

         end
     | munch_exp d (T.BINOP(T.MOD, e1, e2)) =
         let
         end
     | munch_exp d (T.BINOP(T.MOD, e1, e2)) =
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("mod"))

         in
         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)]
+          (munch_exp t1 e1) @ (munch_exp d e2) @
+          [X.MOV (X.REG X.EAX, t1), X.CLTD, X.IDIV d, X.MOV (d, X.REG X.EDX)]

         end
         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, T.CONST n)) = (munch_exp d e1) @ [X.SAL (d, X.CONST (n mod 0w32))]
+    | munch_exp d (T.BINOP(T.LSH, e1, T.TEMP t)) = (munch_exp d e1) @ [X.MOV (X.REG X.ECX, X.TEMP t), X.SAL (d, X.REG X.ECX)]

     | munch_exp d (T.BINOP(T.LSH, e1, e2)) =
         let
     | munch_exp d (T.BINOP(T.LSH, e1, e2)) =
         let

-          val t1 = Temp.new()
+          val t = X.TEMP (Temp.new ("lsh"))

         in
         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)]
+          (munch_exp d e1) @ (munch_exp t e2) @ [X.MOV (X.REG X.ECX, t), X.SAL (d, X.REG X.ECX)]

         end
         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, T.CONST n)) = (munch_exp d e1) @ [X.SAR (d, X.CONST (n mod 0w32))]
+    | munch_exp d (T.BINOP(T.RSH, e1, T.TEMP t)) = (munch_exp d e1) @ [X.MOV (X.REG X.ECX, X.TEMP t), X.SAR (d, X.REG X.ECX)]

     | munch_exp d (T.BINOP(T.RSH, e1, e2)) =
         let
     | munch_exp d (T.BINOP(T.RSH, e1, e2)) =
         let

-          val t1 = Temp.new()
+          val t = X.TEMP (Temp.new ("rsh"))

         in
         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)]
+          (munch_exp d e1) @ (munch_exp t e2) @ [X.MOV (X.REG X.ECX, t), X.SAR (d, X.REG X.ECX)]

         end
         end

-    | munch_exp d (T.BINOP(T.LOGOR, e1, e2)) =
+    | munch_exp d (T.BINOP(T.BITAND, T.CONST n, e1)) = (munch_exp d e1) @ [X.AND (d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.BITAND, e1, T.CONST n)) = (munch_exp d e1) @ [X.AND (d, X.CONST n)] 
+    | munch_exp d (T.BINOP(T.BITAND, T.TEMP t, e1)) = (munch_exp d e1) @ [X.AND (d, X.TEMP t)]
+    | munch_exp d (T.BINOP(T.BITAND, e1, T.TEMP t)) = (munch_exp d e1) @ [X.AND (d, X.TEMP t)] 
+    | munch_exp d (T.BINOP(T.BITAND, e1, e2)) =

         let
         let

-          val l1 = Label.new()
+          val t1 = X.TEMP (Temp.new ("bitand"))

         in
         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)]
+          (munch_exp d e1) @ (munch_exp t1 e2) @ [X.AND(d, t1)]

         end
         end

-    | munch_exp d (T.BINOP(T.LOGAND, e1, e2)) =
+    | munch_exp d (T.BINOP(T.BITOR, T.CONST n, e1)) = (munch_exp d e1) @ [X.OR (d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.BITOR, e1, T.CONST n)) = (munch_exp d e1) @ [X.OR (d, X.CONST n)] 
+    | munch_exp d (T.BINOP(T.BITOR, T.TEMP t, e1)) = (munch_exp d e1) @ [X.OR (d, X.TEMP t)]
+    | munch_exp d (T.BINOP(T.BITOR, e1, T.TEMP t)) = (munch_exp d e1) @ [X.OR (d, X.TEMP t)] 
+    | munch_exp d (T.BINOP(T.BITOR, e1, e2)) =

         let
         let

-          val l1 = Label.new()
+          val t1 = X.TEMP (Temp.new ("bitor"))

         in
         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)]
+          (munch_exp d e1) @ (munch_exp t1 e2) @ [X.OR(d, t1)]

         end
         end

-    | munch_exp d (T.BINOP(T.BITAND, e1, e2)) =
+    | munch_exp d (T.BINOP(T.BITXOR, T.CONST n, e1)) = (munch_exp d e1) @ [X.XOR (d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.BITXOR, e1, T.CONST n)) = (munch_exp d e1) @ [X.XOR (d, X.CONST n)]
+    | munch_exp d (T.BINOP(T.BITXOR, T.TEMP t, e1)) = (munch_exp d e1) @ [X.XOR (d, X.TEMP t)]
+    | munch_exp d (T.BINOP(T.BITXOR, e1, T.TEMP t)) = (munch_exp d e1) @ [X.XOR (d, X.TEMP t)]
+    | munch_exp d (T.BINOP(T.BITXOR, e1, e2)) =

         let
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("bitxor"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ANDL(d, X.TEMP t1)]
+          (munch_exp d e1) @ (munch_exp t1 e2) @ [X.XOR(d, t1)]

         end
         end

-    | munch_exp d (T.BINOP(T.BITOR, e1, e2)) =
+    | munch_exp d (a as T.BINOP(T.LOGAND, e1, e2)) =

         let
         let

-          val t1 = Temp.new ()
+          val (insn1, pos1, neg1) = munch_cond e1
+          val (insn2, pos2, neg2) = munch_cond e2
+          val t1 = X.TEMP (Temp.new("logand 1"))
+          val t2 = X.TEMP (Temp.new("logand 2"))
+          val l = Label.new ()

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.ORL(d, X.TEMP t1)]
+          if (effect e2 orelse (length insn2 > 10))
+          then (insn1) @
+               [X.SETcc(pos1, t1), X.Jcc (neg1, l)] @
+               (insn2) @
+               [X.SETcc(pos2, t1), X.LABEL l, X.MOVZB(d, t1)]
+          else insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.AND(t1, t2)), X.MOVZB(d, t1)]

         end
         end

-    | munch_exp d (T.BINOP(T.BITXOR, e1, e2)) =
+    | munch_exp d (a as T.BINOP(T.LOGOR, e1, e2)) =

         let
         let

-          val t1 = Temp.new ()
+          val (insn1, pos1, neg1) = munch_cond e1
+          val (insn2, pos2, neg2) = munch_cond e2
+          val t1 = X.TEMP (Temp.new("logor 1"))
+          val t2 = X.TEMP (Temp.new("logor 2"))
+          val l = Label.new ()

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @ [X.XORL(d, X.TEMP t1)]
+          if (effect e2 orelse (length insn2 > 10))
+          then (insn1) @
+               [X.SETcc(pos1, t1), X.Jcc (pos1, l)] @
+               (insn2) @
+               [X.SETcc(pos2, t1), X.LABEL l, X.MOVZB(d, t1)]
+          else insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.OR(t1, t2)), X.MOVZB(d, t1)]

         end
         end

-    | munch_exp d (T.BINOP(T.NEQ, e1, e2)) =
+    | munch_exp d (a as T.BINOP(T.EQ, _, _)) =
+        let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end
+    | munch_exp d (a as T.BINOP(T.NEQ, _, _)) =
+        let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end
+    | munch_exp d (a as T.BINOP(T.LE, _, _)) =
+        let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end
+    | munch_exp d (a as T.BINOP(T.LT, _, _)) =
+        let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end
+    | munch_exp d (a as T.BINOP(T.GE, _, _)) =
+        let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end
+    | munch_exp d (a as T.BINOP(T.GT, _, _)) =
+        let val (insns, pos, neg) = munch_cond a in insns @ [X.SETcc (pos, d), X.MOVZB(d, d)] end
+    | munch_exp d (T.UNOP(T.NEG, T.CONST n)) = [X.MOV (d, X.CONST (~n))]
+    | munch_exp d (T.UNOP(T.NEG, e1)) = (munch_exp d e1) @ [X.NEG d]
+    | munch_exp d (T.UNOP(T.BITNOT, T.CONST n)) = [X.MOV (d, X.CONST (Word32.notb n))]
+    | munch_exp d (T.UNOP(T.BITNOT, e1)) = (munch_exp d e1) @ [X.NOT d]
+    | munch_exp d (T.UNOP(T.BANG, T.CONST n)) = if (n = 0w0) then [X.MOV (d, X.CONST 0w1)] else [X.MOV (d, X.CONST 0w0)]
+    | munch_exp d (T.UNOP(T.BANG, e)) = 

         let
         let

-          val t1 = Temp.new ()
+          val (insns, pos, neg) = munch_cond e

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
-          [X.CMPL(d, X.TEMP t1), X.SETNE(d), X.MOVZBL(d, d)]
+          insns @ [X.SETcc (neg, d), X.MOVZB(d, d)]

         end
         end

-    | munch_exp d (T.BINOP(T.EQ, e1, e2)) =
+  (* munch_cond : T.exp -> X.insn list * X.cond * X.cond
+   * munch_cond stm generates code to set flags, and then returns a conditional
+   * to test if the expression was true and for if it was false.
+   *)
+  and munch_cond (T.UNOP (T.BANG, e)) =

         let
         let

-          val t1 = Temp.new ()
+          val (insns, pos, neg) = munch_cond e

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
-          [X.CMPL(d, X.TEMP t1), X.SETE(d), X.MOVZBL(d, d)]
+          (insns, neg, pos)

         end
         end

-    | munch_exp d (T.BINOP(T.LE, e1, e2)) =
+    | munch_cond (T.BINOP(T.NEQ, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.NE, X.E)
+    | munch_cond (T.BINOP(T.NEQ, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.NE, X.E)
+    | munch_cond (T.BINOP(T.NEQ, T.CONST n, e1)) =
+        let val t = X.TEMP (Temp.new ("const neq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.NE, X.E) end
+    | munch_cond (T.BINOP(T.NEQ, e1, T.CONST n)) =
+        let val t = X.TEMP (Temp.new ("const neq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.NE, X.E) end
+    | munch_cond (T.BINOP(T.NEQ, T.TEMP t, e1)) =
+        let val t1 = X.TEMP (Temp.new ("const neq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.NE, X.E) end
+    | munch_cond (T.BINOP(T.NEQ, e1, T.TEMP t)) =
+        let val t1 = X.TEMP (Temp.new ("const neq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.NE, X.E) end
+    | munch_cond (T.BINOP(T.NEQ, e1, e2)) =

         let
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("var neq 1"))
+          val t2 = X.TEMP (Temp.new ("var neq 2"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
-          [X.CMPL(d, X.TEMP t1), X.SETLE(d), X.MOVZBL(d, d)]
+          (munch_exp t1 e1 @ munch_exp t2 e2 @
+           [X.CMP(t1, t2)], X.NE, X.E)

         end
         end

-    | munch_exp d (T.BINOP(T.LT, e1, e2)) =
+    | munch_cond (T.BINOP(T.EQ, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.E, X.NE)
+    | munch_cond (T.BINOP(T.EQ, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.E, X.NE)
+    | munch_cond (T.BINOP(T.EQ, T.CONST n, e1)) =
+        let val t = X.TEMP (Temp.new ("const eq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.E, X.NE) end
+    | munch_cond (T.BINOP(T.EQ, e1, T.CONST n)) =
+        let val t = X.TEMP (Temp.new ("const eq")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.E, X.NE) end
+    | munch_cond (T.BINOP(T.EQ, T.TEMP t, e1)) =
+        let val t1 = X.TEMP (Temp.new ("const eq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.E, X.NE) end
+    | munch_cond (T.BINOP(T.EQ, e1, T.TEMP t)) =
+        let val t1 = X.TEMP (Temp.new ("const eq")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.E, X.NE) end
+    | munch_cond (T.BINOP(T.EQ, e1, e2)) =

         let
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("var eq 1"))
+          val t2 = X.TEMP (Temp.new ("var eq 2"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
-          [X.CMPL(d, X.TEMP t1), X.SETL(d), X.MOVZBL(d, d)]
+          (munch_exp t1 e1 @ munch_exp t2 e2 @
+           [X.CMP(t1, t2)], X.E, X.NE)

         end
         end

-    | munch_exp d (T.BINOP(T.GE, e1, e2)) =
+    | munch_cond (T.BINOP(T.LE, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.LE, X.G)
+    | munch_cond (T.BINOP(T.LE, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.GE, X.L)
+    | munch_cond (T.BINOP(T.LE, T.CONST n, e1)) =
+        let val t = X.TEMP (Temp.new ("const le")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.GE, X.L) end
+    | munch_cond (T.BINOP(T.LE, e1, T.CONST n)) =
+        let val t = X.TEMP (Temp.new ("const le")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.LE, X.G) end
+    | munch_cond (T.BINOP(T.LE, T.TEMP t, e1)) =
+        let val t1 = X.TEMP (Temp.new ("const le")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.GE, X.L) end
+    | munch_cond (T.BINOP(T.LE, e1, T.TEMP t)) =
+        let val t1 = X.TEMP (Temp.new ("const le")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.LE, X.G) end
+    | munch_cond (T.BINOP(T.LE, e1, e2)) =

         let
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("var le 1"))
+          val t2 = X.TEMP (Temp.new ("var le 2"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
-          [X.CMPL(d, X.TEMP t1), X.SETGE(d), X.MOVZBL(d, d)]
+          (munch_exp t1 e1 @ munch_exp t2 e2 @
+           [X.CMP(t1, t2)], X.LE, X.G)

         end
         end

-    | munch_exp d (T.BINOP(T.GT, e1, e2)) =
+    | munch_cond (T.BINOP(T.LT, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.L, X.GE)
+    | munch_cond (T.BINOP(T.LT, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.G, X.LE)
+    | munch_cond (T.BINOP(T.LT, T.CONST n, e1)) =
+        let val t = X.TEMP (Temp.new ("const lt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.G, X.LE) end
+    | munch_cond (T.BINOP(T.LT, e1, T.CONST n)) =
+        let val t = X.TEMP (Temp.new ("const lt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.L, X.GE) end
+    | munch_cond (T.BINOP(T.LT, T.TEMP t, e1)) =
+        let val t1 = X.TEMP (Temp.new ("const lt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.G, X.LE) end
+    | munch_cond (T.BINOP(T.LT, e1, T.TEMP t)) =
+        let val t1 = X.TEMP (Temp.new ("const lt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.L, X.GE) end
+    | munch_cond (T.BINOP(T.LT, e1, e2)) =

         let
         let

-          val t1 = Temp.new ()
+          val t1 = X.TEMP (Temp.new ("var lt 1"))
+          val t2 = X.TEMP (Temp.new ("var lt 2"))

         in
         in

-          (munch_exp d e1) @ (munch_exp (X.TEMP t1) e2) @
-          [X.CMPL(d, X.TEMP t1), X.SETG(d), X.MOVZBL(d, d)]
+          (munch_exp t1 e1 @ munch_exp t2 e2 @
+           [X.CMP(t1, t2)], X.L, X.GE)

         end
         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_cond (T.BINOP(T.GT, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.G, X.LE)
+    | munch_cond (T.BINOP(T.GT, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.L, X.GE)
+    | munch_cond (T.BINOP(T.GT, e1, T.CONST n)) =
+        let val t = X.TEMP (Temp.new ("const gt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.G, X.LE) end
+    | munch_cond (T.BINOP(T.GT, T.CONST n, e1)) =
+        let val t = X.TEMP (Temp.new ("const gt")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.L, X.GE) end
+    | munch_cond (T.BINOP(T.GT, e1, T.TEMP t)) =
+        let val t1 = X.TEMP (Temp.new ("const gt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.G, X.LE) end
+    | munch_cond (T.BINOP(T.GT, T.TEMP t, e1)) =
+        let val t1 = X.TEMP (Temp.new ("const gt")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.L, X.GE) end
+    | munch_cond (T.BINOP(T.GT, e1, e2)) =
+        let
+          val t1 = X.TEMP (Temp.new ("var gt 1"))
+          val t2 = X.TEMP (Temp.new ("var gt 2"))
+        in
+          (munch_exp t1 e1 @ munch_exp t2 e2 @
+           [X.CMP(t1, t2)], X.G, X.LE)
+        end
+    | munch_cond (T.BINOP(T.GE, T.TEMP t, T.CONST n)) = ([X.CMP(X.TEMP t, X.CONST n)], X.GE, X.L)
+    | munch_cond (T.BINOP(T.GE, T.CONST n, T.TEMP t)) = ([X.CMP(X.TEMP t, X.CONST n)], X.LE, X.G)
+    | munch_cond (T.BINOP(T.GE, e1, T.CONST n)) =
+        let val t = X.TEMP (Temp.new ("const ge")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.GE, X.L) end
+    | munch_cond (T.BINOP(T.GE, T.CONST n, e1)) =
+        let val t = X.TEMP (Temp.new ("const ge")) in (munch_exp t e1 @ [X.CMP(t, X.CONST n)], X.LE, X.G) end
+    | munch_cond (T.BINOP(T.GE, e1, T.TEMP t)) =
+        let val t1 = X.TEMP (Temp.new ("const ge")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.GE, X.L) end
+    | munch_cond (T.BINOP(T.GE, T.TEMP t, e1)) =
+        let val t1 = X.TEMP (Temp.new ("const ge")) in (munch_exp t1 e1 @ [X.CMP(t1, X.TEMP t)], X.LE, X.G) end
+    | munch_cond (T.BINOP(T.GE, e1, e2)) =
+        let
+          val t1 = X.TEMP (Temp.new ("var ge 1"))
+          val t2 = X.TEMP (Temp.new ("var ge 2"))
+        in
+          (munch_exp t1 e1 @ munch_exp t2 e2 @
+           [X.CMP(t1, t2)], X.GE, X.L)
+        end
+    | munch_cond (T.BINOP(T.LOGOR, e1, e2)) =
+        let
+          val (insn1, pos1, neg1) = munch_cond e1
+          val (insn2, pos2, neg2) = munch_cond e2
+          val t1 = X.TEMP (Temp.new("logor c 1"))
+          val t2 = X.TEMP (Temp.new("logor c 2"))
+          val l = Label.new ()
+        in
+          if (effect e2 orelse (length insn2 > 10))
+          then ((insn1) @
+                [X.SETcc (pos1, t1), X.Jcc (pos1, l)] @
+                (insn2) @
+                [X.SETcc (pos2, t1), X.LABEL l, X.SIZE (X.Byte, X.TEST (t1, t1))],
+                X.NE, X.E)
+          else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.OR(t1, t2))], X.NE, X.E)
+        end
+    | munch_cond (T.BINOP(T.LOGAND, e1, e2)) =
+        let
+          val (insn1, pos1, neg1) = munch_cond e1
+          val (insn2, pos2, neg2) = munch_cond e2
+          val t1 = X.TEMP (Temp.new("logand c 1"))
+          val t2 = X.TEMP (Temp.new("logand c 2"))
+          val l = Label.new ()
+        in
+          if (effect e2 orelse (length insn2 > 10))
+          then ((insn1) @
+                [X.SETcc (pos1, t1), X.Jcc (neg1, l)] @
+                (insn2) @
+                [X.SETcc (pos2, t1), X.LABEL l, X.SIZE (X.Byte, X.TEST (t1, t1))],
+                X.NE, X.E)
+          else (insn1 @ [X.SETcc (pos1, t1)] @ insn2 @ [X.SETcc (pos2, t2), X.SIZE(X.Byte, X.AND(t1, t2))], X.NE, X.E)
+        end
+    | munch_cond e =
+      let
+        val t = X.TEMP (Temp.new ("munch c"))
+      in
+        (munch_exp t e @ [ X.TEST (t,t) ], X.NE, X.E)
+      end

 
   (* munch_stm : T.stm -> X.insn list *)
   (* munch_stm stm generates code to execute stm *)
 
   (* munch_stm : T.stm -> X.insn list *)
   (* munch_stm stm generates code to execute stm *)

-  fun munch_stm (T.MOVE(T.TEMP(t1), e2)) =
+  fun munch_stm (T.MOVE (T.TEMP t, a as T.TEMP _)) = munch_exp (X.TEMP t) a
+    | munch_stm (T.MOVE (T.TEMP t, a as T.CONST _)) = munch_exp (X.TEMP t) a
+    | munch_stm (T.MOVE (T.TEMP t, a as T.ARG _)) = munch_exp (X.TEMP t) a
+    | munch_stm (T.MOVE (T.TEMP t, a as T.CALL _)) = munch_exp (X.TEMP t) a
+    | munch_stm (T.MOVE(T.TEMP t1, e2)) =

         let
         let

-          val t = Temp.new ()
+          val t = Temp.new ("assign")

         in
           munch_exp (X.TEMP t) e2
         in
           munch_exp (X.TEMP t) e2

-          @ [X.MOVL(X.TEMP t1, X.TEMP t)]
+          @ [X.MOV(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)) =
         let
         end
     | munch_stm (T.MOVE(_, _)) =
         raise ErrorMsg.InternalError "Incorrect first operand for T.MOVE?"
     | munch_stm (T.RETURN(e)) =
         let

-          val t = Temp.new ()
+          val t = Temp.new ("retval")

         in
           munch_exp (X.TEMP t) e
         in
           munch_exp (X.TEMP t) e

-          @ [X.MOVL(X.REG X.EAX, X.TEMP t), X.RET]
+          @ [X.MOV(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
         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 ()
+         val (insns, pos, neg) = munch_cond e 

        in
        in

-         munch_exp (X.TEMP t) e
-         @ [X.TEST(X.TEMP t, X.TEMP t), X.JE l]
+         insns @ [X.Jcc (neg, l)]

        end
 
   fun codegen nil = nil
        end
 
   fun codegen nil = nil

diff --git a/codegen/coloring.sml b/codegen/coloring.sml
index eeca849b5d10a68ef91e0079a374ba4545dffb8b..1e08e1d7d6863fb9359eb60cd5126cb60c309610 100644 (file)
--- a/codegen/coloring.sml
+++ b/codegen/coloring.sml
@@ -1,4 +1,4 @@
-(* L2 compiler
+(* L3 compiler

  * colorizer
  * colors a graph and returns a list of nodes with associated colors
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  * colorizer
  * colors a graph and returns a list of nodes with associated colors
  * Author: Joshua Wise <jwise@andrew.cmu.edu>


@@ -7,18 +7,29 @@
 
 signature COLORIZER =
 sig
 
 signature COLORIZER =
 sig

+  structure OperSet : ORD_SET
+    where type Key.ord_key = x86.oper
+  structure LiveMap : ORD_MAP
+    where type Key.ord_key = int
+  structure TempMap : ORD_MAP
+    where type Key.ord_key = Temp.temp
+

   type temps = Temp.temp list
   type colorlist = (Temp.temp * int) list
   type temps = Temp.temp list
   type colorlist = (Temp.temp * int) list

-  type igraph = (Temp.temp * x86.oper list) list
+  type igraph = OperSet.set TempMap.map

 
 

-  val colorize : temps -> igraph -> colorlist
+  val colorize : temps -> Igraph.graph -> colorlist

 end
 
 structure Colorizer :> COLORIZER =
 struct
 end
 
 structure Colorizer :> COLORIZER =
 struct

+  structure OperSet = Igraph.OperSet
+  structure LiveMap = Igraph.LiveMap
+  structure TempMap = Igraph.TempMap
+

   type temps = Temp.temp list
   type colorlist = (Temp.temp * int) list
   type temps = Temp.temp list
   type colorlist = (Temp.temp * int) list

-  type igraph = (Temp.temp * x86.oper list) list
+  type igraph = OperSet.set TempMap.map

   
   structure X = x86
   
   
   structure X = x86
   


@@ -27,19 +38,20 @@ struct
    * already-colored nodes, colors the temp, and adds it to the list
    * this is a helper function for the foldr in colorize
    *)
    * already-colored nodes, colors the temp, and adds it to the list
    * this is a helper function for the foldr in colorize
    *)

-  fun color_single (graph: igraph) (temp, regs) =
+  fun color_single (graph: Igraph.graph) (temp, regs) =

     let
     let

-      (* Grab the list of interfering operands from the graph *)
-      val interfere = case List.find (fn (temp',_) => Temp.compare (temp', temp) = EQUAL) graph
-        of SOME(_, l) => l
-         | NONE => raise ErrorMsg.InternalError "Temporary not found in graph"
+      (* Grab the set of interfering operands from the graph *)
+      val interfere = case TempMap.find (graph, temp)
+        of SOME(l) => OperSet.listItems l
+         | NONE => []
+(*       | NONE => raise ErrorMsg.InternalError "Temporary not found in graph" *)

       
       (* Grab the subset of those that are already colorized *)
       val colorized =
         List.filter
           (fn (t,_) =>
             List.exists
       
       (* Grab the subset of those that are already colorized *)
       val colorized =
         List.filter
           (fn (t,_) =>
             List.exists

-              (fn X.TEMP t' => Temp.compare (t, t') = EQUAL
+              (fn X.TEMP t' => Temp.eq (t, t')

                 | _ => false)
               interfere
           ) regs
                 | _ => false)
               interfere
           ) regs


@@ -57,10 +69,8 @@ struct
           (fn (_,i) => i)
           colorized)
         @ (List.map
           (fn (_,i) => i)
           colorized)
         @ (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")
+             (fn X.REG a => X.regtonum a
+               | loss => raise ErrorMsg.InternalError ("Bad kind of specreg " ^ (X.prettyprint_oper X.Long loss )))

           fixeds)
       (* Greedy-colorize -- pick the lowest number that isn't used by a neighbor *)
       fun greedy i l =
           fixeds)
       (* Greedy-colorize -- pick the lowest number that isn't used by a neighbor *)
       fun greedy i l =

diff --git a/codegen/colororder.sml b/codegen/colororder.sml
index f533cead3e680c51c4a88d9e7f37b60f5097cba4..0f25863957933eeeace36c2d402fa82c31ef656e 100644 (file)
--- a/codegen/colororder.sml
+++ b/codegen/colororder.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 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>
  * Takes a interference graph and generates an ordering for coloring
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  * Author: Chris Lu <czl@aundrew.cmu.edu>


@@ -6,10 +6,17 @@
 
 signature COLORORDER =
 sig
 
 signature COLORORDER =
 sig

-  type igraph = (Temp.temp * x86.oper list) list
+  structure OperSet : ORD_SET
+    where type Key.ord_key = x86.oper
+  structure LiveMap : ORD_MAP
+    where type Key.ord_key = int
+  structure TempMap : ORD_MAP
+    where type Key.ord_key = Temp.temp
+
+  type igraph = OperSet.set TempMap.map

   type ordering = Temp.temp list
   
   type ordering = Temp.temp list
   

-  val colororder : igraph -> ordering
+  val colororder : Igraph.graph * Temp.temp list -> ordering

 end
 
 structure ColorOrder :> COLORORDER =
 end
 
 structure ColorOrder :> COLORORDER =


@@ -17,12 +24,16 @@ struct
   structure T = Temp
   structure X = x86
   
   structure T = Temp
   structure X = x86
   

-  type igraph = (Temp.temp * x86.oper list) list
+  structure OperSet = Igraph.OperSet
+  structure LiveMap = Igraph.LiveMap
+  structure TempMap = Igraph.TempMap
+  
+  type igraph = OperSet.set TempMap.map

   type ordering = Temp.temp list
   
   type ordering = Temp.temp list
   

-  fun colororder graph =
+  fun colororder (graph,temps) =

     let
     let

-      val initialWeights = map (fn (t, _) => (t, 0)) graph
+      val initialWeights = TempMap.mapi (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
       
       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


@@ -34,15 +45,14 @@ struct
           val (chosen, w) = List.hd sorted     (* Grab the temp with the highest weight. *)
           val remaining = List.tl sorted
           val neighbors =                      (* Grab all the neighbors for some given temp. *)
           val (chosen, w) = List.hd sorted     (* Grab the temp with the highest weight. *)
           val remaining = List.tl sorted
           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))
+            (OperSet.listItems
+              (valOf (TempMap.find (graph, chosen))))

           val newWeights =
             List.map
               (fn (t, wt) =>
                 (t,
                   if (List.exists 
           val newWeights =
             List.map
               (fn (t, wt) =>
                 (t,
                   if (List.exists 

-                        (fn X.TEMP t' => (T.compare (t, t') = EQUAL)
+                        (fn X.TEMP t' => (T.eq (t, t'))

                           | _ => false)
                         neighbors)
                     then (wt + 1)
                           | _ => false)
                         neighbors)
                     then (wt + 1)


@@ -61,7 +71,9 @@ struct
           in
             chosen :: (keepOrdering newWeights)
           end
           in
             chosen :: (keepOrdering newWeights)
           end

+
+      val ordered = keepOrdering (TempMap.listItems initialWeights)

     in
     in

-      (keepOrdering initialWeights)
+      ordered @ (List.filter (fn a => not (List.exists (fn b => Temp.eq (a,b)) ordered)) temps)

     end
 end
     end
 end

diff --git a/codegen/igraph.sml b/codegen/igraph.sml
index 9fe50a00ff23ee8360a8b819c63b94d53fce0f2b..30b17eee61acdde8942671491542182cb7e17200 100644 (file)
--- a/codegen/igraph.sml
+++ b/codegen/igraph.sml
@@ -1,4 +1,4 @@
-(* L2 compiler
+(* L3 compiler

  * interference graph generator
  * Takes a list of interfering temps and generates the interference graph
  * Author: Chris Lu <czl@andrew.cmu.edu>
  * interference graph generator
  * Takes a list of interfering temps and generates the interference graph
  * Author: Chris Lu <czl@andrew.cmu.edu>


@@ -6,66 +6,109 @@
 
 signature IGRAPH =
 sig
 
 signature IGRAPH =
 sig

-  type interferences = x86.oper list list
-  type graph = (Temp.temp * x86.oper list) list
-  val gengraph : interferences -> graph
+  structure OperSet : ORD_SET
+    where type Key.ord_key = x86.oper
+  structure LiveMap : ORD_MAP
+    where type Key.ord_key = int
+  structure TempMap : ORD_MAP
+    where type Key.ord_key = Temp.temp
+      
+  type predicates = Liveness.predicates
+  type livenesses = Liveness.livenesses
+  type graph = OperSet.set TempMap.map
+  val gengraph : predicates * livenesses -> graph * Temp.temp list

 end
 
 structure Igraph :> IGRAPH =
 struct
 end
 
 structure Igraph :> IGRAPH =
 struct

-  type interferences = x86.oper list list
-  type graph = (Temp.temp * x86.oper list) list
+  structure OperSet = Liveness.OperSet
+  structure LiveMap = Liveness.LiveMap
+
+  structure TempSet = BinarySetFn (
+    struct
+      type ord_key = Temp.temp
+      val compare = Temp.compare
+    end
+  )
+
+  structure TempMap = SplayMapFn (
+    struct
+      type ord_key = Temp.temp
+      val compare = Temp.compare
+    end)
+  
+  type predicates = Liveness.predicates
+  type livenesses = Liveness.livenesses
+  type graph = OperSet.set TempMap.map
+  

   structure X = x86
   
   structure X = x86
   

-  (* 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 =
+  fun add_temp_interfere g (t, oper) =

     let
     let

-      val sorig = ListMergeSort.sort (fn ((a,_),(b,_)) => X.cmpoper (a,b) = LESS) orig
-      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) = (if X.opereq (x,y) then merge' (x::rl) else x :: merge' (y::rl))
-            | merge' (x::nil) = [x]
-            | merge' nil = nil
-        in
-          merge' sl
-        end
+      val set = (valOf (TempMap.find (g, t))) handle Option => OperSet.empty

     in
     in

-      List.map (fn (a, x) => (a, uniq x)) ml
+      TempMap.insert (g, t, OperSet.union (set, OperSet.singleton oper))
+    end
+  
+  fun add_interfere g (o1, o2) =
+    let
+      val g = case o1
+        of (X.TEMP t) => add_temp_interfere g (t, o2)
+         | _ => g
+    in
+      case o2
+        of (X.TEMP t) => add_temp_interfere g (t, o1)
+         | _ => g

     end
 
     end
 

-  (* 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 => not (X.opereq(item1, item2))) x)))
-          x
+  fun alltemps preds =
+    LiveMap.foldr
+      (fn (ps, ts) => List.foldr
+        (fn (Liveness.DEF(X.TEMP t), ts') => TempSet.add (ts', t)
+          | (Liveness.USE(X.TEMP t), ts') => TempSet.add (ts', t)
+          | (_, ts') => ts')
+        ts
+        ps
+      )
+      TempSet.empty
+      preds

 
   (* 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
    *)
 
   (* 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
    *)

-  fun gengraph x =
-    let
-      val igraph' = canonicalize (List.concat (List.map proc_one x))
-    in
-      foldr
-        (fn ((a,l),b) => case a
-          of X.REG(_) => b
-           | X.TEMP(t) => (t,l)::b 
-           | _ => raise ErrorMsg.InternalError "Non-live register type found in igraph"
+  fun gengraph (preds, lives) : graph * Temp.temp list =
+    (LiveMap.foldri
+      (fn (ln, predlist, map) =>
+        let
+          val ismove = Liveness.ismove predlist
+        in
+          List.foldr
+            (fn (oper, map) =>
+              List.foldr
+                (fn (ln', map) =>
+                  let
+                    val liveat = valOf (LiveMap.find (lives, ln'))
+                    val liveat =
+                      if not ismove
+                      then liveat
+                      else OperSet.difference
+                             (liveat,
+                              OperSet.addList (OperSet.empty, Liveness.uses predlist))
+                  in
+                    OperSet.foldr
+                      (fn (oper', map) => add_interfere map (oper, oper'))
+                      map
+                      liveat
+                  end)
+                map
+                (Liveness.succs predlist))
+            map
+            (Liveness.defs predlist)
+        end

         )
         )

-        nil
-        igraph'
-    end
-
+      TempMap.empty
+      preds,
+      TempSet.listItems (alltemps preds))

 end
 end

diff --git a/codegen/liveness.sml b/codegen/liveness.sml
index 95f1f90ce3b35f13ebcd217154ffc1825bf915f3..24123b9013ffc3e1e5c7bc5feb98caa87f2cb714 100644 (file)
--- a/codegen/liveness.sml
+++ b/codegen/liveness.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler

  * Turns pseudoasm into liveness-annotated pseudoasm
  * Author: Chris Lu <czl@andrew.cmu.edu>
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  * Turns pseudoasm into liveness-annotated pseudoasm
  * Author: Chris Lu <czl@andrew.cmu.edu>
  * Author: Joshua Wise <jwise@andrew.cmu.edu>


@@ -6,31 +6,47 @@
 
 signature LIVENESS =
 sig
 
 signature LIVENESS =
 sig

-
-  type live = int * x86.oper list
+  structure OperSet : ORD_SET
+    where type Key.ord_key = x86.oper;
+  structure LiveMap : ORD_MAP
+    where type Key.ord_key = int;
+  
+  type live = int * OperSet.set

   type pseudoasm = x86.insn list
   type pseudoasm = x86.insn list

-  type livenesses = x86.oper list list
-
+  type livenesses = OperSet.set LiveMap.map
+  

   type ident = int
   type ident = int

-  datatype pred = DEF of x86.oper | USE of x86.oper | SUCC of ident
+  datatype pred = DEF of x86.oper | USE of x86.oper | SUCC of ident | ISMOVE
+  
+  type predicates = pred list LiveMap.map
+
+  val uses : pred list -> x86.oper list
+  val succs : pred list -> ident list
+  val defs : pred list -> x86.oper list
+  val ismove : pred list -> bool

 
 

-  val liveness : pseudoasm -> livenesses
-  val prettyprint : x86.oper list -> string
+  val liveness : pseudoasm -> predicates * livenesses
+  val listify : livenesses -> OperSet.set list
+  val prettyprint : OperSet.set -> string

 end
 
 structure Liveness :> LIVENESS =
 struct
   structure T = Temp
   structure X = x86
 end
 
 structure Liveness :> LIVENESS =
 struct
   structure T = Temp
   structure X = x86

+  
+  structure OperSet = x86.OperSet
+  structure LiveMap = x86.LiveMap

 
 

-
-  type live = int * x86.oper list
+  type live = int * OperSet.set

   type pseudoasm = X.insn list
   type pseudoasm = X.insn list

-  type numasm = (int * X.insn) list
-  type livenesses = X.oper list list
+  type numasm = X.insn LiveMap.map
+  type livenesses = OperSet.set LiveMap.map

 
   type ident = int
 
   type ident = int

-  datatype pred = DEF of X.oper | USE of X.oper | SUCC of ident
+  datatype pred = DEF of X.oper | USE of X.oper | SUCC of ident | ISMOVE
+  
+  type predicates = pred list LiveMap.map

 
   (* val number : pseudoasm -> numasm
    * numbers the instructions!
 
   (* val number : pseudoasm -> numasm
    * numbers the instructions!


@@ -40,7 +56,10 @@ struct
     let
       val nums = List.tabulate (List.length instrs, (fn i => i))
     in
     let
       val nums = List.tabulate (List.length instrs, (fn i => i))
     in

-      ListPair.zip (nums,instrs)
+      foldr
+        LiveMap.insert'
+        LiveMap.empty
+        (ListPair.zip (nums,instrs))

     end
 
   (* val defusesucc : numasm -> (ident * pred list) list
     end
 
   (* val defusesucc : numasm -> (ident * pred list) list


@@ -51,82 +70,112 @@ struct
     let
       fun findlabel (lb) =
             Option.valOf
     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)
+              (LiveMap.foldri (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 *)
       
       (* 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 defhit (X.REG a) = [DEF(X.REG a)]
+        | defhit (X.TEMP a) = [DEF(X.TEMP a)]
+        | defhit (_) = nil
+    
+      fun usehit (X.REG a) = [USE(X.REG a)]
+        | usehit (X.TEMP a) = [USE(X.TEMP a)]
+        | usehit (_) = nil

 
 

-      fun usehit (a as X.CONST(_)) = nil
-        | usehit (a) = [USE(a)]
+      fun callhit 0 = nil
+        | callhit 1 = USE(X.REG(X.EDI))::(callhit 0)
+        | callhit 2 = USE(X.REG(X.ESI))::(callhit 1)
+        | callhit 3 = USE(X.REG(X.EDX))::(callhit 2)
+        | callhit 4 = USE(X.REG(X.ECX))::(callhit 3)
+        | callhit 5 = USE(X.REG(X.R8D))::(callhit 4)
+        | callhit 6 = USE(X.REG(X.R9D))::(callhit 5)
+        | callhit _ = callhit 6

 
       (* val gendef : ident * X.insn -> ident * pred list
        * generates the def/use/succ predicates for a single insn
        *)
 
       (* 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)),
+      fun gendef (n, X.DIRECTIVE(_))           = (nil)
+        | gendef (n, X.COMMENT(_))             = (nil)
+        | gendef (n, X.LIVEIGN (_))            = ([SUCC (n+1)])
+        | gendef (n, X.SIZE(_, i))             = gendef (n,i)
+        | gendef (n, X.MOV(dest, src))         = (defhit dest @ usehit src @ [SUCC(n+1), ISMOVE])
+        | gendef (n, X.SUB(dest, src))         = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.IMUL(dest, src))        = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.IMUL3(dest, src, _))    = (defhit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.ADD(dest, src))         = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.IDIV(src))              = (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)])
                                                                    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)])
+        | gendef (n, X.CLTD)                   = ([USE(X.REG(X.EAX)), DEF(X.REG(X.EDX)), SUCC(n+1)])
+        | gendef (n, X.SAL(dest, shft))        = (defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)])
+        | gendef (n, X.SAR(dest, shft))        = (defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)])
+        | gendef (n, X.NEG(src))               = (defhit src @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.NOT(src))               = (defhit src @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.AND(dest, src))         = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.OR(dest, src))          = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.XOR(dest, src))         = (defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.CMP(dest, src))         = (usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.TEST(dest, src))        = (usehit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.SETcc(_,dest))          = (defhit dest @ [SUCC(n+1)])
+        | gendef (n, X.CALL(_, a))             = (callhit a @ [DEF(X.REG(X.EAX)), DEF(X.REG(X.ECX)), DEF(X.REG(X.EDX)),
+                                                                  DEF(X.REG(X.EDI)), DEF(X.REG(X.ESI)), DEF(X.REG(X.R8D)),
+                                                                  DEF(X.REG(X.R9D)), DEF(X.REG(X.R10D)), DEF(X.REG(X.R11D)), SUCC(n+1)])
+        | gendef (n, X.MOVZB(dest, src))       = (defhit dest @ usehit src @ [SUCC(n+1)])
+        | gendef (n, X.RET)                    = ([USE (X.REG X.EAX)])
+        | gendef (n, X.LABEL l)                = ([SUCC (n+1)])
+        | gendef (n, X.JMP l)                  = ([SUCC (findlabel l)])
+        | gendef (n, X.Jcc (_,l))              = ([SUCC (n+1), SUCC (findlabel l)])

     in
     in

-        List.map gendef l
+        LiveMap.mapi gendef l

     end
 
     end
 

-  (* val uselive : (ident * pred list) list -> live list
+  (* val uselive : (int * pred list) list -> OperSet.set LiveMap.map

    * generates liveness for 'use' rules to get the iterative analyzer started
    *)
   fun uselive preds =
    * 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
+    LiveMap.mapi
+      (fn (n, pl) =>
+         foldr
+           (fn (USE (l), set) => OperSet.add (set, l)
+             | (_, set) => set)
+           OperSet.empty
+           pl

       )
       )

-    )
-    preds
+      preds

 
 

-  (* val subsetlive : (ident * pred list) * (ident * pred list) -> bool
+  (* val subsetlive : OperSet.set LiveMap.map * OperSet.set LiveMap.map -> bool

    * true if first is subset of second
    *)
 
   fun subsetlive (l1,l2) =
    * 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)
+    LiveMap.foldri
+      (fn (_, _, false) => false
+        | (n, set1, _) => case LiveMap.find (l2, n)
+            of NONE => false
+             | SOME set2 => OperSet.isSubset (set1, set2))
+      true
+      l1
+  
+  (* val succs : pred list -> int list
+   * 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
+
+  fun defs (DEF(a)::l) = a::(defs l)
+    | defs (_::l) = defs l
+    | defs nil = nil
+  
+  fun uses (USE(a)::l) = a::(defs l)
+    | uses (_::l) = defs l
+    | uses nil = nil
+  
+  fun ismove l = List.exists (fn ISMOVE => true | _ => false) l

 
 

-  (* val liveiter : live list -> (ident * pred list) list -> live list
+  (* val liveiter : OperSet.set LiveMap.map -> (int * pred list) list -> OperSet.set LiveMap.map

    * 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 :
    * 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 :


@@ -138,42 +187,34 @@ struct
    *   live(l,x)
    *)
 
    *   live(l,x)
    *)
 

-  fun liveiter l p =
+  fun liveiter livemap preds =

     let
     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
+
+
+      (* val lives : int list -> OperSet.set LiveMap.map -> OperSet.set

        * scans l for live variables in succeeding lines *)
       fun lives l' idents =
        * 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')
+        let
+          val lines = List.mapPartial (fn a => LiveMap.find (l', a)) idents
+        in
+          foldr
+            (fn (set', set) => OperSet.union (set', set))
+            OperSet.empty
+            lines
+        end

 
       (* val isndef : X.oper -> pred list -> bool
        * checks to see if x is defined in a predicate list *)
 
       (* 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
+      fun isndef (X.STACKARG(_)) _ = false
+        | 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
 
         | 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
+      (* val liveadd : live -> OperSet.set LiveMap.map -> OperSet.set LiveMap.map *)
+      fun liveadd (n,oper) map = case LiveMap.find (map, n)
+        of SOME(x) => LiveMap.insert (map, n, OperSet.add (x, oper))
+         | NONE => LiveMap.insert (map, n, OperSet.singleton oper)

 
       (* this does the dirty work!
        * for each line, checks if the live variables in succeeding lines are
 
       (* this does the dirty work!
        * for each line, checks if the live variables in succeeding lines are


@@ -182,18 +223,25 @@ struct
        * changing the first foldr to a foldl slows down liveness by a factor
        * of at least 100 on cedar-anastulate.l2
        *)
        * 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
+      val newl = LiveMap.foldri
+        (fn (n, a, b) => OperSet.foldr

           (fn (a',b') => if (isndef a' a) then liveadd (n, a') b' else b')
           b
           (lives b (succs a))
         )
           (fn (a',b') => if (isndef a' a) then liveadd (n, a') b' else b')
           b
           (lives b (succs a))
         )

-        l
-        p
+        livemap
+        preds

     in
     in

-      if subsetlive (newl, l) then l else liveiter newl p
+      if subsetlive (newl, livemap)
+      then livemap
+      else liveiter newl preds

     end
 
     end
 

+  fun dustostring (DEF(a)) = "DEF(" ^ X.prettyprint_oper X.Long a ^ ")"
+    | dustostring (USE(a)) = "USE(" ^ X.prettyprint_oper X.Long a ^ ")"
+    | dustostring (SUCC(a)) = "SUCC(" ^ Int.toString a ^ ")"
+    | dustostring ISMOVE = "ISMOVE"
+

   (* val liveness : pseudoasm -> livenesses
    * analyzes liveness of variables in the given pseudo-asm
    *)
   (* val liveness : pseudoasm -> livenesses
    * analyzes liveness of variables in the given pseudo-asm
    *)


@@ -201,13 +249,31 @@ struct
   fun liveness instrs =
     let
       val preds = defusesucc (number instrs)
   fun liveness instrs =
     let
       val preds = defusesucc (number instrs)

+(*      val (_,l) = ListPair.unzip preds
+      val () = print (
+        String.concatWith "\n" (
+          List.map
+            (fn a => String.concatWith ", " (List.map dustostring a))
+            l
+        )
+      )*)

       val init = uselive preds
       val init = uselive preds

-      val (_,lives) = ListPair.unzip (liveiter init preds)
+      val initmap = LiveMap.foldri (fn (n,a,b) => LiveMap.insert (b, n, a)) LiveMap.empty init

     in
     in

-      lives
+      (preds, liveiter initmap preds)
+    end
+  
+  fun prettyprint (set) =
+    OperSet.foldr
+      (fn (oper, s) => (X.prettyprint_oper X.Long oper) ^ ", " ^ s)
+      "-\n"
+      set
+      
+  fun listify map =
+    let
+      val maxln = LiveMap.foldri (fn (a, _, b) => Int.max (a, b)) 0 map
+      val nums = List.tabulate (maxln+1, fn x => x)
+    in
+      List.map (fn num => valOf (LiveMap.find (map, num)) handle Option => OperSet.empty) nums

     end
     end

-
-  fun prettyprint (a::l) = (X.prettyprint_oper a) ^ ", " ^ prettyprint l
-    | prettyprint nil = "-\n"
-

 end
 end

diff --git a/codegen/peephole.sml b/codegen/peephole.sml
index 7880a4532a5744d1c0f9a13fdcbb47cbacdcdb6b..7fa4554b305d5721dfbbedf8d305a8e8ed169c95 100644 (file)
--- a/codegen/peephole.sml
+++ b/codegen/peephole.sml
@@ -1,4 +1,4 @@
-(* L2 compiler
+(* L3 compiler

  * peephole optimizer
  * optimizes away redundant insns such as:
      mov a, b
  * peephole optimizer
  * optimizes away redundant insns such as:
      mov a, b


@@ -25,15 +25,22 @@ struct
 
   (* val peephole : x86.insn list -> x86.insn list *)
 
 
   (* val peephole : x86.insn list -> x86.insn list *)
 

-  fun peephole ((insn1 as X.MOVL(a1,b1))::(insn2 as X.MOVL(a2,b2))::l) =
+  fun peephole ((insn1 as X.MOV(a1,b1))::(insn2 as X.MOV(a2,b2))::l) =

         if(x86.opereq(a1, b1) orelse (x86.opereq(a1, a2) andalso x86.opereq(b1, b2))) then
           peephole (insn2::l)
         else if(x86.opereq(a2, b2) orelse (x86.opereq(a1, b2) andalso x86.opereq(b1, a2))) then
           peephole (insn1::l)
         else
           insn1::(peephole (insn2::l))
         if(x86.opereq(a1, b1) orelse (x86.opereq(a1, a2) andalso x86.opereq(b1, b2))) then
           peephole (insn2::l)
         else if(x86.opereq(a2, b2) orelse (x86.opereq(a1, b2) andalso x86.opereq(b1, a2))) then
           peephole (insn1::l)
         else
           insn1::(peephole (insn2::l))

-    | peephole ((insn as X.MOVL(a,b))::l) = if x86.opereq(a, b) then peephole l else insn::(peephole l)
+    | peephole (X.MOV (X.REG r, X.CONST 0w0)::l) = (X.XOR (X.REG r, X.REG r))::(peephole l)
+    | peephole ((insn as X.MOV(a,b))::l) = if x86.opereq(a, b) then peephole l else insn::(peephole l)

     | peephole ((insn1 as X.NEG(a))::(insn2 as X.NEG(b))::l) = if x86.opereq(a, b) then peephole l else insn1::(peephole (insn2::l))
     | peephole ((insn1 as X.NEG(a))::(insn2 as X.NEG(b))::l) = if x86.opereq(a, b) then peephole l else insn1::(peephole (insn2::l))

+    | peephole (X.ADD (_, X.CONST 0w0)::l) = peephole l
+    | peephole (X.SUB (_, X.CONST 0w0)::l) = peephole l
+    | peephole (X.CMP (X.REG r, X.CONST 0w0)::l) = (X.TEST (X.REG r, X.REG r))::(peephole l)
+    | peephole ((X.JMP a)::(X.JMP b)::l) = peephole ((X.JMP a)::l) (* What the cock? Yes, we actually generate this. *)
+    | peephole ((X.JMP l1)::(X.LABEL l2)::l) = if (Label.compare (l1,l2) = EQUAL) then (X.LABEL l2)::(peephole l) else (X.JMP l1)::(X.LABEL l2)::(peephole l)
+    | peephole (X.SIZE (s, i)::l) = map (fn i => X.SIZE (s, i)) (peephole [i]) @ (peephole l)  (* :/ that kind of sucks, but oh well *)

     | peephole (a::l) = a::(peephole l)
     | peephole nil = nil
 
     | peephole (a::l) = a::(peephole l)
     | peephole nil = nil
 

diff --git a/codegen/solidify.sml b/codegen/solidify.sml
index 48fad3986f434dd5fe82ab1842cd11ef7ce8781a..8c39017586297295225d1269b9123463244ac240 100644 (file)
--- a/codegen/solidify.sml
+++ b/codegen/solidify.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 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>
  * Takes a list of mappings of temporaries to colors and a pseudoasm listing,
  * then produces x86 code.
  * Author: Chris Lu <czl@andrew.cmu.edu>


@@ -26,7 +26,7 @@ struct
   fun solidify (regmap : colorings) (instrs : asm) : asm =
     let
       (* r14d and r15d is reserved for spilling *)
   fun solidify (regmap : colorings) (instrs : asm) : asm =
     let
       (* r14d and r15d is reserved for spilling *)

-      val maxreg = X.regtonum X.R13D
+      val maxreg = X.regtonum X.R14D

       fun numtoreg n =
           if (n > maxreg)
           then raise Spilled
       fun numtoreg n =
           if (n > maxreg)
           then raise Spilled


@@ -35,59 +35,97 @@ struct
       fun temptonum (t: T.temp) : int =
         (List.hd
           (List.map (fn (_, n) => n)
       fun temptonum (t: T.temp) : int =
         (List.hd
           (List.map (fn (_, n) => n)

-            (List.filter (fn (a, _) => (Temp.compare (a, t) = EQUAL)) regmap)))
+            (List.filter (fn (a, _) => (Temp.eq (a, t))) regmap)))

       
       fun temptoreg (t: T.temp) : x86.reg =
         numtoreg (temptonum t)          
       
       fun temptoreg (t: T.temp) : x86.reg =
         numtoreg (temptonum t)          

-        handle Empty =>
-          (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 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"]
-      
+        handle Empty => raise ErrorMsg.InternalError ("Uncolored temp "^(Temp.name t)^", agh!")
+
+      val spillreg1 = X.R15D
+
+      (* Determine which need to be saved. *)
+      val opsused = map (fn (_, n) => X.REG (numtoreg n handle Spilled => X.R15D)) regmap
+      val saveregs = X.OperSet.intersection (
+        X.OperSet.addList (X.OperSet.empty, opsused),
+        X.OperSet.addList (
+          X.OperSet.empty,
+          [X.REG X.EBX,
+           X.REG X.EBP,
+           X.REG X.R12D,
+           X.REG X.R13D,
+           X.REG X.R14D,
+           X.REG X.R15D]))
+      val savelist = X.OperSet.listItems saveregs
+      val nsave = length savelist
+

       val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap)     (* Number of registers used. *)
       val nspilled = Int.max (numreg - maxreg, 0)      (* Number of spilled registers. *)
       fun isspilled (X.TEMP temp) = (((temptonum temp) > maxreg) handle Empty => false)        (* Whether a register is spilled *)
       val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap)     (* Number of registers used. *)
       val nspilled = Int.max (numreg - maxreg, 0)      (* Number of spilled registers. *)
       fun isspilled (X.TEMP temp) = (((temptonum temp) > maxreg) handle Empty => false)        (* Whether a register is spilled *)

+        | isspilled (X.STACKARG _) = true
+        | isspilled (X.REL _) = true

         | isspilled _ = false
         | isspilled _ = false

-      fun stackpos (reg: int) = (reg - maxreg) * ~4    (* Stack position of some register number *)
-      
+      val stacksz = (nspilled + nsave) * 8
+      fun stackpos (reg: int) = stacksz - (reg - maxreg + nsave) * 8   (* Stack position of some register number *)
+
+      val prologue =
+        (X.SIZE (X.Qword, X.SUB (X.REG X.RSP, X.CONST (Word32.fromInt stacksz)))) ::
+        (ListPair.map
+          (fn (num, reg) =>
+            X.SIZE (X.Qword, X.MOV (X.REL (X.RSP, stacksz - 8*(num+1)), reg)))
+          (List.tabulate (nsave, fn x => x), savelist))
+      val epilogue =
+        (ListPair.map
+          (fn (num, reg) =>
+            X.SIZE (X.Qword, X.MOV (reg, X.REL (X.RSP, stacksz - 8*(num+1)))))
+          (List.tabulate (nsave, fn x => x), savelist)) @
+        [X.SIZE (X.Qword, X.ADD (X.REG X.RSP, X.CONST (Word32.fromInt stacksz)))]
+      val endlbl = Label.new()
+

       fun spill (X.TEMP temp, xreg: x86.reg) = (* Spill a register if need be. *)
         if (isspilled (X.TEMP temp))
       fun spill (X.TEMP temp, xreg: x86.reg) = (* Spill a register if need be. *)
         if (isspilled (X.TEMP temp))

-          then [X.MOVL (X.REL (X.RSP, stackpos (temptonum temp)), X.REG xreg)]
+          then [X.MOV (X.REL (X.RSP, stackpos (temptonum temp)), X.REG xreg)]

           else nil
           else nil

+        | spill (X.STACKARG _, _) = raise ErrorMsg.InternalError "Cannot spill to a stack arg"
+        | spill (a as X.REL _, xreg) = [X.MOV (a, X.REG xreg)]

         | spill _ = nil                (* Nothing else can be spilled. *)
       fun unspill (X.TEMP temp, xreg: x86.reg) =       (* Unspill a register if need be. *)
         if (isspilled (X.TEMP temp))
         | spill _ = nil                (* Nothing else can be spilled. *)
       fun unspill (X.TEMP temp, xreg: x86.reg) =       (* Unspill a register if need be. *)
         if (isspilled (X.TEMP temp))

-          then [X.MOVL (X.REG xreg, X.REL (X.RSP, stackpos (temptonum temp)))]
+          then [X.MOV (X.REG xreg, X.REL (X.RSP, stackpos (temptonum temp)))]

           else nil
           else nil

+        | unspill (X.STACKARG arg, xreg) = [X.MOV (X.REG xreg, X.REL (X.RSP, stacksz + 8 + (arg * 8)))]
+        | unspill (a as X.REL _, xreg) = [X.MOV (X.REG xreg, a)]

         | unspill _ = nil
       
       fun realoper (X.TEMP temp) = X.REG (temptoreg temp)      (* Makes a operand 'real'. *)
         | unspill _ = nil
       
       fun realoper (X.TEMP temp) = X.REG (temptoreg temp)      (* Makes a operand 'real'. *)

+        | realoper (X.STACKARG arg) = raise Spilled
+        | realoper (X.REL _) = raise Spilled

         | realoper r = r
         | realoper r = r

+

       fun stackoper (X.TEMP temp) =
             if not (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "stackoper on unspilled temp?"
             else X.REL (X.RSP, stackpos (temptonum temp))
       fun stackoper (X.TEMP temp) =
             if not (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "stackoper on unspilled temp?"
             else X.REL (X.RSP, stackpos (temptonum temp))

+        | stackoper (X.STACKARG arg) = X.REL (X.RSP, stacksz + 8 + (arg * 8))
+        | stackoper (a as X.REL _) = a

         | stackoper _ = raise ErrorMsg.InternalError "stackoper on not temp?"
       
       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
         | transform (X.COMMENT s) = [X.COMMENT s]
         | stackoper _ = raise ErrorMsg.InternalError "stackoper on not temp?"
       
       fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
         | transform (X.COMMENT s) = [X.COMMENT s]

-        | transform (X.MOVL (dest, src)) =
+        | transform (X.LIVEIGN a) = transform a
+        | transform (X.SIZE (s, i)) = map (fn i' => (X.SIZE (s, i'))) (transform i)
+        | transform (X.MOV (dest, src)) =

             if (isspilled dest)
             then
               unspill (src, spillreg1) @
             if (isspilled dest)
             then
               unspill (src, spillreg1) @

-              [ X.MOVL(
+              [X.MOV(

                   realoper dest handle Spilled => stackoper dest,
                   realoper src handle Spilled => X.REG spillreg1)]
             else
                   realoper dest handle Spilled => stackoper dest,
                   realoper src handle Spilled => X.REG spillreg1)]
             else

-              [ X.MOVL(
+              [X.MOV(

                   realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
                   realoper src handle Spilled => stackoper src)]
                   realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
                   realoper src handle Spilled => stackoper src)]

-        | transform (X.SUBL (dest, src)) =
+        | transform (X.SUB (dest, src)) =

             unspill (src, spillreg1) @
             unspill (src, spillreg1) @

-            [ X.SUBL(
+            [ X.SUB(

                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
         | transform (X.IMUL (dest, src)) =
                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
         | transform (X.IMUL (dest, src)) =


@@ -102,47 +140,47 @@ struct
                 realoper src handle Spilled => stackoper src,
                 const)] @
             spill (dest, spillreg1)
                 realoper src handle Spilled => stackoper src,
                 const)] @
             spill (dest, spillreg1)

-        | transform (X.ADDL (dest, src)) =     (* You can have either operand spilled, but not both. Pick one. *)
+        | transform (X.ADD (dest, src)) =      (* You can have either operand spilled, but not both. Pick one. *)

             if (isspilled dest)
             then
               unspill (src, spillreg1) @
             if (isspilled dest)
             then
               unspill (src, spillreg1) @

-              [ X.ADDL(
+              [ X.ADD(

                   realoper dest handle Spilled => stackoper dest,
                   realoper src handle Spilled => X.REG spillreg1)]
             else
                   realoper dest handle Spilled => stackoper dest,
                   realoper src handle Spilled => X.REG spillreg1)]
             else

-              [ X.ADDL(
+              [ X.ADD(

                   realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
                   realoper src handle Spilled => stackoper src)]
                   realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
                   realoper src handle Spilled => stackoper src)]

-        | transform (X.IDIVL (src)) = [ X.IDIVL(realoper src handle Spilled => stackoper src)]
+        | transform (X.IDIV (src)) = [ X.IDIV(realoper src handle Spilled => stackoper src)]

         | transform (X.NEG (src)) = [ X.NEG(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 (
+        | transform (X.NOT (src)) = [ X.NOT(realoper src handle Spilled => stackoper src)]
+        | transform (X.SAL (dest, shft)) =
+            [ X.SAL (

                 realoper dest handle Spilled => stackoper dest,
                 shft)]
                 realoper dest handle Spilled => stackoper dest,
                 shft)]

-        | transform (X.SARL (dest, shft)) =
-            [ X.SARL (
+        | transform (X.SAR (dest, shft)) =
+            [ X.SAR (

                 realoper dest handle Spilled => stackoper dest,
                 shft)]
         | transform (X.CLTD) = [ X.CLTD ]
                 realoper dest handle Spilled => stackoper dest,
                 shft)]
         | transform (X.CLTD) = [ X.CLTD ]

-        | transform (X.ANDL (dest, src)) =
+        | transform (X.AND (dest, src)) =

             unspill (src, spillreg1) @
             unspill (src, spillreg1) @

-            [ X.ANDL(
+            [ X.AND(

                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]

-        | transform (X.ORL (dest, src)) =
+        | transform (X.OR (dest, src)) =

             unspill (src, spillreg1) @
             unspill (src, spillreg1) @

-            [ X.ORL(
+            [ X.OR(

                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]

-        | transform (X.XORL (dest, src)) =
+        | transform (X.XOR (dest, src)) =

             unspill (src, spillreg1) @
             unspill (src, spillreg1) @

-            [ X.XORL(
+            [ X.XOR(

                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]
                 realoper dest handle Spilled => stackoper dest,
                 realoper src handle Spilled => X.REG spillreg1)]

-        | transform (X.CMPL (op1, op2)) =
+        | transform (X.CMP (op1, op2)) =

             unspill (op2, spillreg1) @
             unspill (op2, spillreg1) @

-            [ X.CMPL(
+            [ X.CMP(

                 realoper op1 handle Spilled => stackoper op1,
                 realoper op2 handle Spilled => X.REG spillreg1)]
         | transform (X.TEST (op1, op2)) =
                 realoper op1 handle Spilled => stackoper op1,
                 realoper op2 handle Spilled => X.REG spillreg1)]
         | transform (X.TEST (op1, op2)) =


@@ -150,25 +188,21 @@ struct
             [ X.TEST(
                 realoper op1 handle Spilled => stackoper op1,
                 realoper op2 handle Spilled => X.REG 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(
+        | transform (X.SETcc (c,src)) = [ X.SETcc(c, realoper src handle Spilled => stackoper src)]
+        | transform (X.CALL l) = [ X.CALL l ]
+        | transform (X.MOVZB (dest, src)) =
+            [ X.MOVZB(

                 realoper dest handle Spilled => X.REG spillreg1,
                 realoper src handle Spilled => stackoper src)]
             @ spill (dest, spillreg1)
                 realoper dest handle Spilled => X.REG spillreg1,
                 realoper src handle Spilled => stackoper src)]
             @ spill (dest, spillreg1)

-        | transform (X.RET) = epilogue @ [X.RET]
+        | transform (X.RET) = if nsave < 2 then (epilogue @ [X.RET]) else [X.JMP endlbl]

         | transform (X.LABEL l) = [ X.LABEL l ]
         | transform (X.JMP l) = [ X.JMP l ]
         | 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")*)
+        | transform (X.Jcc (c,l)) = [X.Jcc (c,l)]

     in
     in

-      List.concat (prologue :: (map transform instrs))
-         
+      if (nsave < 2) then
+        List.concat (prologue :: (map transform instrs))
+      else
+        List.concat (prologue :: ((map transform instrs) @ [[X.LABEL endlbl], epilogue, [X.RET]]))

     end
 end
     end
 end

diff --git a/codegen/stringifier.sml b/codegen/stringifier.sml
index 5cb2113e75072f683e95f1879ae50f9ea92b29e8..74fe8c15b046cd4be77dfeeb22d98da862ea62ac 100644 (file)
--- a/codegen/stringifier.sml
+++ b/codegen/stringifier.sml
@@ -1,4 +1,4 @@
-(* L2 compiler
+(* L3 compiler

  * stringifier
  * turns a list of x86 insns into the assembly code to generate them
  * Author: Chris Lu <czl@andrew.cmu.edu>
  * stringifier
  * turns a list of x86 insns into the assembly code to generate them
  * Author: Chris Lu <czl@andrew.cmu.edu>


@@ -7,7 +7,7 @@
 signature STRINGIFY =
 sig
   type asm = x86.insn list
 signature STRINGIFY =
 sig
   type asm = x86.insn list

-  val stringify : asm -> string
+  val stringify : (string -> string) -> asm -> string

 end
 
 structure Stringify :> STRINGIFY =
 end
 
 structure Stringify :> STRINGIFY =


@@ -18,42 +18,10 @@ struct
   (* val stringify : asm -> string
    * turns a x86 instruction list into a string of assembly code for these instructions *)
 
   (* 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.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"
+  fun stringify' rn (X.CALL (l, n)) = X.prettyprint X.Long (X.CALL ((Symbol.symbol (rn (Symbol.name l))), n))
+    | stringify' rn x = X.prettyprint X.Long x

 
   (* val stringify : asm -> string *)
 
   (* val stringify : asm -> string *)

-  fun stringify l = foldr (fn (a,b) => (stringify' a) ^ b) ("") l
+  fun stringify realname l = foldr (fn (a,b) => (stringify' realname a) ^ b) ("") l

 
 end
 
 end

diff --git a/codegen/x86.sml b/codegen/x86.sml
index 33ddd60914bbe880e36904ace59226e6a7edf097..6ec426375fccc37b37c302cbdc1f84674085a742 100644 (file)
--- a/codegen/x86.sml
+++ b/codegen/x86.sml
@@ -1,4 +1,4 @@
-(* L2 compiler
+(* L3 compiler

  * X86 instruction/operand internal representation and manipulation
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  * Author: Chris Lu <czl@andrew.cmu.edu>
  * X86 instruction/operand internal representation and manipulation
  * Author: Joshua Wise <jwise@andrew.cmu.edu>
  * Author: Chris Lu <czl@andrew.cmu.edu>


@@ -10,138 +10,143 @@ sig
   datatype reg =
     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
   (* operands to instructions *)
   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 oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int) | STACKARG of int | STR of string
+  datatype cc = E | NE | GE | LE | L | G
+  datatype size = Byte | Word | Long | Qword
+  (* instructions *)

   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |

-    MOVL of oper * oper |
-    SUBL of oper * oper |
+    SIZE of size * insn |
+    MOV of oper * oper |
+    SUB of oper * oper |

     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |

-    ADDL of oper * oper |
-    IDIVL of oper |
+    ADD of oper * oper |
+    IDIV of oper |

     NEG 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 |
+    NOT of oper |
+    SAL of oper * oper |
+    SAR of oper * oper |
+    AND of oper * oper |
+    OR of oper * oper |
+    XOR of oper * oper |
+    CMP of oper * oper |

     TEST 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 |
+    SETcc of cc * oper |

     JMP of Label.label |
     JMP of Label.label |

-    JE of Label.label |
-    JNE of Label.label |
-    MOVZBL of oper * oper |
+    Jcc of cc * Label.label |
+    CALL of Symbol.symbol * int |
+    MOVZB of oper * oper |

     CLTD |
     CLTD |

+    LIVEIGN of insn |

     RET
   
     RET
   

+  structure OperSet : ORD_SET
+    where type Key.ord_key = oper;
+  structure LiveMap : ORD_MAP
+    where type Key.ord_key = int;
+  

   val cmpoper : oper * oper -> order
   val opereq : oper * oper -> bool
   val cmpoper : oper * oper -> order
   val opereq : oper * oper -> bool

-  val regname : reg -> string
-  val regnameb : reg -> string
+  val regname : size -> reg -> string

   val regtonum : reg -> int
   val numtoreg : int -> reg
   val regtonum : reg -> int
   val numtoreg : int -> reg

-  val prettyprint_oper : oper -> string
-  val prettyprint_operb : oper -> string
-  val prettyprint : insn -> string
+  val ccname : cc -> string
+  val opsused : insn list -> OperSet.set
+  val prettyprint_oper : size -> oper -> string
+  val prettyprint : size -> insn -> string

 end
 
 structure x86 :> X86 =
 struct
 end
 
 structure x86 :> X86 =
 struct

+
+

   datatype reg =
     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D
   datatype reg =
     EAX | EBX | ECX | EDX | ESI | EDI | EBP | RSP | R8D | R9D | R10D | R11D | R12D | R13D | R14D | R15D

-  datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int)
+  datatype oper = REG of reg | TEMP of Temp.temp | CONST of Word32.word | REL of (reg * int) | STACKARG of int | STR of string
+  datatype cc = E | NE | GE | LE | L | G
+  datatype size = Byte | Word | Long | Qword

   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |
   datatype insn =
     DIRECTIVE of string |
     COMMENT of string |
     LABEL of Label.label |

-    MOVL of oper * oper |
-    SUBL of oper * oper |
+    SIZE of size * insn |
+    MOV of oper * oper |
+    SUB of oper * oper |

     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |
     IMUL of oper * oper |
     IMUL3 of oper * oper * Word32.word |

-    ADDL of oper * oper |
-    IDIVL of oper |
+    ADD of oper * oper |
+    IDIV of oper |

     NEG 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 |
+    NOT of oper |
+    SAL of oper * oper |
+    SAR of oper * oper |
+    AND of oper * oper |
+    OR of oper * oper |
+    XOR of oper * oper |
+    CMP of oper * oper |

     TEST 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 |
+    SETcc of cc * oper |

     JMP of Label.label |
     JMP of Label.label |

-    JE of Label.label |
-    JNE of Label.label |
-    MOVZBL of oper * oper |
+    Jcc of cc * Label.label |
+    CALL of Symbol.symbol * int |
+    MOVZB of oper * oper |

     CLTD |
     CLTD |

+    LIVEIGN of insn |

     RET
     RET

+  
+  type func = Ast.ident * insn list

 
   (* gives name of reg *)
 
   (* gives name of reg *)

-  fun regname EAX = "eax"
-    | regname EBX = "ebx"
-    | regname ECX = "ecx"
-    | regname EDX = "edx"
-    | regname ESI = "esi"
-    | regname EDI = "edi"
-    | regname EBP = "ebp"
-    | regname RSP = "rsp"
-    | regname R8D = "r8d"
-    | regname R9D = "r9d"
-    | regname R10D = "r10d"
-    | regname R11D = "r11d"
-    | regname R12D = "r12d"
-    | regname R13D = "r13d"
-    | regname R14D = "r14d"
-    | regname R15D = "r15d"
+  val regnames =
+    [ (EAX, ("al", "ax", "eax", "rax")),
+      (EBX, ("bl", "bx", "ebx", "rbx")),
+      (ECX, ("cl", "cx", "ecx", "rcx")),
+      (EDX, ("dl", "dx", "edx", "rdx")),
+      (ESI, ("sil", "si", "esi", "rsi")),
+      (EDI, ("dil", "di", "edi", "rdi")),
+      (EBP, ("bpl", "bp", "ebp", "rbp")),
+      (RSP, ("spl", "sp", "esp", "rsp")),
+      (R8D, ("r8b", "r8w", "r8d", "r8")),
+      (R9D, ("r9b", "r9w", "r9d", "r9")),
+      (R10D, ("r10b", "r10w", "r10d", "r10")),
+      (R11D, ("r11b", "r11w", "r11d", "r11")),
+      (R12D, ("r12b", "r12w", "r12d", "r12")),
+      (R13D, ("r13b", "r13w", "r13d", "r13")),
+      (R14D, ("r14b", "r14w", "r14d", "r14")),
+      (R15D, ("r15b", "r15w", "r15d", "r15")) ];

 
 

-  (* 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"
+  fun regname sz reg =
+    let
+      val (n, (b, w, l, q)) = valOf (List.find (fn (r, _) => r = reg) regnames)
+    in
+      case sz
+      of Byte => b
+       | Word => w
+       | Long => l
+       | Qword => q
+    end
+
+  fun ccname E  = "e"
+    | ccname NE = "ne"
+    | ccname GE = "ge"
+    | ccname LE = "le"
+    | ccname G  = "g"
+    | ccname L  = "l"

 
   (* gives number (color) associated with reg *)
   fun regtonum EAX = 0
 
   (* gives number (color) associated with reg *)
   fun regtonum EAX = 0

-    | regtonum EBX = 1
-    | regtonum ECX = 2
-    | regtonum EDX = 3
-    | regtonum ESI = 4
-    | regtonum EDI = 5
-    | regtonum R8D = 6
-    | regtonum R9D = 7
-    | regtonum R10D = 8
-    | regtonum R11D = 9
+    | regtonum ESI = 1
+    | regtonum EDI = 2
+    | regtonum ECX = 3
+    | regtonum R8D = 4
+    | regtonum R9D = 5
+    | regtonum EDX = 6
+    | regtonum R10D = 7
+    | regtonum R11D = 8
+    | regtonum EBX = 9

     | regtonum R12D = 10
     | regtonum R13D = 11
     | regtonum R14D = 12
     | regtonum R12D = 10
     | regtonum R13D = 11
     | regtonum R14D = 12


@@ -151,15 +156,15 @@ struct
 
   (* gives reg associated with number (color) *)
   fun numtoreg 0 = EAX
 
   (* gives reg associated with number (color) *)
   fun numtoreg 0 = EAX

-    | numtoreg 1 = EBX
-    | numtoreg 2 = ECX
-    | numtoreg 3 = EDX
-    | numtoreg 4 = ESI
-    | numtoreg 5 = EDI
-    | numtoreg 6 = R8D
-    | numtoreg 7 = R9D
-    | numtoreg 8 = R10D
-    | numtoreg 9 = R11D
+    | numtoreg 1 = ESI
+    | numtoreg 2 = EDI
+    | numtoreg 3 = ECX
+    | numtoreg 4 = R8D
+    | numtoreg 5 = R9D
+    | numtoreg 6 = EDX
+    | numtoreg 7 = R10D
+    | numtoreg 8 = R11D
+    | numtoreg 9 = EBX

     | numtoreg 10 = R12D
     | numtoreg 11 = R13D
     | numtoreg 12 = R14D
     | numtoreg 10 = R12D
     | numtoreg 11 = R13D
     | numtoreg 12 = R14D


@@ -188,7 +193,51 @@ struct
     | cmpoper (REL _, _) = LESS
     | cmpoper (_, _) = GREATER
 
     | cmpoper (REL _, _) = LESS
     | cmpoper (_, _) = GREATER
 

-  fun opereq (a, b) = cmpoper (a, b) = EQUAL
+  fun opereq (REG a, REG b) = a = b
+    | opereq (TEMP a, TEMP b) = Temp.eq (a, b)
+    | opereq (CONST a, CONST b) = a = b
+    | opereq (REL (ra, ia), REL (rb, ib)) = (ra = rb) andalso (ia = ib)
+    | opereq (_, _) = false
+    
+  structure OperSet = ListSetFn (
+    struct
+      type ord_key = oper
+      val compare = cmpoper
+    end)
+  
+  structure LiveMap = SplayMapFn(struct
+                                   type ord_key = int
+                                   val compare = Int.compare
+                                 end)
+  
+  fun opsused nil = OperSet.empty
+    | opsused ((DIRECTIVE _)::l) = opsused l
+    | opsused ((COMMENT _)::l) = opsused l
+    | opsused ((LABEL _)::l) = opsused l
+    | opsused ((MOV (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((SUB (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((IMUL (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((IMUL3 (dst, src, _))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((ADD (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((IDIV (src))::l) = OperSet.addList (opsused l, [src, REG EDX, REG EAX])
+    | opsused ((NEG (dst))::l) = OperSet.addList (opsused l, [dst])
+    | opsused ((NOT (dst))::l) = OperSet.addList (opsused l, [dst])
+    | opsused ((SAL (dst, shft))::l) = OperSet.addList (opsused l, [dst, shft])
+    | opsused ((SAR (dst, shft))::l) = OperSet.addList (opsused l, [dst, shft])
+    | opsused ((AND (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((OR (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((XOR (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((CMP (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((TEST (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((SETcc (c, dst))::l) = OperSet.addList (opsused l, [dst])
+    | opsused ((JMP _)::l) = opsused l
+    | opsused ((Jcc _)::l) = opsused l
+    | opsused ((CALL _)::l) = opsused l
+    | opsused ((MOVZB (dst, src))::l) = OperSet.addList (opsused l, [dst, src])
+    | opsused ((CLTD)::l) = opsused l
+    | opsused ((RET)::l) = opsused l
+    | opsused ((LIVEIGN i)::l) = opsused (i::l)
+    | opsused ((SIZE (_, i))::l) = opsused (i::l)

 
   (* integer tostring, except with more - and less ~ *)
   fun moreDifferentToString (i) =
 
   (* integer tostring, except with more - and less ~ *)
   fun moreDifferentToString (i) =


@@ -196,47 +245,45 @@ struct
        else "-" ^ (Int.toString (~i))
 
   (* pretty prints an operand *)  
        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
+  fun sfx Byte = "b"
+    | sfx Word = "w"
+    | sfx Long = "l"
+    | sfx Qword = "q"
+  
+  fun prettyprint_oper s (REG r) = "%" ^ (regname s r)
+    | prettyprint_oper s (TEMP t) = (Temp.name t) ^ (sfx s)
+    | prettyprint_oper _ (CONST c) = "$0x" ^ (Word32.toString c)
+    | prettyprint_oper _ (REL (r, i)) = (moreDifferentToString i) ^ "(%" ^ (regname Qword r) ^ ")"
+    | prettyprint_oper _ (STR s) = s
+    | prettyprint_oper _ (STACKARG i) = "arg#"^Int.toString i

 
   (* pretty prints (no...) *)
 
   (* 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 (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")*)
+  fun prettyprint s (DIRECTIVE(str)) = str ^ "\n"
+    | prettyprint s (COMMENT(str)) = "// " ^ str ^ "\n"
+    | prettyprint s (LABEL(l)) = Label.name l ^ ":\n"
+    | prettyprint s (MOV(dst, src)) = "\tmov" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (SUB(dst, src)) = "\tsub" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (IMUL(dst, src)) = "\timul\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (IMUL3(dst, tmp, const)) = "\timul\t" ^ (prettyprint_oper s (CONST const)) ^ ", " ^ (prettyprint_oper s tmp) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (ADD(dst, src)) = "\tadd" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (IDIV(src)) = "\tidiv" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ "\n"
+    | prettyprint s (NEG (dst)) = "\tneg" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (NOT (dst)) = "\tnot" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (SAL (dst, shft)) = "\tsal" ^ (sfx s) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (SAR (dst, shft)) = "\tsar" ^ (sfx s) ^ "\t" ^ (prettyprint_oper Byte shft) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (AND (dst, src)) = "\tand" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (OR (dst, src)) = "\tor" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (XOR (dst, src)) = "\txor" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (CMP (dst, src)) = "\tcmp" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (TEST (dst, src)) = "\ttest" ^ (sfx s) ^ "\t" ^ (prettyprint_oper s src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (SETcc (c, dst)) = "\tset" ^ (ccname c) ^ "\t" ^ (prettyprint_oper Byte dst) ^ "\n"
+    | prettyprint s (JMP (label)) = "\tjmp\t" ^ (Label.name label) ^ "\n"
+    | prettyprint s (Jcc (c,label)) = "\tj" ^ (ccname c) ^ "\t" ^ (Label.name label) ^ "\n"
+    | prettyprint s (CALL (l,n)) = "\tcall\t" ^ Symbol.name l ^ "\t # (" ^ Int.toString n ^ "args)\n"
+    | prettyprint s (MOVZB (dst, src)) = "\tmovzb" ^ (sfx s) ^ "\t" ^ (prettyprint_oper Byte src) ^ ", " ^ (prettyprint_oper s dst) ^ "\n"
+    | prettyprint s (CLTD) = "\tcltd\n"
+    | prettyprint s (RET) = "\tret\n"
+    | prettyprint s (LIVEIGN i) = prettyprint s i
+    | prettyprint _ (SIZE (s, i)) = prettyprint s i
+(*    | prettyprint _ = raise ErrorMsg.InternalError ("prettyprint: Type A? Hatchar de coneccion?")*)

 end
 end

diff --git a/compile-l2c.sml b/compile-l3c.sml
similarity index 63%
rename from compile-l2c.sml
rename to compile-l3c.sml
index 651b99f45646fe62248f52e8755f9228f4cf9ca7..a8f95ec4fa56bd4576a605142d5169fee8fbff7c 100644 (file)
--- a/compile-l2c.sml
+++ b/compile-l3c.sml
@@ -1,7 +1,7 @@
-(* L1 Compiler
+(* L3 Compiler

  * Helper for compilation
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  *)
 
 CM.make "sources.cm";
  * Helper for compilation
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  *)
 
 CM.make "sources.cm";

-SMLofNJ.exportFn ("bin/l2c.heap", Top.main);
+SMLofNJ.exportFn ("bin/l3c.heap", Top.main);

diff --git a/parse/ast.sml b/parse/ast.sml
index ec538808be4c0eb5b40555154de402072cc8cba6..fce70ab9d9e69275415d4acdf39563621bece8b2 100644 (file)
--- a/parse/ast.sml
+++ b/parse/ast.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler

  * Abstract Syntax Trees
  * Author: Alex Vaynberg
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
  * Abstract Syntax Trees
  * Author: Alex Vaynberg
  * Modified: Frank Pfenning <fp@cs.cmu.edu>


@@ -12,6 +12,9 @@
 signature AST =
 sig
   type ident = Symbol.symbol
 signature AST =
 sig
   type ident = Symbol.symbol

+  
+  datatype vtype = Int
+  type variable = ident * vtype

 
   datatype oper = 
      PLUS
 
   datatype oper = 
      PLUS


@@ -41,6 +44,7 @@ sig
    | ConstExp of Word32.word
    | OpExp of oper * exp list
    | Marked of (* Kane *) exp Mark.marked
    | ConstExp of Word32.word
    | OpExp of oper * exp list
    | Marked of (* Kane *) exp Mark.marked

+   | FuncCall of ident * (exp list)

   and stm =
      Assign of ident * exp
    | Return of exp
   and stm =
      Assign of ident * exp
    | Return of exp


@@ -52,7 +56,11 @@ sig
    | While of exp * stm list
    | MarkedStm of stm Mark.marked
 
    | While of exp * stm list
    | MarkedStm of stm Mark.marked
 

-  type program = stm list
+  datatype function =
+     Extern of vtype * ident * (variable list)
+   | Function of vtype * ident * (variable list) * (variable list) * stm list
+  
+  type program = function list

 
   (* print as source, with redundant parentheses *)
   structure Print :
 
   (* print as source, with redundant parentheses *)
   structure Print :


@@ -68,6 +76,9 @@ structure Ast :> AST =
 struct
   type ident = Symbol.symbol
 
 struct
   type ident = Symbol.symbol
 

+  datatype vtype = Int
+  type variable = ident * vtype
+

   datatype oper = 
      PLUS
    | MINUS
   datatype oper = 
      PLUS
    | MINUS


@@ -96,6 +107,7 @@ struct
    | ConstExp of Word32.word
    | OpExp of oper * exp list
    | Marked of exp Mark.marked
    | ConstExp of Word32.word
    | OpExp of oper * exp list
    | Marked of exp Mark.marked

+   | FuncCall of ident * (exp list)

   and stm =
      Assign of ident * exp
    | Return of exp
   and stm =
      Assign of ident * exp
    | Return of exp


@@ -107,7 +119,11 @@ struct
    | While of exp * stm list
    | MarkedStm of stm Mark.marked
 
    | While of exp * stm list
    | MarkedStm of stm Mark.marked
 

-  type program = stm list
+  datatype function =
+     Extern of vtype * ident * (variable list)
+   | Function of vtype * ident * (variable list) * (variable list) * stm list
+  
+  type program = function list

 
   (* print programs and expressions in source form
    * using redundant parentheses to clarify precedence
 
   (* print programs and expressions in source form
    * using redundant parentheses to clarify precedence


@@ -147,8 +163,13 @@ struct
          ^ " " ^ pp_exp e2 ^ ")"
       | pp_exp (OpExp(oper, _)) =
           pp_oper oper
          ^ " " ^ pp_exp e2 ^ ")"
       | pp_exp (OpExp(oper, _)) =
           pp_oper oper

+      | pp_exp (FuncCall(id, l)) = pp_ident id ^ "(" ^ pp_expl l ^ ")"

       | pp_exp (Marked(marked_exp)) =
          pp_exp (Mark.data marked_exp)
       | pp_exp (Marked(marked_exp)) =
          pp_exp (Mark.data marked_exp)

+    
+    and pp_expl nil = ""
+      | pp_expl (e::a::l) = (pp_exp e) ^ ", " ^ (pp_expl (a::l))
+      | pp_expl (e::l) = (pp_exp e) ^ (pp_expl l)

 
     fun pp_stm (Assign (id,e)) =
        pp_ident id ^ " = " ^ pp_exp e ^ ";"
 
     fun pp_stm (Assign (id,e)) =
        pp_ident id ^ " = " ^ pp_exp e ^ ";"


@@ -168,12 +189,24 @@ struct
       | pp_block (l) = let
           val contents = map pp_stm l
         in
       | pp_block (l) = let
           val contents = map pp_stm l
         in

-          "{" ^ String.concat contents ^ "}"
+          "{\n" ^ String.concat contents ^ "}\n"

         end
 
         end
 

-    fun pp_stms nil = ""
+    and pp_stms nil = ""

       | pp_stms (s::ss) = pp_stm s ^ "\n" ^ pp_stms ss
       | pp_stms (s::ss) = pp_stm s ^ "\n" ^ pp_stms ss

-
-    fun pp_program ss = "{\n" ^ pp_stms ss ^ "}"
+    
+    and pp_type Int = "int"
+    
+    and pp_params nil = ""
+      | pp_params ((i, t)::a::l) = (pp_ident i) ^ " : " ^ (pp_type t) ^ ", " ^ (pp_params (a::l))
+      | pp_params ((i, t)::l) = (pp_ident i) ^ " : " ^ (pp_type t) ^ (pp_params l)
+    
+    and pp_vars nil = ""
+      | pp_vars ((i, t)::l) = "var " ^ (pp_ident i) ^ " : " ^ (pp_type t) ^ ";\n" ^ (pp_vars l)
+
+    and pp_function (Extern(t, n, pl)) = "extern " ^ (pp_type t) ^ " " ^ (pp_ident n) ^ "(" ^ (pp_params pl) ^ ");\n"
+      | pp_function (Function(t, n, pl, vl, stms)) = (pp_type t) ^ " " ^ (pp_ident n) ^ "(" ^ (pp_params pl) ^ ")\n{\n" ^ (pp_vars vl) ^ (String.concat (map pp_stm stms)) ^ "\n}\n"
+    
+    and pp_program (p) = String.concat (map pp_function p)

   end
 end
   end
 end

diff --git a/parse/l2.grm b/parse/l3.grm
similarity index 71%
rename from parse/l2.grm
rename to parse/l3.grm
index 6376e1cd2b978e2df0ded8e93d1f0577042c25b9..cbf92ea4306768a426f024bb942f7dfc579d7cc0 100644 (file)
--- a/parse/l2.grm
+++ b/parse/l3.grm
@@ -1,5 +1,5 @@
-(* L2 Compiler
- * L2 grammar
+(* L3 Compiler
+ * L3 grammar

  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
  * Modified: Joshua Wise <jwise@andrew.cmu.edu>
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
  * Modified: Joshua Wise <jwise@andrew.cmu.edu>


@@ -34,7 +34,7 @@ fun expand_asnop (exp1, NONE, exp2) (left, right) =
               mark(A.OpExp(oper, [exp1, exp2]), (left, right)))
 
 %%
               mark(A.OpExp(oper, [exp1, exp2]), (left, right)))
 
 %%

-%header (functor L2LrValsFn (structure Token : TOKEN))
+%header (functor L3LrValsFn (structure Token : TOKEN))

 
 %term 
    EOF
 
 %term 
    EOF


@@ -49,6 +49,7 @@ fun expand_asnop (exp1, NONE, exp2) (left, right) =
  | LBRACE | RBRACE
  | LPAREN | RPAREN
  | UNARY | ASNOP (* dummy *)
  | LBRACE | RBRACE
  | LPAREN | RPAREN
  | UNARY | ASNOP (* dummy *)

+ | EXTERN | VAR | INT | COLON | COMMA

 
 %nonterm 
    program of A.program
 
 %nonterm 
    program of A.program


@@ -57,11 +58,22 @@ fun expand_asnop (exp1, NONE, exp2) (left, right) =
  | simp of A.stm
  | return of A.stm
  | exp of A.exp
  | simp of A.stm
  | return of A.stm
  | exp of A.exp

+ | explist of A.exp list

  | 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
  | 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

+ | idents of A.ident list
+ | vtype of A.vtype
+ | extdecls of A.function list
+ | extdecl of A.function
+ | paramlist of A.variable list
+ | param of A.variable
+ | functions of A.function list
+ | function of A.function
+ | vardecl of A.variable list
+ | vardecls of A.variable list

 
 %verbose                                (* print summary of errors *)
 %pos int                                (* positions *)
 
 %verbose                                (* print summary of errors *)
 %pos int                                (* positions *)


@@ -69,7 +81,7 @@ fun expand_asnop (exp1, NONE, exp2) (left, right) =
 %eop EOF
 %noshift EOF
 
 %eop EOF
 %noshift EOF
 

-%name L2
+%name L3

 
 %left LOGOR
 %left LOGAND
 
 %left LOGOR
 %left LOGAND


@@ -86,15 +98,48 @@ fun expand_asnop (exp1, NONE, exp2) (left, right) =
 
 %%
 
 
 %%
 

-program    : LBRACE stms RBRACE
-                                    (stms)
+program    : extdecls functions     (extdecls @ functions)
+
+vtype      : INT                    (A.Int)
+
+extdecls   :                        ([])
+           | extdecl extdecls       (extdecl :: extdecls)
+
+extdecl    : EXTERN vtype IDENT LPAREN RPAREN SEMI
+                                    (A.Extern (vtype, IDENT, []))
+           | EXTERN vtype IDENT LPAREN param RPAREN SEMI
+                                    (A.Extern (vtype, IDENT, [param]))
+           | EXTERN vtype IDENT LPAREN paramlist RPAREN SEMI
+                                    (A.Extern (vtype, IDENT, paramlist))
+
+paramlist  : param COMMA paramlist  (param :: paramlist)
+           | param                  ([param])
+
+param      : IDENT COLON vtype      (IDENT, vtype)
+
+functions  :                        ([])
+           | function functions     (function :: functions)
+
+function   : vtype IDENT LPAREN RPAREN LBRACE vardecls stms RBRACE
+                                    (A.Function (vtype, IDENT, [], vardecls, stms))
+           | vtype IDENT LPAREN paramlist RPAREN LBRACE vardecls stms RBRACE
+                                    (A.Function (vtype, IDENT, paramlist, vardecls, stms))
+
+vardecls   :                        ([])
+           | vardecl vardecls       (vardecl @ vardecls)
+
+vardecl    : VAR idents COLON vtype SEMI
+                                    (map (fn x => (x, vtype)) idents)
+
+idents     : IDENT                  ([IDENT])
+           | IDENT COMMA idents     (IDENT :: idents)

 
 stms       :                        ([])
            | stm stms               (stm :: stms)
 
 
 stms       :                        ([])
            | stm stms               (stm :: stms)
 

-stm        : simp SEMI (simp)
-           | control (control)
-           | SEMI (A.Nop)
+stm        : simp SEMI              (simp)
+           | control                (control)
+           | SEMI                   (A.Nop)

 
 simp       : exp asnop exp %prec ASNOP
                                     (expand_asnop (exp1, asnop, exp2) (exp1left, exp2right))
 
 simp       : exp asnop exp %prec ASNOP
                                     (expand_asnop (exp1, asnop, exp2) (exp1left, exp2right))


@@ -139,10 +184,18 @@ exp        : LPAREN exp RPAREN      (exp)
            | 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)))
            | 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)))

+           | IDENT LPAREN RPAREN    (mark (A.FuncCall(IDENT, []), (IDENTleft, RPARENright)))
+           | IDENT LPAREN exp RPAREN
+                                    (mark (A.FuncCall(IDENT, [exp]), (IDENTleft, RPARENright)))
+           | IDENT LPAREN explist RPAREN
+                                    (mark (A.FuncCall(IDENT, explist), (IDENTleft, RPARENright)))

            | 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)))
 
            | 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)))
 

+explist    : exp                    ([exp])
+           | exp COMMA explist      (exp :: explist)
+

 asnop      : ASSIGN                (NONE)
            | PLUSEQ                (SOME(A.PLUS))
            | MINUSEQ               (SOME(A.MINUS))
 asnop      : ASSIGN                (NONE)
            | PLUSEQ                (SOME(A.PLUS))
            | MINUSEQ               (SOME(A.MINUS))

diff --git a/parse/l2.lex b/parse/l3.lex
similarity index 93%
rename from parse/l2.lex
rename to parse/l3.lex
index 9caa8e1a829e4fc91469f47a958c4002372af63a..d9c2217876c5e16338a8463a6a09bed4c6c20e5e 100644 (file)
--- a/parse/l2.lex
+++ b/parse/l3.lex
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler

  * Lexer
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
  * Lexer
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>


@@ -51,7 +51,7 @@ in
 end
 
 %%
 end
 
 %%

-%header (functor L2LexFn(structure Tokens : L2_TOKENS));
+%header (functor L3LexFn(structure Tokens : L3_TOKENS));

 %full
 %s COMMENT COMMENT_LINE;
 
 %full
 %s COMMENT COMMENT_LINE;
 


@@ -105,6 +105,9 @@ ws = [\ \t\012];
 <INITIAL> ">="        => (Tokens.GE (yypos, yypos + size yytext));
 <INITIAL> ">"         => (Tokens.GT (yypos, yypos + size yytext));
 
 <INITIAL> ">="        => (Tokens.GE (yypos, yypos + size yytext));
 <INITIAL> ">"         => (Tokens.GT (yypos, yypos + size yytext));
 

+<INITIAL> ":"         => (Tokens.COLON (yypos, yypos + size yytext));
+<INITIAL> ","         => (Tokens.COMMA (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> "return"    => (Tokens.RETURN (yypos, yypos + size yytext));
 <INITIAL> "if"        => (Tokens.IF (yypos, yypos + size yytext));
 <INITIAL> "while"     => (Tokens.WHILE (yypos, yypos + size yytext));


@@ -112,6 +115,10 @@ ws = [\ \t\012];
 <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> "continue"  => (Tokens.CONTINUE (yypos, yypos + size yytext));
 <INITIAL> "break"     => (Tokens.BREAK (yypos, yypos + size yytext));
 <INITIAL> "else"      => (Tokens.ELSE (yypos, yypos + size yytext));

+<INITIAL> "var"       => (Tokens.VAR (yypos, yypos + size yytext));
+<INITIAL> "int"       => (Tokens.INT (yypos, yypos + size yytext));
+<INITIAL> "extern"    => (Tokens.EXTERN (yypos, yypos + size yytext));
+

 
 <INITIAL> {decnum}    => (number (yytext, yypos));
 
 
 <INITIAL> {decnum}    => (number (yytext, yypos));
 

diff --git a/parse/parse.sml b/parse/parse.sml
index 1fc612f9727fba19963e2f91548cbb76a0cd9e0a..aa701c41c89903b298b0f40d0c8aae4d3fb544d0 100644 (file)
--- a/parse/parse.sml
+++ b/parse/parse.sml
@@ -1,4 +1,4 @@
-(* L1 Compiler
+(* L3 Compiler

  * Parsing
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
  * Parsing
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>


@@ -17,10 +17,10 @@ end
 structure Parse :> PARSE =
 struct 
 
 structure Parse :> PARSE =
 struct 
 

-  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 L3LrVals = L3LrValsFn (structure Token = LrParser.Token)
+  structure L3Lex = L3LexFn (structure Tokens = L3LrVals.Tokens)
+  structure L3Parse = Join (structure ParserData = L3LrVals.ParserData
+                            structure Lex = L3Lex

                             structure LrParser = LrParser)
 
   (* Main parsing function *)
                             structure LrParser = LrParser)
 
   (* Main parsing function *)


@@ -31,9 +31,9 @@ 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
          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

-                         (L2Lex.makeLexer (fn _ => TextIO.input instream))
+                         (L3Lex.makeLexer (fn _ => TextIO.input instream))

          (* 0 = no error correction, 15 = reasonable lookahead for correction *)
          (* 0 = no error correction, 15 = reasonable lookahead for correction *)

-         val (absyn, _) = L2Parse.parse(0, lexer, parseerror, ())
+         val (absyn, _) = L3Parse.parse(0, lexer, parseerror, ())

           val _ = if !ErrorMsg.anyErrors
                  then raise ErrorMsg.Error
                  else ()
           val _ = if !ErrorMsg.anyErrors
                  then raise ErrorMsg.Error
                  else ()


@@ -41,7 +41,7 @@ struct
          absyn
        end)
       handle Fail s => ( ErrorMsg.error NONE ("lexer error: "^s) ;
          absyn
        end)
       handle Fail s => ( ErrorMsg.error NONE ("lexer error: "^s) ;

-                        raise ErrorMsg.Error )
+                        raise ErrorMsg.Error )

           | LrParser.ParseError => raise ErrorMsg.Error (* always preceded by msg *)
            | e as IO.Io _ => ( ErrorMsg.error NONE (exnMessage e);
                                raise ErrorMsg.Error )
           | LrParser.ParseError => raise ErrorMsg.Error (* always preceded by msg *)
            | e as IO.Io _ => ( ErrorMsg.error NONE (exnMessage e);
                                raise ErrorMsg.Error )

diff --git a/parse/parsestate.sml b/parse/parsestate.sml
index 5e27137f541e9de1960fee381359fcc734cbff30..2ce6fd62018b3ed4150ff2f6bbb865df77a971a9 100644 (file)
--- a/parse/parsestate.sml
+++ b/parse/parsestate.sml
@@ -1,4 +1,4 @@
-(* L1 Compiler
+(* L3 Compiler

  * Parse State System
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Annotations: Alex Vaynberg <alv@andrew.cmu.edu>
  * Parse State System
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Annotations: Alex Vaynberg <alv@andrew.cmu.edu>

diff --git a/sources.cm b/sources.cm
index fb9b604320e73f4902cb5b9ff55629cd78a23502..3dd6fa104e268220fdf873996a58675e5d1cecf0 100644 (file)
--- a/sources.cm
+++ b/sources.cm
@@ -12,25 +12,27 @@ Group is
 
        parse/ast.sml
        parse/parsestate.sml
 
        parse/ast.sml
        parse/parsestate.sml

-       parse/l2.lex
-       parse/l2.grm
+       parse/l3.lex
+       parse/l3.grm

        parse/parse.sml
 
        type/typechecker.sml
 
        trans/temp.sml
        parse/parse.sml
 
        type/typechecker.sml
 
        trans/temp.sml

+

         trans/label.sml
        trans/tree.sml
        trans/trans.sml
 
        codegen/x86.sml
         trans/label.sml
        trans/tree.sml
        trans/trans.sml
 
        codegen/x86.sml

+       codegen/codegen.sml
+

        codegen/igraph.sml
        codegen/colororder.sml
        codegen/solidify.sml
        codegen/coloring.sml
        codegen/stringifier.sml
        codegen/peephole.sml
        codegen/igraph.sml
        codegen/colororder.sml
        codegen/solidify.sml
        codegen/coloring.sml
        codegen/stringifier.sml
        codegen/peephole.sml

-       codegen/codegen.sml

        codegen/liveness.sml
 
        top/top.sml
        codegen/liveness.sml
 
        top/top.sml

diff --git a/sources.mlb b/sources.mlb
new file mode 100644 (file)
index 0000000..d97bba4
--- /dev/null
+++ b/sources.mlb
@@ -0,0 +1,38 @@
+$(SML_LIB)/basis/basis.mlb
+$(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb
+$(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
+
+       util/mark.sml
+       util/flag.sml
+       util/symbol.sml
+       util/errormsg.sml
+        util/safe-io.sml
+        util/word32.sml
+
+       parse/ast.sml
+       parse/parsestate.sml
+       parse/l3.grm.sig
+       parse/l3.grm.sml
+       parse/l3.lex.sml
+       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
+       codegen/coloring.sml
+       codegen/stringifier.sml
+       codegen/peephole.sml
+       codegen/codegen.sml
+
+       top/top.sml
+
+       top/top_mlton.sml
\ No newline at end of file

diff --git a/top/top.sml b/top/top.sml
index 35e03a68e287b9d92ec19dfa73066c2592df825a..5e564b18ad2e487f26b9b2d6b7ec557dd607a94d 100644 (file)
--- a/top/top.sml
+++ b/top/top.sml
@@ -1,4 +1,4 @@
-(* L1 Compiler
+(* L3 Compiler

  * Top Level Environment
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
  * Top Level Environment
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>


@@ -34,6 +34,7 @@ struct
   val flag_ast = Flag.flag "ast"
   val flag_ir = Flag.flag "ir"
   val flag_assem = Flag.flag "assem"
   val flag_ast = Flag.flag "ast"
   val flag_ir = Flag.flag "ir"
   val flag_assem = Flag.flag "assem"

+  val flag_color = Flag.flag "color"

 
   fun reset_flags () =
       List.app Flag.unset [flag_verbose, flag_ast,
 
   fun reset_flags () =
       List.app Flag.unset [flag_verbose, flag_ast,


@@ -53,7 +54,10 @@ struct
                   help="pretty print the liveness results"},
                  {short = "s", long=["dump-assem"],
                   desc=G.NoArg (fn () => Flag.set flag_assem),
                   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"}
+                  help="pretty print the assembly before register allocaction"},
+                 {short = "c", long=["dump-color"],
+                  desc=G.NoArg (fn () => Flag.set flag_color),
+                  help="pretty print the allocated regs"}

                 ]
 
 
                 ]
 
 


@@ -66,6 +70,73 @@ struct
              then s (* return whole string *)
           else Substring.string (Substring.trimr 1 prefix)
       end
              then s (* return whole string *)
           else Substring.string (Substring.trimr 1 prefix)
       end

+  
+  fun processir externs (Tree.FUNCTION (id, ir)) =
+      let
+        val name = "_l3_" ^ (Symbol.name id)
+        
+        fun realname s = if (List.exists (fn n => s = n) externs)
+                         then s
+                         else "_l3_" ^ s
+      
+        val _ = Flag.guard flag_verbose say ("Processing function: " ^ name)
+
+        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 x86.Long)) assem) ()
+
+        val _ = Flag.guard flag_verbose say "  Analyzing liveness..."
+        val (preds, liveness) = Liveness.liveness assem;
+        val _ = Flag.guard flag_liveness
+                  (fn () => List.app
+                    (fn (asm, liv) =>
+                      TextIO.print (
+                        let
+                          val xpp = x86.prettyprint x86.Long asm
+                          val xpp = String.extract (xpp, 0, SOME (size xpp - 1))
+                          val spaces = implode (List.tabulate (40 - size xpp, fn _ => #" ")) handle size => ""
+                          val lpp = Liveness.prettyprint liv
+                          val lpp = String.extract (lpp, 0, SOME (size lpp - 1))
+                          val spaces2 = implode (List.tabulate (40 - size lpp, fn _ => #" ")) handle size => ""
+                        in
+                          xpp ^ spaces ^ lpp ^ spaces2 ^ "\n"
+                        end))
+                    (ListPair.zip (assem, Liveness.listify liveness))) ()
+
+        val _ = Flag.guard flag_verbose say "  Graphing..."
+        val (igraph,temps) = Igraph.gengraph (preds, liveness)
+
+        val _ = Flag.guard flag_verbose say "  Ordering..."
+        val order = ColorOrder.colororder (igraph,temps)
+        
+        val _ = Flag.guard flag_verbose say "  Coloring..."
+        val colors = Colorizer.colorize order igraph;
+        val _ = Flag.guard flag_color
+                  (fn () => List.app (TextIO.print o
+                    (fn (t, i) =>
+                      (Temp.name t) ^ " => " ^ (
+                        if (i <= x86.regtonum x86.R14D)
+                          then (x86.prettyprint_oper x86.Long (x86.REG (x86.numtoreg i)))
+                        else
+                          "spill[" ^ Int.toString (i - x86.regtonum x86.R14D) ^ "]")
+                        ^ "--"^ Int.toString i ^ "\n"))
+                    colors) ()
+
+        val _ = Flag.guard flag_verbose say "  Solidifying x86_64 code..."
+        val x86 = Solidify.solidify colors assem;
+
+        val _ = Flag.guard flag_verbose say "  Peepholing..."
+        val x86p = Peephole.peephole x86;
+
+        val _ = Flag.guard flag_verbose say "  Stringifying..."
+        val x86d = [x86.DIRECTIVE(".globl " ^ name),
+                    x86.DIRECTIVE(name ^ ":")]
+                    @ x86p
+        val code = Stringify.stringify realname x86d
+      in
+        code
+      end

 
   fun main (name, args) =
       let
 
   fun main (name, args) =
       let


@@ -96,51 +167,25 @@ struct
         val ast = Parse.parse source
         val _ = Flag.guard flag_ast
                   (fn () => say (Ast.Print.pp_program ast)) ()
         val ast = Parse.parse source
         val _ = Flag.guard flag_ast
                   (fn () => say (Ast.Print.pp_program ast)) ()

-
+        
+        val externs = List.mapPartial 
+                        (fn (Ast.Function _) => NONE
+                          | (Ast.Extern (_, s, _)) => SOME (Symbol.name s)) ast
+        

         val _ = Flag.guard flag_verbose say "Checking..."
         val ast = TypeChecker.typecheck 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 "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;

         
         

-        val _ = Flag.guard flag_verbose say "Coloring..."
-        val colors = Colorizer.colorize order igraph;
-        
-        val _ = Flag.guard flag_verbose say "Solidifying x86_64 code..."
-        val x86 = Solidify.solidify colors assem;
-
-        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 _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 output = foldr (fn (func, code) => (processir externs func) ^ code) 
+          (".file\t\"" ^ source ^ "\"\n.ident\t\"15-411 L3 compiler by czl@ and jwise@\"\n") ir

 
         val afname = stem source ^ ".s"
         val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
         val _ = SafeIO.withOpenOut afname (fn afstream =>
 
         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))
+                   TextIO.output (afstream, output))

       in
           OS.Process.success
       end
       in
           OS.Process.success
       end

diff --git a/top/top_mlton.sml b/top/top_mlton.sml
new file mode 100644 (file)
index 0000000..3f6ea30
--- /dev/null
+++ b/top/top_mlton.sml
@@ -0,0 +1,5 @@
+val _ =
+  OS.Process.exit
+    (Top.main
+      (CommandLine.name (), CommandLine.arguments ())
+    )

diff --git a/trans/label.sml b/trans/label.sml
index 76041f49b9ce7d9983356a2eccc5206c2a57d458..3a6a14b64ab434808cb6ba2095ffcdd2744af7fa 100644 (file)
--- a/trans/label.sml
+++ b/trans/label.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler

  * Labeloraries
  * Like temporaries, except more different
  * Author: Joshua Wise <jwise@cs.cmu.edu>
  * Labeloraries
  * Like temporaries, except more different
  * Author: Joshua Wise <jwise@cs.cmu.edu>

diff --git a/trans/temp.sml b/trans/temp.sml
index 13411f1ab76e16c38a986059439f3a45802009a7..d370d99ccd470eb1c341697127bc7bf49e56996f 100644 (file)
--- a/trans/temp.sml
+++ b/trans/temp.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler

  * Temporaries
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
  * Temporaries
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>


@@ -10,24 +10,26 @@ sig
   type temp
 
   val reset : unit -> unit     (* resets temp numbering *)
   type temp
 
   val reset : unit -> unit     (* resets temp numbering *)

-  val new : unit -> temp       (* returns a unique new temp *)
+  val new : string -> temp     (* returns a unique new temp *)

   val name : temp -> string    (* returns the name of a temp *)
   val compare : temp * temp -> order (* comparison function *)
   val name : temp -> string    (* returns the name of a temp *)
   val compare : temp * temp -> order (* comparison function *)

+  val eq : temp * temp -> bool

 end
 
 structure Temp :> TEMP = 
 struct
 end
 
 structure Temp :> TEMP = 
 struct

-  type temp = int
+  type temp = int * string

 
   local
     val counter = ref 1
   in
     (* warning: calling reset() may jeopardize uniqueness of temps! *)
     fun reset () = ( counter := 1 )
 
   local
     val counter = ref 1
   in
     (* warning: calling reset() may jeopardize uniqueness of temps! *)
     fun reset () = ( counter := 1 )

-    fun new () = !counter before ( counter := !counter + 1 )
+    fun new str = (!counter, str) before ( counter := !counter + 1 )

   end
 
   end
 

-  fun name t = "+t" ^ Int.toString t
-                     
-  fun compare (t1,t2) = Int.compare (t1,t2)
+  fun name (t,s) = "+t" ^ Int.toString t ^ "[" ^ s ^ "]"
+  fun compare ((t1,_),(t2,_)) = Int.compare (t1,t2)
+
+  fun eq ((t1,_), (t2,_)) = t1 = t2

 end
 end

diff --git a/trans/trans.sml b/trans/trans.sml
index 57e5faa390eb894a12f3514a25164f4b82d376ff..80802be332d71daf4744d4458e2da0e93f7850d8 100644 (file)
--- a/trans/trans.sml
+++ b/trans/trans.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler

  * AST -> IR Translator
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified by: Alex Vaynberg <alv@andrew.cmu.edu>
  * AST -> IR Translator
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified by: Alex Vaynberg <alv@andrew.cmu.edu>


@@ -10,7 +10,7 @@
 signature TRANS =
 sig
   (* translate abstract syntax tree to IR tree *)
 signature TRANS =
 sig
   (* translate abstract syntax tree to IR tree *)

-  val translate : Ast.program -> Tree.stm list
+  val translate : Ast.program -> Tree.func list

 end
 
 structure Trans :> TRANS = 
 end
 
 structure Trans :> TRANS = 


@@ -38,121 +38,149 @@ struct
     | trans_oper A.GE = T.GE
     | trans_oper A.GT = T.GT
     | trans_oper _ = raise ErrorMsg.InternalError "expected AST binop, got AST unop"
     | 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 *)
-       T.TEMP (Symbol.look' env id)
-    | 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(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 *)
+  fun translate p =
+    let
+      val allfuncs = foldr (fn (A.Extern(_),b) => b
+                             | (A.Function(_, id, _, _, _), b) => Symbol.bind b (id, () ))
+                           Symbol.empty p
+
+      fun 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"
+
+      fun trans_exp env (A.Var(id)) =
+        (* after type-checking, id must be declared; do not guard lookup *)
+            T.TEMP (Symbol.look' env id)
+        | 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(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)
+        | trans_exp env (A.FuncCall(func, stms)) =
+            T.CALL(func, List.map (trans_exp env) stms)

 
 

-  (* 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)
-         :: 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
+        (* anything else should be impossible *)
+
+      (* trans_stms : Temp.temp Symbol.table -> (Label.label * Label.label) option -> A.stm list -> Tree.stm list
+       * 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 vars ls (A.Assign(id,e)::stms) =
+          let
+            val t = Symbol.look' vars id handle Option => raise ErrorMsg.InternalError "Undeclared variable, should have been caught in typechecker..."
+            val remainder = trans_stms vars ls stms
+          in
+            T.MOVE(T.TEMP(t), trans_exp vars e)
+            :: remainder
+          end
+        | trans_stms vars ls (A.Return e::stms) =
+          let
+            val remainder = trans_stms vars ls stms
+          in 
+            T.RETURN (trans_exp vars e)
+            :: remainder
+          end

         
         

-    | 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)
+        | trans_stms vars ls (A.If(e, s, NONE)::stms) =
+          let
+            val l = Label.new ()
+            val strans = trans_stms vars ls s
+            val remainder = trans_stms vars ls stms
+          in
+            (T.JUMPIFN(trans_exp vars e, l)

             :: strans
             @ [T.LABEL (l)]
             :: strans
             @ [T.LABEL (l)]

-            @ remainder, env')
-        end
-    | trans_stms env ls (A.If(e, s, SOME s2)::stms) =
-        let val l = Label.new ()
+            @ remainder)
+          end
+        | trans_stms vars ls (A.If(e, s, SOME s2)::stms) =
+          let
+            val l = Label.new ()

             val l2 = 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)
+            val s1trans = trans_stms vars ls s
+            val s2trans = trans_stms vars ls s2
+            val remainder = trans_stms vars ls stms
+          in
+            (T.JUMPIFN(trans_exp vars e, l)

             :: s1trans
             @ [T.JUMP (l2), T.LABEL (l)]
             @ s2trans
             @ [T.LABEL (l2)]
             :: 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"
+            @ remainder)
+          end
+        | trans_stms vars ls (A.For(s1, e, s2, s)::stms) = 
+          let
+            val head = Label.new ()
+            val tail = Label.new ()
+            val loop = Label.new ()
+            val stm1 = if isSome s1 then trans_stms vars NONE [valOf s1] else nil
+            val strans = trans_stms vars (SOME(loop,tail)) s
+            val stm2 = if isSome s2 then trans_stms vars NONE [valOf s2] else nil
+            val remainder = trans_stms vars ls stms
+          in
+            (stm1
+            @ [T.LABEL head, T.JUMPIFN(trans_exp vars e, tail)]
+            @ strans
+            @ [T.LABEL loop]
+            @ stm2
+            @ [T.JUMP head, T.LABEL tail]
+            @ remainder)
+          end
+        | trans_stms vars ls (A.While(e, s)::stms) =
+          let
+            val head = Label.new ()
+            val tail = Label.new ()
+            val strans = trans_stms vars (SOME(head,tail)) s
+            val remainder = trans_stms vars ls stms
+          in
+            (T.LABEL head
+            :: T.JUMPIFN(trans_exp vars e, tail)
+            :: strans
+            @ [T.JUMP head, T.LABEL tail]
+            @ remainder)
+          end

 
 

-    | 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)
+        | trans_stms vars (SOME(b,e)) (A.Break::stms) =
+          let
+            val remainder = trans_stms vars (SOME(b,e)) stms
+          in
+            ((T.JUMP e) :: remainder)
+          end
+        | trans_stms vars  NONE       (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker"
+        | trans_stms vars (SOME(b,e)) (A.Continue::stms) =
+          let
+            val remainder = trans_stms vars (SOME(b,e)) stms
+          in
+            ((T.JUMP b) :: remainder)
+          end
+        | trans_stms vars  NONE       (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker"
+        | trans_stms vars ls (A.Nop::stms) = trans_stms vars ls stms
+        | trans_stms vars ls (A.MarkedStm m :: stms) = trans_stms vars ls ((Mark.data m) :: stms)
+        | trans_stms vars _ nil = nil

 
 

-  fun translate p = let val (trans, _) = trans_stms Symbol.empty NONE p in trans end
+      fun trans_funcs (A.Extern(t, id, varl)::l) = trans_funcs l
+        | trans_funcs (A.Function(t, id, args, vars, body)::l) = 
+            let
+              val (a,_) = ListPair.unzip (args @ vars)
+              val allvars = foldr (fn (a,b) => Symbol.bind b (a, Temp.new(Symbol.name(a)))) Symbol.empty a
+              val b = trans_stms allvars NONE body
+              val (argn,_) = ListPair.unzip args
+              val numberedargs = ListPair.zip (List.tabulate (length argn, fn x => x), argn)
+              val argmv = map
+                (fn (n, argname) => T.MOVE(T.TEMP (Symbol.look' allvars argname), T.ARG n))
+                numberedargs
+            in
+              (T.FUNCTION(id, argmv @ b)) :: (trans_funcs l)
+            end
+        | trans_funcs nil = nil
+    in
+      trans_funcs p
+    end

 
 end
 
 end

diff --git a/trans/tree.sml b/trans/tree.sml
index f69cefb8a4026964c6e02062b54212dcd93bb2ab..f5a92b5a3275451a8c47c123d9e3f1e3d4a5f060 100644 (file)
--- a/trans/tree.sml
+++ b/trans/tree.sml
@@ -1,8 +1,10 @@
-(* L2 Compiler
+(* L3 Compiler

  * IR Trees
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
  * IR Trees
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>

+ * Modified: Joshua Wise <jwise>
+ * Modified: Chris Lu <czl>

  *)
 
 signature TREE =
  *)
 
 signature TREE =


@@ -11,19 +13,25 @@ sig
   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 binop = ADD | SUB | MUL | DIV | MOD | LSH | RSH | LOGOR | LOGAND | BITOR | BITAND | BITXOR | NEQ | EQ | LT | GT | LE | GE
   datatype unop = NEG | BITNOT | BANG
 

+  type Blarg = int
+

   datatype exp = 
       CONST of Word32.word
     | TEMP of Temp.temp
   datatype exp = 
       CONST of Word32.word
     | TEMP of Temp.temp

+    | ARG of Blarg (* I am j4cbo *)

     | BINOP of binop * exp * exp
     | UNOP of unop * exp
     | BINOP of binop * exp * exp
     | UNOP of unop * exp

+    | CALL of Ast.ident * exp list

   and stm =
       MOVE of exp * exp
     | RETURN of exp
     | LABEL of Label.label
     | JUMPIFN of exp * Label.label
     | JUMP of Label.label
   and stm =
       MOVE of exp * exp
     | RETURN of exp
     | LABEL of Label.label
     | JUMPIFN of exp * Label.label
     | JUMP of Label.label

+  and func =
+      FUNCTION of Ast.ident * stm list

 
 

-  type program = stm list
+  type program = func list

 
   structure Print :
   sig
 
   structure Print :
   sig


@@ -39,23 +47,31 @@ struct
   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 binop = ADD | SUB | MUL | DIV | MOD | LSH | RSH | LOGOR | LOGAND | BITOR | BITAND | BITXOR | NEQ | EQ | LT | GT | LE | GE
   datatype unop = NEG | BITNOT | BANG
 

+  type Blarg = int
+

   datatype exp = 
       CONST of Word32.word
     | TEMP of Temp.temp
   datatype exp = 
       CONST of Word32.word
     | TEMP of Temp.temp

+    | ARG of Blarg

     | BINOP of binop * exp * exp
     | UNOP of unop * exp
     | BINOP of binop * exp * exp
     | UNOP of unop * exp

+    | CALL of Ast.ident * exp list

   and stm =
       MOVE of exp * exp
     | RETURN of exp
     | LABEL of Label.label
     | JUMPIFN of exp * Label.label
     | JUMP of Label.label
   and stm =
       MOVE of exp * exp
     | RETURN of exp
     | LABEL of Label.label
     | JUMPIFN of exp * Label.label
     | JUMP of Label.label

+  and func =
+      FUNCTION of Ast.ident * stm list

 
 

-  type program = stm list
+  type program = func list

 
   structure Print = 
   struct
 
 
   structure Print = 
   struct
 

+    exception Aaaasssssss
+

     fun pp_binop ADD = "+"
       | pp_binop SUB = "-"
       | pp_binop MUL = "*"
     fun pp_binop ADD = "+"
       | pp_binop SUB = "-"
       | pp_binop MUL = "*"


@@ -81,10 +97,13 @@ struct
 
     fun pp_exp (CONST(x)) = Word32Signed.toString x
       | pp_exp (TEMP(t)) = Temp.name t
 
     fun pp_exp (CONST(x)) = Word32Signed.toString x
       | pp_exp (TEMP(t)) = Temp.name t

+      | pp_exp (ARG(n)) = "arg#"^Int.toString n

       | 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 ^ ")"
       | 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 ^ ")"

+      | pp_exp (CALL (f, l)) =
+          Symbol.name f ^ "(" ^ (String.concatWith ", " (List.map pp_exp l)) ^ ")"

 
     fun pp_stm (MOVE (e1,e2)) =
          pp_exp e1 ^ "  <--  " ^ pp_exp e2
 
     fun pp_stm (MOVE (e1,e2)) =
          pp_exp e1 ^ "  <--  " ^ pp_exp e2


@@ -98,6 +117,11 @@ struct
           "jump "^Label.name l^" if! "^pp_exp e
 
     fun pp_program (nil) = ""
           "jump "^Label.name l^" if! "^pp_exp e
 
     fun pp_program (nil) = ""

-      | pp_program (stm::stms) = pp_stm stm ^ "\n" ^ pp_program stms
+      | pp_program (FUNCTION(id, stms)::funcs) =
+          (Symbol.name id) ^
+          "\n{\n" ^
+          (foldr (fn (a,b) => (pp_stm a) ^ "\n" ^ b) "" stms) ^
+          "}\n" ^
+          pp_program funcs

   end
 end
   end
 end

diff --git a/type/typechecker.sml b/type/typechecker.sml
index 32f80a16e40b9cddb7abae4e82ee4332b457719a..63608bdb403628faaa4aed2d79e640a2e3476fee 100644 (file)
--- a/type/typechecker.sml
+++ b/type/typechecker.sml
@@ -1,10 +1,9 @@
-(* L1 Compiler
+(* L3 Compiler

  * TypeChecker
  * Author: Alex Vaynberg <alv@andrew.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>
  * TypeChecker
  * Author: Alex Vaynberg <alv@andrew.cmu.edu>
  * Modified: Frank Pfenning <fp@cs.cmu.edu>

- *
- * Simple typechecker that is based on a unit Symbol.table
- * This is all that is needed since there is only an integer type present
+ * Modified: Joshua Wise <jwise>
+ * Modified: Chris Lu <czl>

  *) 
 
 signature TYPE_CHECK =
  *) 
 
 signature TYPE_CHECK =


@@ -16,6 +15,8 @@ end;
 structure TypeChecker :> TYPE_CHECK = 
 struct
   structure A = Ast
 structure TypeChecker :> TYPE_CHECK = 
 struct
   structure A = Ast

+  
+  datatype asn = ASSIGNED | UNASSIGNED

 
   fun returns nil = false
     | returns (A.Assign _ :: stms) = returns stms
 
   fun returns nil = false
     | returns (A.Assign _ :: stms) = returns stms


@@ -27,7 +28,7 @@ struct
     | 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.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)
+    | returns (A.MarkedStm m :: stms) = returns (Mark.kane m :: stms)

   
   fun breakcheck nil mark = ()
     | breakcheck (A.Break :: stms) mark = ( ErrorMsg.error mark ("Illegal break outside loop") ;
   
   fun breakcheck nil mark = ()
     | breakcheck (A.Break :: stms) mark = ( ErrorMsg.error mark ("Illegal break outside loop") ;


@@ -41,21 +42,41 @@ struct
         ( breakcheck s1 mark;
           breakcheck s2 mark;
           breakcheck 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 (A.MarkedStm m :: stms) mark = (breakcheck [(Mark.kane m)] (Mark.ext m); breakcheck stms mark)

     | breakcheck (_ :: stms) mark = breakcheck stms mark
   
     | breakcheck (_ :: stms) mark = breakcheck stms mark
   

-  fun varcheck_exp env (A.Var v) mark =
+  fun varcheck_exp env fenv (A.Var v) mark : Ast.vtype =

         ( case Symbol.look env v
           of NONE => ( ErrorMsg.error mark ("undefined variable `" ^ Symbol.name v ^ "'") ;
                        raise ErrorMsg.Error )
         ( 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)
+           | SOME (t, UNASSIGNED) => ( ErrorMsg.error mark ("usage of unassigned variable `" ^ Symbol.name v ^ "'") ;
+                                       raise ErrorMsg.Error )
+           | SOME (t, ASSIGNED) => t)
+    | varcheck_exp env fenv (A.ConstExp _) mark = (A.Int)
+    | varcheck_exp env fenv (A.OpExp (_, l)) mark = (List.app (fn znt => (varcheck_exp env fenv znt mark; ())) l; A.Int)
+    | varcheck_exp env fenv (A.FuncCall (f, l)) mark =
+      let
+        val types = map (fn znt => varcheck_exp env fenv znt mark) l
+        val func = case Symbol.look fenv f
+                     of NONE => ( ErrorMsg.error mark ("undefined function `" ^ Symbol.name f ^ "'") ;
+                                  raise ErrorMsg.Error )
+                      | SOME a => a
+        val (rtype, params) = case func
+                               of A.Extern (rtype, _, params) => (rtype, params)
+                                | A.Function (rtype, _, params, _, _) => (rtype, params)
+        val paramtypes = map (fn (i, t) => t) params
+        val () = if not (types = paramtypes)
+                 then ( ErrorMsg.error mark ("incorrect parameters for function `" ^ Symbol.name f ^ "'") ;
+                        raise ErrorMsg.Error )
+                 else ()
+      in
+        rtype
+      end
+    | varcheck_exp env fenv (A.Marked m) mark = varcheck_exp env fenv (Mark.kane m) (Mark.ext m)

   
   fun computeassigns env nil = env
     | computeassigns env (A.Assign (id,e) :: stms) =
   
   fun computeassigns env nil = env
     | computeassigns env (A.Assign (id,e) :: stms) =

-        computeassigns (Symbol.bind env (id, ())) stms
+        computeassigns (Symbol.bind env (id, (A.Int, ASSIGNED))) stms

     | computeassigns env (A.Return _ :: stms) = env
     | computeassigns env (A.Nop :: stms) = computeassigns env stms
     | computeassigns env (A.Break :: stms) = env
     | computeassigns env (A.Return _ :: stms) = env
     | computeassigns env (A.Nop :: stms) = computeassigns env stms
     | computeassigns env (A.Break :: stms) = env


@@ -65,7 +86,11 @@ struct
         let
           val env1 = computeassigns env s1
           val env2 = computeassigns env s2
         let
           val env1 = computeassigns env s1
           val env2 = computeassigns env s2

-          val env' = Symbol.intersect (env1, env2)
+          val env' =
+            Symbol.intersect
+              (fn ((t, ASSIGNED), (t', ASSIGNED)) => (t, ASSIGNED) (* XXX check types for equality *)
+                | ((t, _), (t', _)) => (t, UNASSIGNED))
+              (env1, env2)

           val env' =
             if (returns s1) then env2
             else if (returns s2) then env1
           val env' =
             if (returns s1) then env2
             else if (returns s2) then env1


@@ -82,59 +107,137 @@ struct
        in
          computeassigns env' stms
        end
        in
          computeassigns env' stms
        end

-    | computeassigns env (A.MarkedStm m :: stms) = computeassigns env ((Mark.data m) :: stms)
+    | computeassigns env (A.MarkedStm m :: stms) = computeassigns env ((Mark.kane 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;
+  fun varcheck env fenv nil mark = nil
+    | varcheck env fenv (A.Assign (id, e) :: stms) mark =
+        let
+          val sym = Symbol.look env id
+          val _ = if not (isSome sym)
+                  then (ErrorMsg.error mark ("assignment to undeclared variable " ^ (Symbol.name id)); raise ErrorMsg.Error)
+                  else ()
+          val (t, a) = valOf sym
+          val t' = varcheck_exp env fenv e mark
+        in 
+          A.Assign (id, e) :: (varcheck (Symbol.bind env (id, (t, ASSIGNED))) fenv stms mark)
+        end
+    | varcheck env fenv (A.Return (e) :: stms) mark =
+        ( varcheck_exp env fenv e mark;

           A.Return (e) :: nil )
           A.Return (e) :: nil )

-    | varcheck env (A.Nop :: stms) mark =
-        ( A.Nop :: (varcheck env stms mark))
-    | varcheck env (A.Break :: stms) mark =
+    | varcheck env fenv (A.Nop :: stms) mark =
+        ( A.Nop :: (varcheck env fenv stms mark))
+    | varcheck env fenv (A.Break :: stms) mark =

         ( A.Break :: nil )
         ( A.Break :: nil )

-    | varcheck env (A.Continue :: stms) mark =
+    | varcheck env fenv (A.Continue :: stms) mark =

         ( A.Continue :: nil )
         ( 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 ;
+    | varcheck env fenv (A.If (e, s1, NONE) :: stms) mark =
+        ( varcheck_exp env fenv e mark ;
+          varcheck env fenv s1 mark ;
+          A.If (e, s1, NONE) :: (varcheck env fenv stms mark) )
+    | varcheck env fenv ((i as A.If (e, s1, SOME s2)) :: stms) mark =
+        ( varcheck_exp env fenv e mark ;
+          varcheck env fenv s1 mark ; 
+          varcheck env fenv s2 mark ;

           A.If (e, s1, SOME s2) ::
             (if (returns [i])
              then nil
           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 =
+             else varcheck (computeassigns env [i]) fenv stms mark)  )
+    | varcheck env fenv (A.While (e, s1) :: stms) mark =
+        ( varcheck_exp env fenv e mark ;
+          varcheck env fenv s1 mark ;
+          A.While (e, s1) :: (varcheck env fenv stms mark) )
+    | varcheck env fenv (A.For (sbegin, e, sloop, inner) :: stms) mark =

         let
           val sbegin = case sbegin
         let
           val sbegin = case sbegin

-                       of SOME(s) => SOME (hd (varcheck env [s] mark))
+                       of SOME(s) => SOME (hd (varcheck env fenv [s] mark))

                         | NONE => NONE
           val env' = case sbegin
                      of SOME(s) => computeassigns env [s]
                       | NONE => env
                         | 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 _ = varcheck_exp env' fenv e
+          val inner = varcheck env' fenv inner mark

           val env'' = computeassigns env' inner
           val sloop = case sloop
           val env'' = computeassigns env' inner
           val sloop = case sloop

-                  of SOME(s) => SOME (hd (varcheck env'' [s] mark))
+                  of SOME(s) => SOME (hd (varcheck env'' fenv [s] mark))

                    | NONE => NONE
         in
                    | NONE => NONE
         in

-          A.For (sbegin, e, sloop, inner) :: (varcheck env' stms mark)
+          A.For (sbegin, e, sloop, inner) :: (varcheck env' fenv stms mark)

         end
         end

-    | varcheck env (A.MarkedStm m :: stms) mark = varcheck env ((Mark.data m) :: stms) (Mark.ext m)
+    | varcheck env fenv (A.MarkedStm m :: stms) mark = varcheck env fenv ((Mark.kane 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)
+  fun bindvars sym stat l = foldr (fn ((i,t), s) => Symbol.bind s (i,(t, stat))) sym l
+  fun bindfuns sym l =
+    foldr
+      (fn (a as (A.Function (_, id, _, _, _)), s) => Symbol.bind s (id, a)
+        | (a as (A.Extern (_, id, _)), s) => Symbol.bind s (id, a))
+      sym l
+
+  fun dupchk l =
+        List.app
+          (fn (n, _) =>
+            let
+              val name = Symbol.name n
+              val all = List.filter (fn (n', _) => name = (Symbol.name n')) l
+              val count = length all
+            in
+              if count = 1
+              then ()
+              else ( ErrorMsg.error NONE ("multiple definition of variable " ^ (Symbol.name n));
+                     raise ErrorMsg.Error )
+            end) l
+
+  fun typecheck_fn p (e as (A.Extern (t, id, al))) = (dupchk al; e)
+    | typecheck_fn p (A.Function (t, id, al, vl, sl)) =
+      let
+        val () = breakcheck sl NONE
+        val () = if not (returns sl)
+                 then ( ErrorMsg.error NONE ("function `"^ Symbol.name id ^ "' does not return in all cases");
+                        raise ErrorMsg.Error )
+                 else ()
+        val env = Symbol.empty
+        val env = bindvars env ASSIGNED al
+        val env = bindvars env UNASSIGNED vl
+        val fenv = bindfuns Symbol.empty p
+        val () = dupchk (al @ vl)
+      in
+        A.Function (t, id, al, vl, varcheck env fenv sl NONE)
+      end
+  
+  fun typecheck p =
+      let
+        fun getFun n =
+          List.find (fn A.Extern (_, id, _) => ((Symbol.name id) = n)
+                      | A.Function (_, id, _, _, _) => ((Symbol.name id) = n))
+                    p
+        val main = case (getFun "main")
+                   of NONE => ( ErrorMsg.error NONE ("no function named main");
+                                raise ErrorMsg.Error )
+                    | SOME m => m
+        val () = case main
+                 of A.Extern _ => ( ErrorMsg.error NONE ("you anus, main can't be an extern");
+                                    raise ErrorMsg.Error )
+                  | A.Function (A.Int, _, nil, _, _) => ()
+                  | A.Function (A.Int, _, _, _, _) => ( ErrorMsg.error NONE ("main should take no parameters");
+                                                        raise ErrorMsg.Error )
+        val () = List.app
+                   (fn a =>
+                      let
+                        val id = case a
+                          of A.Extern (_, id, _) => id
+                           | A.Function (_, id, _, _, _) => id
+                        val name = Symbol.name id
+                        val all = List.filter
+                          (fn A.Extern (_, id, _) => (Symbol.name id) = name
+                            | A.Function (_, id, _, _, _) => (Symbol.name id) = name)
+                          p
+                        val num = length all
+                      in
+                        if num = 1
+                        then ()
+                        else ( ErrorMsg.error NONE ("multiple definition of " ^ name);
+                               raise ErrorMsg.Error )
+                      end) p
+      in
+        List.map (typecheck_fn p) p
+      end

 end
 end

diff --git a/util/mark.sml b/util/mark.sml
index a83f65a64f6ff54efc417cbd8bc8427c47fbc9eb..c3b8348474bd108a77648a42cd3a9612bf6b5f93 100644 (file)
--- a/util/mark.sml
+++ b/util/mark.sml
@@ -27,6 +27,7 @@ sig
 
   (* data: remove the markings *)
   val data : 'a marked -> 'a
 
   (* data: remove the markings *)
   val data : 'a marked -> 'a

+  val kane : 'a marked -> 'a

 
   (* ext: retrieve positional information from marked value*)
   val ext : 'a marked -> ext option
 
   (* ext: retrieve positional information from marked value*)
   val ext : 'a marked -> ext option


@@ -64,6 +65,7 @@ struct
   fun naked d = (d, NONE)
 
   fun data (d, e) = d
   fun naked d = (d, NONE)
 
   fun data (d, e) = d

+  val kane = data

   fun ext (d, e) = e
 
   fun extmin ((l1, c1), (l2, c2)) =
   fun ext (d, e) = e
 
   fun extmin ((l1, c1), (l2, c2)) =

diff --git a/util/symbol.sml b/util/symbol.sml
index 77878b47cf329ecbdd979de4be4e32db2dfec64a..87a0ab9c06b219e7c790cfca146e99f709f0c4eb 100644 (file)
--- a/util/symbol.sml
+++ b/util/symbol.sml
@@ -38,7 +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 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
+  val intersect : ('a * 'a -> 'a) -> 'a table * 'a table -> 'a table

 
   (* symbol set -- similar to a () Symbol.table, elements can be removed *)
   type set
 
   (* symbol set -- similar to a () Symbol.table, elements can be removed *)
   type set


@@ -104,7 +104,7 @@ struct
   fun elems t = Map.listItems t
   fun elemsi t = Map.listItemsi t
   fun keys t = Map.listKeys t
   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 intersect binding (t1,t2) = Map.intersectWith binding (t1,t2)

 
   fun delimit' [] s = s
     | delimit' [x] s = s ^ x
 
   fun delimit' [] s = s
     | delimit' [x] s = s ^ x