top/top.sml

   1 (* L3 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   val flag_color = Flag.flag "color"
  38
  39   fun reset_flags () =
  40       List.app Flag.unset [flag_verbose, flag_ast,
  41                            flag_ir, flag_assem, flag_liveness];
  42
  43   val options = [{short = "v", long=["verbose"],
  44                   desc=G.NoArg (fn () => Flag.set flag_verbose),
  45                   help="verbose messages"},
  46                  {short = "a", long=["dump-ast"],
  47                   desc=G.NoArg (fn () => Flag.set flag_ast),
  48                   help="pretty print the AST"},
  49                  {short = "i", long=["dump-ir"],
  50                   desc=G.NoArg (fn () => Flag.set flag_ir),
  51                   help="pretty print the IR"},
  52                  {short = "l", long=["dump-liveness"],
  53                   desc=G.NoArg (fn () => Flag.set flag_liveness),
  54                   help="pretty print the liveness results"},
  55                  {short = "s", long=["dump-assem"],
  56                   desc=G.NoArg (fn () => Flag.set flag_assem),
  57                   help="pretty print the assembly before register allocaction"},
  58                  {short = "c", long=["dump-color"],
  59                   desc=G.NoArg (fn () => Flag.set flag_color),
  60                   help="pretty print the allocated regs"}
  61                 ]
  62
  63
  64   fun stem s =
  65       let
  66           val (prefix, suffix) =
  67               Substring.splitr (fn c => c <> #".") (Substring.full s)
  68       in
  69           if Substring.isEmpty prefix (* no "." in string s *)
  70              then s (* return whole string *)
  71           else Substring.string (Substring.trimr 1 prefix)
  72       end
  73
  74   fun processir externs (Tree.FUNCTION (id, ir)) =
  75       let
  76         val name = "_l3_" ^ (Symbol.name id)
  77
  78         fun realname s = if (List.exists (fn n => s = n) externs)
  79                          then s
  80                          else "_l3_" ^ s
  81
  82         val _ = Flag.guard flag_verbose say ("Processing function: " ^ name)
  83
  84         val _ = Flag.guard flag_verbose say "  Generating proto-x86_64 code..."
  85         val assem = Codegen.codegen ir
  86         val _ = Flag.guard flag_assem
  87                   (fn () => List.app (TextIO.print o (x86.prettyprint x86.Long)) assem) ()
  88
  89         val _ = Flag.guard flag_verbose say "  Analyzing liveness..."
  90         val (preds, liveness) = Liveness.liveness assem;
  91         val _ = Flag.guard flag_liveness
  92                   (fn () => List.app
  93                     (fn (asm, liv) =>
  94                       TextIO.print (
  95                         let
  96                           val xpp = x86.prettyprint x86.Long asm
  97                           val xpp = String.extract (xpp, 0, SOME (size xpp - 1))
  98                           val spaces = implode (List.tabulate (40 - size xpp, fn _ => #" ")) handle size => ""
  99                           val lpp = Liveness.prettyprint liv
 100                           val lpp = String.extract (lpp, 0, SOME (size lpp - 1))
 101                           val spaces2 = implode (List.tabulate (40 - size lpp, fn _ => #" ")) handle size => ""
 102                         in
 103                           xpp ^ spaces ^ lpp ^ spaces2 ^ "\n"
 104                         end))
 105                     (ListPair.zip (assem, Liveness.listify liveness))) ()
 106
 107         val _ = Flag.guard flag_verbose say "  Graphing..."
 108         val (igraph,temps) = Igraph.gengraph (preds, liveness)
 109
 110         val _ = Flag.guard flag_verbose say "  Ordering..."
 111         val order = ColorOrder.colororder (igraph,temps)
 112
 113         val _ = Flag.guard flag_verbose say "  Coloring..."
 114         val colors = Colorizer.colorize order igraph;
 115         val _ = Flag.guard flag_color
 116                   (fn () => List.app (TextIO.print o
 117                     (fn (t, i) =>
 118                       (Temp.name t) ^ " => " ^ (
 119                         if (i <= x86.regtonum x86.R14D)
 120                           then (x86.prettyprint_oper x86.Long (x86.REG (x86.numtoreg i)))
 121                         else
 122                           "spill[" ^ Int.toString (i - x86.regtonum x86.R14D) ^ "]")
 123                         ^ "--"^ Int.toString i ^ "\n"))
 124                     colors) ()
 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(".globl " ^ name),
 134                     x86.DIRECTIVE(name ^ ":")]
 135                     @ x86p
 136         val code = Stringify.stringify realname x86d
 137       in
 138         code
 139       end
 140
 141   fun main (name, args) =
 142       let
 143         val header = "Usage: compile [OPTION...] SOURCEFILE\nwhere OPTION is"
 144         val usageinfo = G.usageInfo {header = header, options = options}
 145         fun errfn msg = (say (msg ^ "\n" ^ usageinfo) ; raise EXIT)
 146
 147         val _ = Temp.reset (); (* reset temp variable counter *)
 148         val _ = reset_flags (); (* return all flags to default value *)
 149
 150         val _ = if List.length args = 0 then
 151                     (say usageinfo; raise EXIT)
 152                 else ()
 153
 154         val (opts, files) =
 155             G.getOpt {argOrder = G.Permute,
 156                       options = options,
 157                       errFn = errfn}
 158                      args
 159
 160         val source =
 161             case files
 162               of [] => errfn "Error: no input file"
 163                | [filename] => filename
 164                | _ => errfn "Error: more than one input file"
 165
 166         val _ = Flag.guard flag_verbose say ("Parsing... " ^ source)
 167         val ast = Parse.parse source
 168         val _ = Flag.guard flag_ast
 169                   (fn () => say (Ast.Print.pp_program ast)) ()
 170
 171         val externs = List.mapPartial
 172                         (fn (Ast.Function _) => NONE
 173                           | (Ast.Extern (_, s, _)) => SOME (Symbol.name s)) ast
 174
 175         val _ = Flag.guard flag_verbose say "Checking..."
 176         val ast = TypeChecker.typecheck ast
 177
 178         val _ = Flag.guard flag_verbose say "Translating..."
 179         val ir = Trans.translate ast
 180         val _ = Flag.guard flag_ir (fn () => say (Tree.Print.pp_program ir)) ()
 181
 182         val output = foldr (fn (func, code) => (processir externs func) ^ code)
 183           (".file\t\"" ^ source ^ "\"\n.ident\t\"15-411 L3 compiler by czl@ and jwise@\"\n") ir
 184
 185         val afname = stem source ^ ".s"
 186         val _ = Flag.guard flag_verbose say ("Writing assembly to " ^ afname ^ " ...")
 187         val _ = SafeIO.withOpenOut afname (fn afstream =>
 188                    TextIO.output (afstream, output))
 189       in
 190           OS.Process.success
 191       end
 192       handle ErrorMsg.Error => ( say "Compilation failed" ; OS.Process.failure )
 193            | EXIT => OS.Process.failure
 194            | ErrorMsg.InternalError s => ( say ("Internal compiler error: "^s^"\n"); OS.Process.failure)
 195            | e => (say ("Unrecognized exception " ^ exnMessage e); OS.Process.failure)
 196
 197   fun test s = main ("", String.tokens Char.isSpace s)
 198 end