Initial import of l2c

[snipe.git] / codegen / solidify.sml

(* L2 Compiler
 * Takes a list of mappings of temporaries to colors and a pseudoasm listing,
 * then produces x86 code.
 * Author: Chris Lu <czl@andrew.cmu.edu>
 * Author: Joshua Wise <jwise@andrew.cmu.edu>
 *)

signature SOLIDIFY =
sig
  type colorings = (Temp.temp * int) list
  type asm = x86.insn list
  
  val solidify : colorings -> asm -> asm
end

structure Solidify :> SOLIDIFY =
struct
  structure X = x86
  structure T = Temp
  
  type colorings = (Temp.temp * int) list
  type asm = x86.insn list
  
  exception Spilled
  
  fun solidify (regmap : colorings) (instrs : asm) : asm =
    let
      (* r14d and r15d is reserved for spilling *)
      val maxreg = X.regtonum X.R13D
      fun numtoreg n =
          if (n > maxreg)
          then raise Spilled
          else X.numtoreg n
      
      fun temptonum (t: T.temp) : int =
        (List.hd
          (List.map (fn (_, n) => n)
            (List.filter (fn (a, _) => (Temp.compare (a, t) = EQUAL)) regmap)))
      
      fun temptoreg (t: T.temp) : x86.reg =
        numtoreg (temptonum t)          
        handle Empty =>
          (ErrorMsg.warn NONE ("Uncolored temp "^(Temp.name t)^" -- dead code?") ;
            X.R15D) (*If we don't care about the output, then it is cool to explode this; R15D is guaranteed not to be used across builtin blocks.*)
      
      val spillreg1 = X.R14D
      
      val prologue = [X.DIRECTIVE "\tpush %rbx\n\tpush %r12\n\tpush %r13\n\tpush %r14\n\tpush %r15"]	(* Could be done better. *)
      val epilogue = [X.DIRECTIVE "\tpop %r15\n\tpop %r14\n\tpop %r13\n\tpop %r12\n\tpop %rbx"]
      
      val numreg = foldr (Int.max) 0 (map (fn (_, n) => n) regmap)	(* Number of registers used. *)
      val nspilled = Int.max (numreg - maxreg, 0)	(* Number of spilled registers. *)
      fun isspilled (X.TEMP temp) = (((temptonum temp) > maxreg) handle Empty => false)	(* Whether a register is spilled *)
        | isspilled _ = false
      fun stackpos (reg: int) = (reg - maxreg) * ~4	(* Stack position of some register number *)
      
      fun spill (X.TEMP temp, xreg: x86.reg) =	(* Spill a register if need be. *)
        if (isspilled (X.TEMP temp))
          then [X.MOVL (X.REL (X.RSP, stackpos (temptonum temp)), X.REG xreg)]
          else nil
        | spill _ = nil		(* Nothing else can be spilled. *)
      fun unspill (X.TEMP temp, xreg: x86.reg) =	(* Unspill a register if need be. *)
        if (isspilled (X.TEMP temp))
          then [X.MOVL (X.REG xreg, X.REL (X.RSP, stackpos (temptonum temp)))]
          else nil
        | unspill _ = nil
      
      fun realoper (X.TEMP temp) = X.REG (temptoreg temp)	(* Makes a operand 'real'. *)
        | realoper r = r
      fun stackoper (X.TEMP temp) =
            if not (isspilled (X.TEMP temp)) then raise ErrorMsg.InternalError "stackoper on unspilled temp?"
            else X.REL (X.RSP, stackpos (temptonum temp))
        | stackoper _ = raise ErrorMsg.InternalError "stackoper on not temp?"
      
      fun transform (X.DIRECTIVE s) = [X.DIRECTIVE s]
        | transform (X.COMMENT s) = [X.COMMENT s]
        | transform (X.MOVL (dest, src)) =
            if (isspilled dest)
            then
              unspill (src, spillreg1) @
              [ X.MOVL(
                  realoper dest handle Spilled => stackoper dest,
                  realoper src handle Spilled => X.REG spillreg1)]
            else
              [ X.MOVL(
                  realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
                  realoper src handle Spilled => stackoper src)]
        | transform (X.SUBL (dest, src)) =
            unspill (src, spillreg1) @
            [ X.SUBL(
                realoper dest handle Spilled => stackoper dest,
                realoper src handle Spilled => X.REG spillreg1)]
        | transform (X.IMUL (dest, src)) =
            unspill (dest, spillreg1) @
            [ X.IMUL(
                realoper dest handle Spilled => X.REG spillreg1,
                realoper src handle Spilled => stackoper src)] @
            spill (dest, spillreg1)
        | transform (X.IMUL3 (dest, src, const)) =
            [ X.IMUL3(
                realoper dest handle Spilled => X.REG spillreg1,
                realoper src handle Spilled => stackoper src,
                const)] @
            spill (dest, spillreg1)
        | transform (X.ADDL (dest, src)) =	(* You can have either operand spilled, but not both. Pick one. *)
            if (isspilled dest)
            then
              unspill (src, spillreg1) @
              [ X.ADDL(
                  realoper dest handle Spilled => stackoper dest,
                  realoper src handle Spilled => X.REG spillreg1)]
            else
              [ X.ADDL(
                  realoper dest handle Spilled => raise ErrorMsg.InternalError "But we said that wasn't spilled?",
                  realoper src handle Spilled => stackoper src)]
        | transform (X.IDIVL (src)) = [ X.IDIVL(realoper src handle Spilled => stackoper src)]
        | transform (X.NEG (src)) = [ X.NEG(realoper src handle Spilled => stackoper src)]
        | transform (X.NOTL (src)) = [ X.NOTL(realoper src handle Spilled => stackoper src)]
        | transform (X.SALL (dest, shft)) =
            [ X.SALL (
                realoper dest handle Spilled => stackoper dest,
                shft)]
        | transform (X.SARL (dest, shft)) =
            [ X.SARL (
                realoper dest handle Spilled => stackoper dest,
                shft)]
        | transform (X.CLTD) = [ X.CLTD ]
        | transform (X.ANDL (dest, src)) =
            unspill (src, spillreg1) @
            [ X.ANDL(
                realoper dest handle Spilled => stackoper dest,
                realoper src handle Spilled => X.REG spillreg1)]
        | transform (X.ORL (dest, src)) =
            unspill (src, spillreg1) @
            [ X.ORL(
                realoper dest handle Spilled => stackoper dest,
                realoper src handle Spilled => X.REG spillreg1)]
        | transform (X.XORL (dest, src)) =
            unspill (src, spillreg1) @
            [ X.XORL(
                realoper dest handle Spilled => stackoper dest,
                realoper src handle Spilled => X.REG spillreg1)]
        | transform (X.CMPL (op1, op2)) =
            unspill (op2, spillreg1) @
            [ X.CMPL(
                realoper op1 handle Spilled => stackoper op1,
                realoper op2 handle Spilled => X.REG spillreg1)]
        | transform (X.TEST (op1, op2)) =
            unspill (op2, spillreg1) @
            [ X.TEST(
                realoper op1 handle Spilled => stackoper op1,
                realoper op2 handle Spilled => X.REG spillreg1)]
        | transform (X.SETNE (src)) = [ X.SETNE(realoper src handle Spilled => stackoper src)]
        | transform (X.SETE (src)) = [ X.SETE(realoper src handle Spilled => stackoper src)]
        | transform (X.SETLE (src)) = [ X.SETLE(realoper src handle Spilled => stackoper src)]
        | transform (X.SETL (src)) = [ X.SETL(realoper src handle Spilled => stackoper src)]
        | transform (X.SETGE (src)) = [ X.SETGE(realoper src handle Spilled => stackoper src)]
        | transform (X.SETG (src)) = [ X.SETG(realoper src handle Spilled => stackoper src)]
        | transform (X.MOVZBL (dest, src)) =
            [ X.MOVZBL(
                realoper dest handle Spilled => X.REG spillreg1,
                realoper src handle Spilled => stackoper src)]
            @ spill (dest, spillreg1)
        | transform (X.RET) = epilogue @ [X.RET]
        | transform (X.LABEL l) = [ X.LABEL l ]
        | transform (X.JMP l) = [ X.JMP l ]
        | transform (X.JE l) = [ X.JE l]
        | transform (X.JNE l) = [ X.JNE l]
(*        | transform _ = raise ErrorMsg.InternalError ("Unimplemented transform")*)
    in
      List.concat (prologue :: (map transform instrs))
         
    end
end