Initial import of l2c

[snipe.git] / codegen / stringifier.sml

(* L2 compiler
 * stringifier
 * turns a list of x86 insns into the assembly code to generate them
 * Author: Chris Lu <czl@andrew.cmu.edu>
 *)

signature STRINGIFY =
sig
  type asm = x86.insn list
  val stringify : asm -> string
end

structure Stringify :> STRINGIFY =
struct
  type asm = x86.insn list
  structure X = x86

  (* val stringify : asm -> string
   * turns a x86 instruction list into a string of assembly code for these instructions *)

  fun stringify' (X.MOVL   (r1, r2))          = "\tmovl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.SUBL   (r1, r2))          = "\tsubl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.IMUL   (r1, r2))          = "\timul " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.IMUL3  (r1, r2, k))       = "\timul " ^ X.prettyprint_oper (X.CONST k) ^ ", " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.ADDL   (r1, r2))          = "\taddl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.IDIVL  (r1))              = "\tidivl " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.NEG    (r1))              = "\tnegl " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.NOTL   (r1))              = "\tnotl " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.RET)                      = "\tret\n"
    | stringify' (X.CLTD)                     = "\tcltd\n"
    | stringify' (X.SALL   (r1, X.REG X.ECX)) = "\tsall %cl, " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.SALL   (r1, X.CONST k))   = "\tsall " ^ X.prettyprint_operb (X.CONST k) ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.SALL   _)                 = raise ErrorMsg.InternalError "Invalid operand generated for SALL"
    | stringify' (X.SARL   (r1, X.REG X.ECX)) = "\tsarl %cl, " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.SARL   (r1, X.CONST k))   = "\tsarl " ^ X.prettyprint_operb (X.CONST k) ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.SARL   _)                 = raise ErrorMsg.InternalError "Invalid operand generated for SARL"
    | stringify' (X.ANDL   (r1, r2))          = "\tandl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.ORL    (r1, r2))          = "\torl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.XORL   (r1, r2))          = "\txorl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.CMPL   (r1, r2))          = "\tcmpl " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.TEST   (r1, r2))          = "\ttest " ^ X.prettyprint_oper r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.SETNE  (r1))              = "\tsetne " ^ X.prettyprint_operb r1 ^ "\n"
    | stringify' (X.SETE   (r1))              = "\tsete " ^ X.prettyprint_operb r1 ^ "\n"
    | stringify' (X.SETLE  (r1))              = "\tsetle " ^ X.prettyprint_operb r1 ^ "\n"
    | stringify' (X.SETL   (r1))              = "\tsetl " ^ X.prettyprint_operb r1 ^ "\n"
    | stringify' (X.SETGE  (r1))              = "\tsetge " ^ X.prettyprint_operb r1 ^ "\n"
    | stringify' (X.SETG   (r1))              = "\tsetg " ^ X.prettyprint_operb r1 ^ "\n"
    | stringify' (X.MOVZBL (r1, r2))          = "\tmovzbl " ^ X.prettyprint_operb r2 ^ ", " ^ X.prettyprint_oper r1 ^ "\n"
    | stringify' (X.DIRECTIVE(s))             = s ^ "\n"
    | stringify' (X.COMMENT(s))               = "\t// " ^ s ^ "\n"
    | stringify' (X.LABEL  l)                 = Label.name l ^ ":\n"
    | stringify' (X.JMP    l)                 = "\tjmp " ^ Label.name l ^ "\n"
    | stringify' (X.JE     l)                 = "\tje " ^ Label.name l ^ "\n"
    | stringify' (X.JNE    l)                 = "\tjne " ^ Label.name l ^ "\n"

  (* val stringify : asm -> string *)
  fun stringify l = foldr (fn (a,b) => (stringify' a) ^ b) ("") l

end