X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/12aa4087bee3e70f170d7457794921de4e385227..de034162d9af50e6bfb454f4de67213d856137c4:/top/top.sml diff --git a/top/top.sml b/top/top.sml index cb409bf..6a132c6 100644 --- a/top/top.sml +++ b/top/top.sml @@ -1,4 +1,4 @@ -(* L1 Compiler +(* L3 Compiler * Top Level Environment * Author: Kaustuv Chaudhuri * Modified: Alex Vaynberg @@ -27,120 +27,207 @@ struct 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_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"], - 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 - val (prefix, suffix) = - Substring.splitr (fn c => c <> #".") (Substring.full s) + val (prefix, suffix) = + Substring.splitr (fn c => c <> #".") (Substring.full s) in - if Substring.isEmpty prefix (* no "." in string s *) - then s (* return whole string *) - else Substring.string (Substring.trimr 1 prefix) + if Substring.isEmpty prefix (* no "." in string s *) + then s (* return whole string *) + else Substring.string (Substring.trimr 1 prefix) end - - fun main (name, args) = + + fun processir externs (Tree.FUNCTION (id, ir)) = 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 (Blarg.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 = 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 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 <= Blarg.regtonum Blarg.R3) + then (Blarg.pp_oper (Blarg.REG (Blarg.numtoreg i))) + else + "spill[" ^ Int.toString (i - Blarg.regtonum Blarg.R3) ^ "]") + ^ "--"^ Int.toString i ^ "\n")) + colors) () + +(* val _ = Flag.guard Flags.verbose say " Solidifying blargCPU 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 + "" + 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 - OS.Process.success + OS.Process.success end handle ErrorMsg.Error => ( say "Compilation failed" ; OS.Process.failure ) - | EXIT => OS.Process.failure - | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure) + | EXIT => OS.Process.failure + | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure) | e => (say ("Unrecognized exception " ^ exnMessage e); OS.Process.failure) fun test s = main ("", String.tokens Char.isSpace s)