top/top.sml

   1 (* L1 Compiler
   2  * Top Level Environment
   3  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
   4  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
   5  * Modified: Frank Pfenning <fp@cs.cmu.edu>
   6  *)
   7
   8 signature TOP =
   9 sig
  10   (* main function for standalone executable
  11    * use with SMLofNJ.exportFn("heapfilename", Top.main)
  12    *)
  13   val main : string * string list -> OS.Process.status
  14
  15   (* test "arguments"; is the same as executing a saved
  16    * heap with arguments on the command line
  17    *)
  18   val test : string -> OS.Process.status
  19 end
  20
  21 structure Top :> TOP =
  22 struct
  23   structure G = GetOpt  (* from $/smlnj-lib/Util/getopt-sig.sml *)
  24
  25   fun say s = TextIO.output (TextIO.stdErr, s ^ "\n")
  26
  27   fun newline () = TextIO.output (TextIO.stdErr, "\n")
  28
  29   exception EXIT
  30
  31   (* see flag explanations below *)
  32   val flag_verbose = Flag.flag "verbose"
  33   val flag_ast = Flag.flag "ast"
  34   val flag_ir = Flag.flag "ir"
  35   val flag_assem = Flag.flag "assem"
  36
  37   fun reset_flags () =
  38       List.app Flag.unset [flag_verbose, flag_ast,
  39                            flag_ir, flag_assem];
  40
  41   val options = [{short = "v", long=["verbose"],
  42                   desc=G.NoArg (fn () => Flag.set flag_verbose),
  43                   help="verbose messages"},
  44                  {short = "", long=["dump-ast"],
  45                   desc=G.NoArg (fn () => Flag.set flag_ast),
  46                   help="pretty print the AST"},
  47                  {short = "", long=["dump-ir"],
  48                   desc=G.NoArg (fn () => Flag.set flag_ir),
  49                   help="pretty print the IR"},
  50                  {short = "", long=["dump-assem"],
  51                   desc=G.NoArg (fn () => Flag.set flag_assem),
  52                   help="pretty print the assembly before register allocaction"}
  53                 ]
  54
  55
  56   fun stem s =
  57       let
  58           val (prefix, suffix) =
  59               Substring.splitr (fn c => c <> #".") (Substring.full s)
  60       in
  61           if Substring.isEmpty prefix (* no "." in string s *)
  62              then s (* return whole string *)
  63           else Substring.string (Substring.trimr 1 prefix)
  64       end
  65
  66   fun main (name, args) =
  67       let
  68         val header = "Usage: compile [OPTION...] SOURCEFILE\nwhere OPTION is"
  69         val usageinfo = G.usageInfo {header = header, options = options}
  70         fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
  71
  72         val _ = Temp.reset (); (* reset temp variable counter *)
  73         val _ = reset_flags (); (* return all flags to default value *)
  74
  75         val _ = if List.length args = 0 then
  76                     (say usageinfo; raise EXIT)
  77                 else ()
  78
  79         val (opts, files) =
  80             G.getOpt {argOrder = G.Permute,
  81                       options = options,
  82                       errFn = errfn}
  83                      args
  84
  85         val source =
  86             case files
  87               of [] => errfn "Error: no input file"
  88                | [filename] => filename
  89                | _ => errfn "Error: more than one input file"
  90
  91         val _ = Flag.guard flag_verbose say ("Parsing... " ^ source)
  92         val ast = Parse.parse source
  93         val _ = Flag.guard flag_ast
  94                   (fn () => say (Ast.Print.pp_program ast)) ()
  95
  96         val _ = Flag.guard flag_verbose say "Checking..."
  97         val _ = TypeChecker.typecheck ast
  98
  99         val _ = Flag.guard flag_verbose say "Translating..."
 100         val ir = Trans.translate ast
 101         val _ = Flag.guard flag_ir (fn () => say (Tree.Print.pp_program ir)) ()
 102
 103         val _ = Flag.guard flag_verbose say "Generating proto-x86_64 code..."
 104         val assem = Codegen.codegen ir
 105         val _ = Flag.guard flag_assem
 106                   (fn () => List.app (TextIO.print o x86.prettyprint) assem) ()
 107
 108         val _ = Flag.guard flag_verbose say "Analyzing liveness..."
 109         val liveness = Liveness.liveness assem;
 110
 111         val _ = Flag.guard flag_verbose say "Graphing..."
 112         val igraph = Igraph.gengraph liveness;
 113
 114         val _ = Flag.guard flag_verbose say "Ordering..."
 115         val order = ColorOrder.colororder igraph;
 116
 117         val _ = Flag.guard flag_verbose say "Coloring..."
 118         val colors = Colorizer.colorize order igraph;
 119
 120         val _ = Flag.guard flag_verbose say "Solidifying x86_64 code..."
 121         val x86 = Solidify.solidify colors assem;
 122
 123         val _ = Flag.guard flag_verbose say "Peepholing..."
 124         val x86p = Peephole.peephole x86;
 125
 126         val _ = Flag.guard flag_verbose say "Stringifying..."
 127         val x86d = [x86.DIRECTIVE(".file\t\"" ^ source ^ "\""),
 128                     x86.DIRECTIVE(".globl _l1_main"),
 129                     x86.DIRECTIVE("_l1_main:")]
 130                     @ x86p
 131                     @ [x86.DIRECTIVE ".ident\t\"15-411 L1 compiler v2 by czl@ and jwise@\""]
 132         val code = Stringify.stringify x86d
 133
 134         val afname = stem source ^ ".s"
 135         val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
 136         val _ = SafeIO.withOpenOut afname (fn afstream =>
 137                    TextIO.output (afstream, code))
 138       in
 139           OS.Process.success
 140       end
 141       handle ErrorMsg.Error => ( say "Compilation failed" ; OS.Process.failure )
 142            | EXIT => OS.Process.failure
 143            | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure)
 144            | e => (say ("Unrecognized exception " ^ exnMessage e); OS.Process.failure)
 145
 146   fun test s = main ("", String.tokens Char.isSpace s)
 147 end