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_liveness = Flag.flag "liveness"
  34   val flag_ast = Flag.flag "ast"
  35   val flag_ir = Flag.flag "ir"
  36   val flag_assem = Flag.flag "assem"
  37
  38   fun reset_flags () =
  39       List.app Flag.unset [flag_verbose, flag_ast,
  40                            flag_ir, flag_assem, flag_liveness];
  41
  42   val options = [{short = "v", long=["verbose"],
  43                   desc=G.NoArg (fn () => Flag.set flag_verbose),
  44                   help="verbose messages"},
  45                  {short = "a", long=["dump-ast"],
  46                   desc=G.NoArg (fn () => Flag.set flag_ast),
  47                   help="pretty print the AST"},
  48                  {short = "i", long=["dump-ir"],
  49                   desc=G.NoArg (fn () => Flag.set flag_ir),
  50                   help="pretty print the IR"},
  51                  {short = "l", long=["dump-liveness"],
  52                   desc=G.NoArg (fn () => Flag.set flag_liveness),
  53                   help="pretty print the liveness results"},
  54                  {short = "s", long=["dump-assem"],
  55                   desc=G.NoArg (fn () => Flag.set flag_assem),
  56                   help="pretty print the assembly before register allocaction"}
  57                 ]
  58
  59
  60   fun stem s =
  61       let
  62           val (prefix, suffix) =
  63               Substring.splitr (fn c => c <> #".") (Substring.full s)
  64       in
  65           if Substring.isEmpty prefix (* no "." in string s *)
  66              then s (* return whole string *)
  67           else Substring.string (Substring.trimr 1 prefix)
  68       end
  69
  70   fun main (name, args) =
  71       let
  72         val header = "Usage: compile [OPTION...] SOURCEFILE\nwhere OPTION is"
  73         val usageinfo = G.usageInfo {header = header, options = options}
  74         fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
  75
  76         val _ = Temp.reset (); (* reset temp variable counter *)
  77         val _ = reset_flags (); (* return all flags to default value *)
  78
  79         val _ = if List.length args = 0 then
  80                     (say usageinfo; raise EXIT)
  81                 else ()
  82
  83         val (opts, files) =
  84             G.getOpt {argOrder = G.Permute,
  85                       options = options,
  86                       errFn = errfn}
  87                      args
  88
  89         val source =
  90             case files
  91               of [] => errfn "Error: no input file"
  92                | [filename] => filename
  93                | _ => errfn "Error: more than one input file"
  94
  95         val _ = Flag.guard flag_verbose say ("Parsing... " ^ source)
  96         val ast = Parse.parse source
  97         val _ = Flag.guard flag_ast
  98                   (fn () => say (Ast.Print.pp_program ast)) ()
  99
 100         val _ = Flag.guard flag_verbose say "Checking..."
 101         val ast = TypeChecker.typecheck ast
 102
 103         val _ = Flag.guard flag_verbose say "Translating..."
 104         val ir = Trans.translate ast
 105         val _ = Flag.guard flag_ir (fn () => say (Tree.Print.pp_program ir)) ()
 106
 107         val _ = Flag.guard flag_verbose say "Generating proto-x86_64 code..."
 108         val assem = Codegen.codegen ir
 109         val _ = Flag.guard flag_assem
 110                   (fn () => List.app (TextIO.print o x86.prettyprint) assem) ()
 111
 112         val _ = Flag.guard flag_verbose say "Analyzing liveness..."
 113         val liveness = Liveness.liveness assem;
 114         val _ = Flag.guard flag_liveness
 115                   (fn () => List.app (TextIO.print o Liveness.prettyprint) liveness) ()
 116
 117         val _ = Flag.guard flag_verbose say "Graphing..."
 118         val igraph = Igraph.gengraph liveness;
 119
 120         val _ = Flag.guard flag_verbose say "Ordering..."
 121         val order = ColorOrder.colororder igraph;
 122
 123         val _ = Flag.guard flag_verbose say "Coloring..."
 124         val colors = Colorizer.colorize order igraph;
 125
 126         val _ = Flag.guard flag_verbose say "Solidifying x86_64 code..."
 127         val x86 = Solidify.solidify colors assem;
 128
 129         val _ = Flag.guard flag_verbose say "Peepholing..."
 130         val x86p = Peephole.peephole x86;
 131
 132         val _ = Flag.guard flag_verbose say "Stringifying..."
 133         val x86d = [x86.DIRECTIVE(".file\t\"" ^ source ^ "\""),
 134                     x86.DIRECTIVE(".globl _l2_main"),
 135                     x86.DIRECTIVE("_l2_main:")]
 136                     @ x86p
 137                     @ [x86.DIRECTIVE ".ident\t\"15-411 L2 compiler by czl@ and jwise@\""]
 138         val code = Stringify.stringify x86d
 139
 140         val afname = stem source ^ ".s"
 141         val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
 142         val _ = SafeIO.withOpenOut afname (fn afstream =>
 143                    TextIO.output (afstream, code))
 144       in
 145           OS.Process.success
 146       end
 147       handle ErrorMsg.Error => ( say "Compilation failed" ; OS.Process.failure )
 148            | EXIT => OS.Process.failure
 149            | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure)
 150            | e => (say ("Unrecognized exception " ^ exnMessage e); OS.Process.failure)
 151
 152   fun test s = main ("", String.tokens Char.isSpace s)
 153 end