]> Joshua Wise's Git repositories - snipe.git/blobdiff - top/top.sml
git.joshuawise.com / snipe.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add string pasting support to the gramamr.
[snipe.git] / top / top.sml
diff --git a/top/top.sml b/top/top.sml
index c350c094c898d4002af110839f7415a77bd94251..c03263fcf40bb5e33c8553fcc7e60523c85f8091 100644 (file)
--- a/top/top.sml
+++ b/top/top.sml
@@ -27,38 +27,61 @@ 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*)] : Optimizer.optimization list
+  
+  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_liveness = Flag.flag "liveness"
-  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,
-                           flag_ir, flag_assem, flag_liveness];
+  val enabledopts = ref alloptimizations
 
   val options = [{short = "v", long=["verbose"], 
 
   val options = [{short = "v", long=["verbose"], 
-                  desc=G.NoArg (fn () => Flag.set flag_verbose),
+                  desc=G.NoArg (fn () => Flag.set Flags.verbose),
                   help="verbose messages"},
                  {short = "a", long=["dump-ast"],
                   help="verbose messages"},
                  {short = "a", long=["dump-ast"],
-                  desc=G.NoArg (fn () => Flag.set flag_ast),
+                  desc=G.NoArg (fn () => Flag.set Flags.ast),
                   help="pretty print the AST"},
                  {short = "i", long=["dump-ir"],
                   help="pretty print the AST"},
                  {short = "i", long=["dump-ir"],
-                  desc=G.NoArg (fn () => Flag.set flag_ir),
+                  desc=G.NoArg (fn () => Flag.set Flags.ir),
                   help="pretty print the IR"},
                  {short = "l", long=["dump-liveness"],
                   help="pretty print the IR"},
                  {short = "l", long=["dump-liveness"],
-                  desc=G.NoArg (fn () => Flag.set flag_liveness),
+                  desc=G.NoArg (fn () => Flag.set Flags.liveness),
                   help="pretty print the liveness results"},
                  {short = "s", long=["dump-assem"],
                   help="pretty print the liveness results"},
                  {short = "s", long=["dump-assem"],
-                  desc=G.NoArg (fn () => Flag.set flag_assem),
+                  desc=G.NoArg (fn () => Flag.set Flags.assem),
                   help="pretty print the assembly before register allocaction"},
                  {short = "c", long=["dump-color"],
                   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"}
-                ]
+                  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 =
 
 
   fun stem s =
@@ -73,27 +96,30 @@ struct
   
   fun processir externs (Tree.FUNCTION (id, ir)) =
       let
   
   fun processir externs (Tree.FUNCTION (id, ir)) =
       let
-        val name = "_l4_" ^ (Symbol.name id)
+        val name = "_l5_" ^ (Symbol.name id)
         
         fun realname s = if (List.exists (fn n => s = n) externs)
                          then s
         
         fun realname s = if (List.exists (fn n => s = n) externs)
                          then s
-                         else "_l4_" ^ s
+                         else "_l5_" ^ s
       
       
-        val _ = Flag.guard flag_verbose say ("Processing function: " ^ name)
+        val _ = Flag.guard Flags.verbose say ("Processing function: " ^ name)
 
 
-        val _ = Flag.guard flag_verbose say "  Generating proto-x86_64 code..."
+        val _ = Flag.guard Flags.verbose say "  Generating proto-blargCPU code..."
         val assem = Codegen.codegen ir
         val assem = Codegen.codegen ir
-        val _ = Flag.guard flag_assem
-                  (fn () => List.app (TextIO.print o (x86.prettyprint)) assem) ()
+        val _ = Flag.guard Flags.assem
+                  (fn () => List.app (TextIO.print o (Blarg.print)) assem) ()
 
 
-        val _ = Flag.guard flag_verbose say "  Analyzing liveness..."
+        val _ = Flag.guard Flags.verbose say "  Optimizing pre-liveness..."
+        val assem = Optimizer.optimize_preliveness (!enabledopts) assem
+        
+        val _ = Flag.guard Flags.verbose say "  Analyzing liveness..."
         val (preds, liveness) = Liveness.liveness assem;
         val (preds, liveness) = Liveness.liveness assem;
-        val _ = Flag.guard flag_liveness
+        val _ = Flag.guard Flags.liveness
                   (fn () => List.app
                     (fn (asm, liv) =>
                       TextIO.print (
                         let
                   (fn () => List.app
                     (fn (asm, liv) =>
                       TextIO.print (
                         let
-                          val xpp = x86.prettyprint asm
+                          val xpp = Blarg.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 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
@@ -104,34 +130,34 @@ struct
                         end))
                     (ListPair.zip (assem, Liveness.listify liveness))) ()
 
                         end))
                     (ListPair.zip (assem, Liveness.listify liveness))) ()
 
-        val _ = Flag.guard flag_verbose say "  Graphing..."
+        val _ = Flag.guard Flags.verbose say "  Graphing..."
         val (igraph,temps) = Igraph.gengraph (preds, liveness)
 
         val (igraph,temps) = Igraph.gengraph (preds, liveness)
 
-        val _ = Flag.guard flag_verbose say "  Ordering..."
+        val _ = Flag.guard Flags.verbose say "  Ordering..."
         val order = ColorOrder.colororder (igraph,temps)
         
         val order = ColorOrder.colororder (igraph,temps)
         
-        val _ = Flag.guard flag_verbose say "  Coloring..."
-        val colors = Colorizer.colorize order igraph;
-        val _ = Flag.guard flag_color
+        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) ^ " => " ^ (
                   (fn () => List.app (TextIO.print o
                     (fn (t, i) =>
                       (Temp.name t) ^ " => " ^ (
-                        if (i <= x86.regtonum x86.R13D)
-                          then (x86.prettyprint_oper x86.Long (x86.REG (x86.numtoreg i)))
+                        if (i <= 10)
+                          then (Blarg.pp_oper (Blarg.REG (Blarg.numtoreg i)))
                         else
                         else
-                          "spill[" ^ Int.toString (i - x86.regtonum x86.R13D) ^ "]")
+                          "spill[" ^ Int.toString (i - 11) ^ "]")
                         ^ "--"^ Int.toString i ^ "\n"))
                     colors) ()
 
                         ^ "--"^ Int.toString i ^ "\n"))
                     colors) ()
 
-        val _ = Flag.guard flag_verbose say "  Solidifying x86_64 code..."
-        val x86 = Solidify.solidify colors assem;
+        val _ = Flag.guard Flags.verbose say "  Solidifying blargCPU code..."
+        val x86 = Solidify.solidify colors assem
 
 
-        val _ = Flag.guard flag_verbose say "  Peepholing..."
-        val x86p = Peephole.peephole x86;
+        val _ = Flag.guard Flags.verbose say "  Optimizing final assembly..."
+        val x86p = Optimizer.optimize_final (!enabledopts) x86
 
 
-        val _ = Flag.guard flag_verbose say "  Stringifying..."
-        val x86d = [x86.DIRECTIVE(".globl " ^ name),
-                    x86.DIRECTIVE(name ^ ":")]
+        val _ = Flag.guard Flags.verbose say "  Stringifying..."
+        val x86d = [Blarg.DIRECTIVE(".globl " ^ name),
+                    Blarg.DIRECTIVE(name ^ ":")]
                     @ x86p
         val code = Stringify.stringify realname x86d
       in
                     @ x86p
         val code = Stringify.stringify realname x86d
       in
@@ -145,7 +171,7 @@ struct
         fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
 
         val _ = Temp.reset (); (* reset temp variable counter *)
         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 _ = Flags.reset (); (* return all flags to default value *)
 
         val _ = if List.length args = 0 then
                     (say usageinfo; raise EXIT)
 
         val _ = if List.length args = 0 then
                     (say usageinfo; raise EXIT)
@@ -163,10 +189,12 @@ struct
                | [filename] => filename
                | _ => errfn "Error: more than one input file"
 
                | [filename] => filename
                | _ => errfn "Error: more than one input file"
 
-        val _ = Flag.guard flag_verbose say ("Parsing... " ^ source)
+        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 ast = Parse.parse source
         val (_, funcs) = ast
-        val _ = Flag.guard flag_ast
+        val _ = Flag.guard Flags.ast
                   (fn () => say (Ast.Print.pp_program ast)) ()
 
         val externs = Symbol.mapPartiali
                   (fn () => say (Ast.Print.pp_program ast)) ()
 
         val externs = Symbol.mapPartiali
@@ -175,18 +203,35 @@ struct
                                        | _ => NONE
                         ) funcs
 
                                        | _ => NONE
                         ) funcs
 
-        val _ = Flag.guard flag_verbose say "Checking..."
+        val _ = Flag.guard Flags.verbose say "Checking..."
         val ast = TypeChecker.typecheck ast
 
         val ast = TypeChecker.typecheck ast
 
-        val _ = Flag.guard flag_verbose say "Translating..."
+        val _ = Flag.guard Flags.verbose say "Translating..."
         val ir = Trans.translate ast
         val ir = Trans.translate ast
-        val _ = Flag.guard flag_ir (fn () => say (Tree.Print.pp_program ir)) ()
+        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 L4 compiler by czl@ and jwise@\"\n") ir
+        val code = map (fn func => processir ("calloc" (* lololololol *) :: (Symbol.elems externs)) func) ir
+        val strings = map (fn (sn, s) => String.concat (
+                                           [Stringref.name sn, ": .word "] @
+                                           (map (fn c => (Int.toString (ord c)) ^ ", ") (String.explode s)) @ 
+                                           ["0\n"]
+                                         ) ) (Stringref.all ())
+
+        val output =
+          String.concat (
+            ".file\t\"" :: source :: "\"\n" ::
+            ".ident\t\"15-411 ASS compiler by czl@ and jwise@\"\n" ::
+            ".ident \"Optimizations enabled: " :: (map (fn x => (#shortname x) ^ " ") (!enabledopts)) @ [ "\"\n" ] @
+            code @
+            [ ".section .rodata\n" ] @
+            strings )
 
         val afname = stem source ^ ".s"
 
         val afname = stem source ^ ".s"
-        val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
+        val _ = Flag.guard Flags.verbose say ("Writing assembly to " ^ afname ^ " ...")
         val _ = SafeIO.withOpenOut afname (fn afstream =>
                    TextIO.output (afstream, output))
       in
         val _ = SafeIO.withOpenOut afname (fn afstream =>
                    TextIO.output (afstream, output))
       in
Compiler for a C-like language written in SML
This page took 0.036174 seconds and 4 git commands to generate.