Rename output binary from l5c to snipe

[snipe.git] / top / top.sml

diff --git a/top/top.sml b/top/top.sml
index cb409bf0c8377e1079da3a956d871accfd9ee7eb..4b58d00cb08d8fbb9cab41e7ba2c6e0ec842f355 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>


@@ -27,120 +27,207 @@ struct
   fun newline () = TextIO.output (TextIO.stdErr, "\n")
 
   exception EXIT
   fun newline () = TextIO.output (TextIO.stdErr, "\n")
 
   exception EXIT

+  
+  val alloptimizations =
+    [ConstantFold.optimizer,
+     StupidFunctionElim.optimizer,
+     FeckfulnessAnalysis.optimizer,
+     ConstantFold.optimizer,
+     LabelCoalescing.optimizer,
+     Peephole.optimizer]
+  
+  val uniqopts =
+    foldr
+      (fn (opt : Optimizer.optimization, l) =>
+        if (List.exists (fn (x : Optimizer.optimization) => (#shortname opt) = (#shortname x)) l)
+        then l
+        else opt :: l)
+      []
+      alloptimizations

 
 

-  (* see flag explanations below *)
-  val flag_verbose = Flag.flag "verbose"
-  val flag_ast = Flag.flag "ast"
-  val flag_ir = Flag.flag "ir"
-  val flag_assem = Flag.flag "assem"
-
-  fun reset_flags () =
-      List.app Flag.unset [flag_verbose, flag_ast,
-                          flag_ir, flag_assem];
+  val enabledopts = ref alloptimizations

 
   val options = [{short = "v", long=["verbose"], 
 
   val options = [{short = "v", long=["verbose"], 

-                 desc=G.NoArg (fn () => Flag.set flag_verbose),
-                 help="verbose messages"},
-                {short = "", long=["dump-ast"],
-                 desc=G.NoArg (fn () => Flag.set flag_ast),
-                 help="pretty print the AST"},
-                {short = "", long=["dump-ir"],
-                 desc=G.NoArg (fn () => Flag.set flag_ir),
-                 help="pretty print the IR"},
-                {short = "", long=["dump-assem"],
-                 desc=G.NoArg (fn () => Flag.set flag_assem),
-                 help="pretty print the assembly before register allocaction"}
-               ]
+                  desc=G.NoArg (fn () => Flag.set Flags.verbose),
+                  help="verbose messages"},
+                 {short = "a", long=["dump-ast"],
+                  desc=G.NoArg (fn () => Flag.set Flags.ast),
+                  help="pretty print the AST"},
+                 {short = "i", long=["dump-ir"],
+                  desc=G.NoArg (fn () => Flag.set Flags.ir),
+                  help="pretty print the IR"},
+                 {short = "l", long=["dump-liveness"],
+                  desc=G.NoArg (fn () => Flag.set Flags.liveness),
+                  help="pretty print the liveness results"},
+                 {short = "s", long=["dump-assem"],
+                  desc=G.NoArg (fn () => Flag.set Flags.assem),
+                  help="pretty print the assembly before register allocaction"},
+                 {short = "c", long=["dump-color"],
+                  desc=G.NoArg (fn () => Flag.set Flags.color),
+                  help="pretty print the allocated regs"},
+                 {short = "", long=["safe"],
+                  desc=G.NoArg (fn () => Flag.set Flags.safe),
+                  help="enable memory-safety"},
+                 {short = "", long=["unsafe"],
+                  desc=G.NoArg (fn () => Flag.unset Flags.safe),
+                  help="disable memory-safety"}, 
+                 {short = "", long = ["disable-all"],
+                  desc=G.NoArg (fn () => enabledopts := nil),
+                  help="disable all optimizations"}
+                ] @
+                map
+                  (fn (opt : Optimizer.optimization) =>
+                    { short = "", long=["disable-" ^ (#shortname opt)],
+                      desc = G.NoArg (* This is nasty. *)
+                        (fn () => enabledopts := List.filter (fn x => (#shortname x) <> (#shortname opt)) (!enabledopts)),
+                      help = "disable optimization: " ^ (#description opt) })
+                  uniqopts

 
 
   fun stem s =
       let
 
 
   fun stem s =
       let

-         val (prefix, suffix) =
-             Substring.splitr (fn c => c <> #".") (Substring.full s)
+          val (prefix, suffix) =
+              Substring.splitr (fn c => c <> #".") (Substring.full s)

       in
       in

-         if Substring.isEmpty prefix (* no "." in string s *)
-            then s (* return whole string *)
-         else Substring.string (Substring.trimr 1 prefix)
+          if Substring.isEmpty prefix (* no "." in string s *)
+             then s (* return whole string *)
+          else Substring.string (Substring.trimr 1 prefix)

       end
       end

-
-  fun main (name, args) =
+  
+  fun processir externs (Tree.FUNCTION (id, ir)) =

       let
       let

-       val header = "Usage: compile [OPTION...] SOURCEFILE\nwhere OPTION is"
-       val usageinfo = G.usageInfo {header = header, options = options}
-       fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
-
-       val _ = Temp.reset (); (* reset temp variable counter *)
-       val _ = reset_flags (); (* return all flags to default value *)
-
-       val _ = if List.length args = 0 then
-                   (say usageinfo; raise EXIT)
-               else ()
-
-       val (opts, files) =
-           G.getOpt {argOrder = G.Permute,
-                     options = options,
-                     errFn = errfn}
-                    args
-
-       val source =
-           case files
-             of [] => errfn "Error: no input file"
-              | [filename] => filename
-              | _ => errfn "Error: more than one input file"
-
-       val _ = Flag.guard flag_verbose say ("Parsing... " ^ source)
-       val ast = Parse.parse source
-       val _ = Flag.guard flag_ast
-                 (fn () => say (Ast.Print.pp_program ast)) ()
-
-       val _ = Flag.guard flag_verbose say "Checking..."
-       val _ = TypeChecker.typecheck ast
-
-       val _ = Flag.guard flag_verbose say "Translating..."
-       val ir = Trans.translate ast
-       val _ = Flag.guard flag_ir (fn () => say (Tree.Print.pp_program ir)) ()
-
-       val _ = Flag.guard flag_verbose say "Generating proto-x86_64 code..."
-       val assem = Codegen.codegen ir
-       val _ = Flag.guard flag_assem
-                 (fn () => List.app (TextIO.print o x86.prettyprint) assem) ()
-
-        val _ = Flag.guard flag_verbose say "Analyzing liveness..."
-        val liveness = Liveness.liveness assem;
+        val name = "_l5_" ^ (Symbol.name id)

         
         

-        val _ = Flag.guard flag_verbose say "Graphing..."
-        val igraph = Igraph.gengraph liveness;
+        fun realname s = if (List.exists (fn n => s = n) externs)
+                         then s
+                         else "_l5_" ^ s
+      
+        val _ = Flag.guard Flags.verbose say ("Processing function: " ^ name)
+
+        val _ = Flag.guard Flags.verbose say "  Generating proto-x86_64 code..."
+        val assem = Codegen.codegen ir
+        val _ = Flag.guard Flags.assem
+                  (fn () => List.app (TextIO.print o (x86.print)) assem) ()
+
+        val _ = Flag.guard Flags.verbose say "  Optimizing pre-liveness..."
+        val assem = Optimizer.optimize_preliveness (!enabledopts) assem

         
         

-        val _ = Flag.guard flag_verbose say "Ordering..."
-        val order = ColorOrder.colororder igraph;
+        val _ = Flag.guard Flags.verbose say "  Analyzing liveness..."
+        val (preds, liveness) = Liveness.liveness assem;
+        val _ = Flag.guard Flags.liveness
+                  (fn () => List.app
+                    (fn (asm, liv) =>
+                      TextIO.print (
+                        let
+                          val xpp = x86.print 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 Flags.verbose say "  Graphing..."
+        val (igraph,temps) = Igraph.gengraph (preds, liveness)
+
+        val _ = Flag.guard Flags.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_verbose say "Solidifying x86_64 code..."
-        val x86 = Solidify.solidify colors assem;
+        val _ = Flag.guard Flags.verbose say "  Coloring..."
+        val colors = Colorizer.colorize order igraph
+        val _ = Flag.guard Flags.color
+                  (fn () => List.app (TextIO.print o
+                    (fn (t, i) =>
+                      (Temp.name t) ^ " => " ^ (
+                        if (i <= x86.regtonum x86.R13D)
+                          then (x86.pp_oper (x86.REG (x86.numtoreg i), Temp.Long))
+                        else
+                          "spill[" ^ Int.toString (i - x86.regtonum x86.R13D) ^ "]")
+                        ^ "--"^ Int.toString i ^ "\n"))
+                    colors) ()
+
+        val _ = Flag.guard Flags.verbose say "  Solidifying x86_64 code..."
+        val x86 = Solidify.solidify colors assem
+
+        val _ = Flag.guard Flags.verbose say "  Optimizing final assembly..."
+        val x86p = Optimizer.optimize_final (!enabledopts) x86
+
+        val _ = Flag.guard Flags.verbose say "  Stringifying..."
+        val x86d = [x86.DIRECTIVE(".globl " ^ name),
+                    x86.DIRECTIVE(name ^ ":")]
+                    @ x86p
+        val code = Stringify.stringify realname x86d
+      in
+        code
+      end

 
 

-        val _ = Flag.guard flag_verbose say "Peepholing..."
-        val x86p = Peephole.peephole x86;
-        
-        val _ = Flag.guard flag_verbose say "Stringifying..."
-       val x86d = [x86.DIRECTIVE(".file\t\"" ^ source ^ "\""),
-                    x86.DIRECTIVE(".globl _l1_main"),
-                   x86.DIRECTIVE("_l1_main:")]
-                   @ x86p
-                   @ [x86.DIRECTIVE ".ident\t\"15-411 L1 compiler v2 by czl@ and jwise@\""]
-       val code = Stringify.stringify x86d
-
-       val afname = stem source ^ ".s"
-       val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
-       val _ = SafeIO.withOpenOut afname (fn afstream =>
-                  TextIO.output (afstream, code))
+  fun main (name, args) =
+      let
+        val header = "Usage: compile [OPTION...] SOURCEFILE\nwhere OPTION is"
+        val usageinfo = G.usageInfo {header = header, options = options}
+        fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
+
+        val _ = Temp.reset (); (* reset temp variable counter *)
+        val _ = Flags.reset (); (* return all flags to default value *)
+
+        val _ = if List.length args = 0 then
+                    (say usageinfo; raise EXIT)
+                else ()
+
+        val (opts, files) =
+            G.getOpt {argOrder = G.Permute,
+                      options = options,
+                      errFn = errfn}
+                     args
+
+        val source =
+            case files
+              of [] => errfn "Error: no input file"
+               | [filename] => filename
+               | _ => errfn "Error: more than one input file"
+
+        val _ = Flag.guard Flags.verbose say ("Enabled optimizations: " ^ String.concat (map (fn x => (#shortname x) ^ " ") (!enabledopts)))
+
+        val _ = Flag.guard Flags.verbose say ("Parsing... " ^ source)
+        val ast = Parse.parse source
+        val (_, funcs) = ast
+        val _ = Flag.guard Flags.ast
+                  (fn () => say (Ast.Print.pp_program ast)) ()
+
+        val externs = Symbol.mapPartiali
+                        (fn (a, b) => case (AstUtils.Function.data b)
+                                      of Ast.Extern _ => SOME(Symbol.name a)
+                                       | _ => NONE
+                        ) funcs
+
+        val _ = Flag.guard Flags.verbose say "Checking..."
+        val ast = TypeChecker.typecheck ast
+
+        val _ = Flag.guard Flags.verbose say "Translating..."
+        val ir = Trans.translate ast
+        val _ = Flag.guard Flags.ir (fn () => say (TreeUtils.Print.pp_program ir)) ()
+
+        val _ = Flag.guard Flags.verbose say "Optimizing whole-program IR..."
+        val ir = Optimizer.optimize_ir (!enabledopts) ir
+        val _ = Flag.guard Flags.ir (fn () => say (TreeUtils.Print.pp_program ir)) ()
+
+        val output = foldr (fn (func, code) => (processir ("calloc" (* lololololol *) :: (Symbol.elems externs)) func) ^ code) 
+          (".file\t\"" ^ source ^ "\"\n.ident\t\"15-411 ASS compiler by czl@ and jwise@\"\n" ^
+           ".ident \"Optimizations enabled: " ^ String.concat (map (fn x => (#shortname x) ^ " ") (!enabledopts)) ^ "\"\n") ir
+
+        val afname = stem source ^ ".s"
+        val _ = Flag.guard Flags.verbose say ("Writing assembly to " ^ afname ^ " ...")
+        val _ = SafeIO.withOpenOut afname (fn afstream =>
+                   TextIO.output (afstream, output))

       in
       in

-         OS.Process.success
+          OS.Process.success

       end
       handle ErrorMsg.Error => ( say "Compilation failed" ; OS.Process.failure )
       end
       handle ErrorMsg.Error => ( say "Compilation failed" ; OS.Process.failure )

-          | EXIT => OS.Process.failure
-          | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure)
+           | EXIT => OS.Process.failure
+           | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure)

            | e => (say ("Unrecognized exception " ^ exnMessage e); OS.Process.failure)
 
   fun test s = main ("", String.tokens Char.isSpace s)
            | e => (say ("Unrecognized exception " ^ exnMessage e); OS.Process.failure)
 
   fun test s = main ("", String.tokens Char.isSpace s)