x86 instruction selection for some IR ops

1 files changed, 675 insertions, 16 deletions

diff --git a/emit.fun b/emit.fun
index f3aa799..4659acf 100644
--- a/emit.fun
+++ b/emit.fun
@@ -502,10 +502,10 @@ functor Emit(I: IL) = struct
 
   fun updateI i = fn z =>
   let
-    fun from rinfo active pool intervals stackCand =
-      { rinfo, active, pool, intervals, stackCand }
-    fun to f { rinfo, active, pool, intervals, stackCand } =
-      f rinfo active pool intervals stackCand
+    fun from rinfo active pool intervals stackOff  =
+      { rinfo, active, pool, intervals, stackOff }
+    fun to f { rinfo, active, pool, intervals, stackOff } =
+      f rinfo active pool intervals stackOff
   in
     FRU.makeUpdate5 (from, from, to) i
   end z
@@ -666,13 +666,14 @@ functor Emit(I: IL) = struct
       end
   end
 
-  fun putToStack poff { rinfo, stackCand, ... } vr =
+  fun putToStack poff { rinfo, stackOff, ... } vr =
   let
+    val newStackOff = !stackOff - 8
     val () = printfn R poff
-      `"puting %" ip vr `" to stack: " ip (!stackCand) %
+      `"puting %" ip vr `" to stack: " ip newStackOff %
   in
-    updReg rinfo vr (VtStack (!stackCand));
-    stackCand := !stackCand - 8
+    updReg rinfo vr (VtStack newStackOff);
+    stackOff := newStackOff
   end
 
   fun assignHardReg poff (I as { rinfo,  pool, ... }) vr reg =
@@ -797,14 +798,14 @@ functor Emit(I: IL) = struct
         putToStack 0 I vr
   end
 
-  fun linearscan rinfo ints =
+  fun linearscan rinfo ints stackOff =
   let
     fun incStart ((_, start1, _), (_, start2, _)) = start1 <= start2
     val ints = sort incStart ints
 
     val () = printInts ints
 
-    fun loop _ [] = ()
+    fun loop { stackOff, ... } [] = stackOff
       | loop (I as { active, ... }) (int :: ints) =
       let
         val () = printfn `"\n\ninspectiing interval "
@@ -826,7 +827,7 @@ functor Emit(I: IL) = struct
       end
   in
     loop { active = ref [], pool = getPool (), rinfo,
-      stackCand = ref (~8) } ints
+      stackOff = ref stackOff } ints
   end
 
   fun printAllocVar rinfo v =
@@ -959,8 +960,34 @@ functor Emit(I: IL) = struct
     Array.appi printRow map
   end
 
+  fun resolveAlloc ops =
+  let
+    fun loop idx stackOffset =
+      if idx = D.length ops then
+        stackOffset
+      else
+        case D.get ops idx of
+          (SOME (I.IrAlloc (v, size, _)), li) =>
+          let
+            val () = printfn `"alloca size: " W size %
+            val () =
+              if Word.mod (size, 0w8) <> 0w0 then raise Unreachable else ()
+
+            val stackOffset = stackOffset - Word.toInt size
+            val negOffset = ~stackOffset
+            val ins = (SOME $ I.IrAlloc (v, size, SOME negOffset), li)
+          in
+            D.set ops idx ins;
+            loop (idx + 1) stackOffset
+          end
+        | (NONE, _) | (SOME _, _) => loop (idx + 1) stackOffset
+  in
+    loop 0 0
+  end
+
   fun regAlloc (F as I.Fi { vregs, ops, paramNum, ... }) =
   let
+    val stackOffset = resolveAlloc ops
     val (toAlloc, regInfo) = prepareRegInfo paramNum ops vregs
     val () = printfn `"for alloc: " Plist i toAlloc (", ", true, 0) %
 
@@ -968,7 +995,7 @@ functor Emit(I: IL) = struct
 
     val intervals = computeInts F toAlloc
 
-    val () = linearscan regInfo intervals
+    val stackOffset = linearscan regInfo intervals stackOffset
     val () = printAlloced regInfo toAlloc
 
     val regsToSave = getRegsToSave regInfo
@@ -978,14 +1005,646 @@ functor Emit(I: IL) = struct
     val regMap = computeMap (D.length ops) intervals regInfo
     val () = printMap regMap
   in
-    raise Unimplemented
+    { regsToSave, stackOffset = !stackOffset, regMap, ops,
+      rinfo = regInfo, vregs }
+  end
+
+  fun emitPushReg reg = fprinttn `"push " Preg reg %
+
+  fun emitPrologue ({ stackOffset, regsToSave, ... }) name =
+  let
+    val () = fprint PP.? name `":\n" %
+    val () = fprinttn `"push rbp" %
+    val () = fprinttn `"mov rbp, rsp" %
+    val () =
+      if stackOffset <> 0 then
+        fprinttn `"sub rsp, " I (~ stackOffset) %
+      else
+        ()
+  in
+    List.app emitPushReg regsToSave
+  end
+
+  fun emitEpilogue { regsToSave, ... } =
+  let
+    val () = List.app emitPushReg (rev regsToSave)
+    val () = fprinttn `"mov rsp, rbp" %
+    val () = fprinttn `"pop rbp" %
+    val () = fprinttn `"ret" %
+  in
+    ()
   end
 
-  fun emitFunc (F as I.Fi { vregs, ... }) =
+  fun pr is8 reg out =
+  let
+    fun old s =
+    let
+      val s = if is8 then s else "e" ^ String.extract (s, 1, NONE)
+    in
+      Printf out `s %
+    end
+
+    fun new s = Printf out `(if is8 then s else s ^ "d") %
+  in
+    case reg of
+      Rcx => old "rcx"
+    | Rsi => old "rsi"
+    | Rdi => old "rdi"
+    | R8 => new "r8"
+    | R9 => new "r9"
+    | R10 => new "r10"
+    | R11 => new "r11"
+
+    | Rbx => old "rbx"
+    | R12 => new "r12"
+    | R13 => new "r13"
+    | R14 => new "r14"
+    | R15 => new "r15"
+
+    | Rax => old "rax"
+    | Rdx => old "rdx"
+    | Rsp => old "rsp"
+    | Rbp => old "rbp"
+  end
+
+  fun pm is8 off out =
+    Printf out `(if is8 then "qword" else "dword") `" [rbp-" I off `"]"%
+
+  fun getType { rinfo, vregs, ... } vr =
+  let
+    val (_, vt) = Array.sub (rinfo, vr)
+    val { class, ... } = D.get vregs vr
+  in
+    (if class = I.VR8 then true else false, vt)
+  end
+
+  datatype template =
+    RRR of reg * reg * reg |
+    RRM of reg * reg * int |
+    RRV of reg * reg * vConst |
+    RMR of reg * int * reg |
+    RMM of reg * int * int |
+    RMV of reg * int * vConst |
+    RVR of reg * vConst * reg |
+    RVM of reg * vConst * int |
+
+    MRR of int * reg * reg |
+    MRM of int * reg * int |
+    MRV of int * reg * vConst |
+    MMR of int * int * reg |
+    MMM of int * int * int |
+    MMV of int * int * vConst |
+    MVR of int * vConst * reg |
+    MVM of int * vConst * int |
+
+    RR of reg * reg |
+    RM of reg * int |
+    RV of reg * vConst |
+    MR of int * reg |
+    MM of int * int |
+    MV of int * vConst
+
+  fun pc is8 c out =
+    case c of
+      VConst w =>
+        if is8 then
+          Printf out W w %
+        else
+          Printf out W (P.extz w 0w32) %
+    | VAddrConst (id, w) => Printf out PP.? id I.Pwc I.VR8 w %
+
+  fun wordFitsInNsx N w =
+  let
+    open Word
+    val nm1 = fromInt N - 0w1
+  in
+    if w < << (0w1, nm1) then (* sign bit is zero *)
+      true
+    else
+      let
+        val mask = << (~ 0w1, nm1)
+      in
+        andb (mask, w) = mask (* sign bit and all bits after == 1 *)
+      end
+  end
+
+  fun fitsInNsx N c =
+    case c of
+      VConst w => wordFitsInNsx N w
+    | VAddrConst _ => false
+
+  fun opRR is8 op' r1 r2 = sprintf `op' `" " A2 pr is8 r1 `", " A2 pr is8 r2 %
+  fun opRM is8 op' r off = sprintf `op' `" " A2 pr is8 r `", " A2 pm is8 off %
+  fun opMR is8 op' off r = sprintf `op' `" " A2 pm is8 off `", " A2 pr is8 r %
+
+  fun opRV is8 op' r c =
+    sprintf `op' `" " A2 pr is8 r `", " A2 pc is8 c %
+
+  fun opMV is8 op' off c =
+    sprintf `op' `" " A2 pm is8 off `", " A2 pc is8 c %
+
+  fun movRR is8 r1 r2 = sprintf `"mov " A2 pr is8 r1 `", " A2 pr is8 r2 %
+  fun movRM is8 r off = sprintf `"mov " A2 pr is8 r `", " A2 pm is8 off %
+  fun movMR is8 off r = sprintf `"mov " A2 pm is8 off `", " A2 pr is8 r %
+
+  fun movRV is8 r c = sprintf `"mov " A2 pr is8 r `", " A2 pc is8 c %
+  fun movMV is8 off c =
+  let
+    val () = if not $ fitsInNsx 32 c then raise Unreachable else ()
+  in
+    opMV is8 "mov" off c
+  end
+
+  fun getTripleTemplate I (rd, rs1, rs2) comm =
+  let
+    val (is81, t1) = getType I rd
+    val (is82, t2) = getType I rs1
+    val (is83, t3) = getType I rs2
+
+    val () =
+      if is81 <> is82 orelse is82 <> is83 then raise Unreachable else ()
+
+    val tmp =
+      case (t1, t2, t3) of
+        (VtReg r1, VtReg r2, VtReg r3) =>
+            if r1 = r2 then
+              RR (r1, r3)
+            else if r1 = r3 andalso comm then
+              RR (r1, r2)
+            else
+              RRR (r1, r2, r3)
+
+      | (VtReg r1, VtReg r2, VtStack off) =>
+          if r1 = r2 then
+            RM (r1, off)
+          else
+            RRM (r1, r2, off)
+      | (VtReg r1, VtStack off, VtReg r2) =>
+          if r1 = r2 andalso comm then
+            RM (r1, off)
+          else
+            RMR (r1, off, r2)
+
+      | (VtReg r1, VtReg r2, VtConst c) =>
+          if r1 = r2 then
+            RV (r1, c)
+          else
+            RRV (r1, r2, c)
+      | (VtReg r1, VtConst c, VtReg r2) =>
+          if r1 = r2 andalso comm then
+            RV (r1, c)
+          else
+            RVR (r1, c, r2)
+
+      | (VtReg r, VtStack off1, VtStack off2) => RMM (r, off1, off2)
+
+      | (VtReg r, VtStack off, VtConst c) => RMV (r, off, c)
+      | (VtReg r, VtConst c, VtStack off) => RVM (r, c, off)
+
+      | (VtStack off, VtReg r1, VtReg r2) => MRR (off, r1, r2)
+
+      | (VtStack off1, VtReg r, VtStack off2) =>
+          if off1 = off2 andalso comm then
+            MR (off1, r)
+          else
+            MRM (off1, r, off2)
+      | (VtStack off1, VtStack off2, VtReg r) =>
+          if off1 = off2 then
+            MR (off1, r)
+          else
+            MMR (off1, off2, r)
+
+      | (VtStack off, VtReg r, VtConst c) => MRV (off, r, c)
+      | (VtStack off, VtConst c, VtReg r) => MVR (off, c, r)
+
+      | (VtStack off1, VtStack off2, VtStack off3) =>
+          if off1 = off2 then
+            MM (off1, off3)
+          else if off1 = off3 andalso comm then
+            MM (off1, off2)
+          else
+            MMM (off1, off2, off3)
+
+      | (VtStack off1, VtStack off2, VtConst c) =>
+          if off1 = off2 then
+            MV (off1, c)
+          else
+            MMV (off1, off2, c)
+      | (VtStack off1, VtConst c, VtStack off2) =>
+          if off1 = off2 andalso comm then
+            MV (off1, c)
+          else
+            MVM (off1, c, off2)
+      | (VtConst _, _, _) | (VtUnk, _, _) | (_, VtUnk, _) |
+        (_, _, VtUnk) | (_, VtConst _, VtConst _) => raise Unreachable
+  in
+    (is81, tmp)
+  end
+
+  fun getUtilMovs is8 =
+  let
+    val movRR = movRR is8
+    val movRM = movRM is8
+    val movMR = movMR is8
+    val movRV = movRV is8
+  in
+    { movRR, movRM, movRV, movMR }
+  end
+
+  fun getUtilOps is8 op' =
+  let
+    val opRR = opRR is8 op'
+    val opRM = opRM is8 op'
+    val opRV = opRV is8 op'
+    val opMR = opMR is8 op'
+    val opMV = opMV is8 op'
+  in
+    { opRR, opRM, opRV, opMR, opMV }
+  end
+
+  fun emitGenComm I op' triple =
+  let
+    val (is8, tmp) = getTripleTemplate I triple true
+    val Pr = fn z => bind A1 (pr is8) z
+    val { movRR, movRM, movMR, movRV } = getUtilMovs is8
+    val { opRR, opRM, opMR, opRV, opMV } = getUtilOps is8 op'
+  in
+    case tmp of
+      RRR (r1, r2, r3) =>
+        if op' = "add" then
+          [sprintf `"lea " Pr r1 `", [" Pr r2 `"+" Pr r3 `"]" % ]
+        else
+          [movRR r1 r2, opRR r1 r3]
+    | RRM (r1, r2, off) | RMR (r1, off, r2) => [ movRR r1 r2, opRM r1 off ]
+    | MMM (off1, off2, off3) =>
+        [ movRM Rax off2, opRM Rax off3, movMR off1 Rax ]
+    | MRM (off1, r, off2) | MMR (off1, off2, r) =>
+        [ movMR off1 r, movRM Rax off2, opMR off1 Rax ]
+    | MRR (off, r1, r2) => [ movMR off r1, opMR off r2 ]
+    | RMM (r, off1, off2) => [ movRM r off1, opRM r off2 ]
+    | RRV (r1, r2, c) | RVR (r1, c, r2) =>
+      if fitsInNsx 32 c then
+        [ movRR r1 r2, opRV r1 c ]
+      else
+        [ movRV r1 c, opRR r1 r2 ]
+    | MMV (off1, off2, c) | MVM (off1, c, off2) =>
+        [ movRV Rax c, opRM Rax off2, movMR off1 Rax ]
+    | MRV (off, r, c) | MVR (off, c, r) =>
+        [ movRV Rax c, opRR Rax r, movMR off Rax ]
+    | RMV (r, off, c) | RVM (r, c, off) => [ movRV r c, opRM r off ]
+    | MM (off1, off2) => [ movRM Rax off2, opMR off1 Rax ]
+    | MR (off, r) => [ opMR off r ]
+    | MV (off, c) =>
+        if fitsInNsx 32 c then
+          [ opMV off c ]
+        else
+          [ movRV Rax c, opMR off Rax ]
+    | RR (r1, r2) => [ opRR r1 r2 ]
+    | RM (r, off) => [ opRM r off ]
+    | RV (r, c) =>
+      if fitsInNsx 32 c then
+        [ opRV r c ]
+      else
+        [ movRV Rax c, opRR r Rax ]
+  end
+
+  fun truncConst (VConst w) N = VConst $ P.extz w (Word.fromInt N)
+    | truncConst (C as (VAddrConst _)) _ = C
+
+  fun emitShift I op' triple =
+  let
+    val (is8, tmp) = getTripleTemplate I triple false
+    val Pr = fn z => bind A1 (pr is8) z
+    val { movRR, movRM, movMR, movRV } = getUtilMovs is8
+    val opRV = opRV is8 op'
+    val opRR = opRR is8 op'
+    val opMV = opMV is8 op'
+
+    fun shift3 r1 r2 r3 =
+      sprintf `op' `"x " Pr r1 `", " Pr r2 `", " Pr r3 %
+
+    fun shift3m r1 off r2 =
+      sprintf `op' `" x" Pr r1 `", " A2 pm is8 off `", " Pr r2 %
+
+    fun t v = truncConst v 8
+  in
+    case tmp of
+      RRR (r1, r2, r3) => [shift3 r1 r2 r3]
+    | RRM (r1, r2, off) => [movRM Rax off, shift3 r1 r2 Rax]
+    | RRV (r1, r2, v) => [movRR r1 r2, opRV r1 (t v)]
+    | RMR (r1, off, r2) => [shift3m r1 off r2]
+    | RMM (r1, off1, off2) =>
+        [movRM Rax off1, movRM Rdx off2, shift3 r1 Rax Rdx]
+    | RMV (r, off, v) => [movRM r off, opRV r (truncConst v 8)]
+    | RVR (r1, v, r2) => [movRV Rax v, shift3 r1 Rax r2]
+    | RVM (r, v, off) => [movRV Rax v, movRM Rdx off, shift3 r Rax Rdx]
+    | MRR (off, r1, r2) => [shift3 Rax r1 r2, movMR off Rax]
+    | MRM (off1, r1, off2) =>
+        [movRM Rax off2, shift3 Rax r1 Rax, movMR off1 Rax]
+    | MRV (off, r, v) => [movRV Rax (t v), shift3 Rax r Rax, movMR off Rax]
+    | MMR (off1, off2, v) => [shift3m Rax off2 v, movMR off1 Rax]
+    | MMM (off1, off2, off3) =>
+        [movRM Rdx off3, shift3m Rax off2 Rdx, movMR off1 Rax]
+    | MMV (off1, off2, v) =>
+        [movRM Rax off2, opRV Rax (t v), movMR off1 Rax]
+    | MVR (off1, v, r) => [movRV Rax v, opRR Rax r, movMR off1 Rax]
+    | MVM (off1, v, off2) =>
+        [movRV Rax v, movRM Rdx off2, opRR Rax Rdx, movMR off1 Rax]
+
+    | RR (r1, r2) => [opRR r1 r2]
+    | RM (r1, off) => [movRM Rax off, shift3 r1 r1 Rax]
+    | RV (r1, v) => [opRV r1 (t v)]
+    | MR (off, r) => [movRM Rax off, opRR Rax r, movMR off Rax]
+    | MM (off1, off2) =>
+        [movRM Rax off1, movRM Rdx off2, opRR Rax Rdx, movMR off1 Rax]
+    | MV (off, v) => [opMV off (t v)]
+  end
+
+  fun emitSub I triple =
+  let
+    val (is8, tmp) = getTripleTemplate I triple false
+    val { movRR, movRM, movRV, movMR } = getUtilMovs is8
+    val { opRR, opRM, opRV, opMR, opMV } = getUtilOps is8 "sub"
+  in
+    case tmp of
+      RRR (r1, r2, r3) => [movRR r1 r2, opRR r1 r3]
+    | RRM (r1, r2, off) => [movRR r1 r2, opRM r1 off]
+    | RRV (r1, r2, c) =>
+      if fitsInNsx 32 c then
+        [movRR r1 r2, opRV r1 c]
+      else
+        [movRR r1 r2, movRV Rax c, opRR r1 Rax]
+    | RMR (r1, off, r2) => [movRM r1 off, opRR r1 r2]
+    | RMM (r1, off1, off2) =>
+        [movRM r1 off1, movRM Rax off2, opRR r1 Rax]
+    | RMV (r1, off, v) =>
+      if fitsInNsx 32 v then
+        [movRM r1 off, opRV r1 v]
+      else
+        [movRM r1 off, movRV Rax v, opRR r1 Rax]
+    | RVR (r1, v, r2) => [movRV r1 v, opRR r1 r2]
+    | RVM (r, v, off) => [movRV r v, opRM r off]
+    | MRR (off, r1, r2) => [movRR Rax r1, opRR Rax r2, movMR off Rax]
+    | MRM (off1, r, off2) => [opRM r off2, movMR off1 r]
+    | MRV (off, r, v) =>
+        if fitsInNsx 32 v then
+          [movRR Rax r, opRV Rax v, movMR off Rax]
+        else
+          [movRR Rax r, movRV Rdx v, opRR Rax Rdx, movMR off Rax]
+    | MMR (off1, off2, r) => [movRM Rax off2, opRR Rax r, movMR off1 Rax]
+    | MMM (off1, off2, off3) =>
+        [movRM Rax off2, opRM Rax off3, movMR off1 Rax]
+    | MMV (off1, off2, v) =>
+        if fitsInNsx 32 v then
+          [movRM Rax off2, opRV Rax v, movMR off1 Rax]
+        else
+          [movRM Rax off2, movRV Rdx v, opRR Rax Rdx, movMR off1 Rax]
+    | MVM (off1, v, off2) => [movRV Rax v, opRM Rax off2, movMR off1 Rax]
+    | MVR (off1, v, r) => [movRV Rax v, opRR Rax r, movMR off1 Rax]
+    | RR (r1, r2) => [opRR r1 r2]
+    | RM (r, off) => [opRM r off]
+    | RV (r, v) =>
+        if fitsInNsx 32 v then
+          [opRV r v]
+        else
+          [movRV Rax v, opRR r Rax]
+    | MR (off, r) => [opMR off r]
+    | MM (off1, off2) => [movRM Rax off2, opMR off1 Rax]
+    | MV (off, v) =>
+        if fitsInNsx 32 v then
+          [opMV off v]
+        else
+          [movRV Rax v, opMR off Rax]
+  end
+
+  fun emitSet I (vrd, I.SaVReg vrs) =
+  let
+    val (is81, t1) = getType I vrd
+    val (is82, t2) = getType I vrs
+  in
+    case (is81, t1, is82, t2) of
+      (false, VtReg r1, false, VtReg r2)
+    | (false, VtReg r1, true, VtReg r2)
+    | (true, VtReg r1, true, VtReg r2) =>
+        if r1 = r2 then
+          []
+        else
+          [movRR true r1 r2]
+    | (true, VtReg r1, false, VtReg r2) => [movRR false r1 r2]
+
+    | (_, VtReg r1, _, VtConst c) => [movRV true r1  c]
+    | (_, VtReg r1, _, VtStack off) => [movRM true r1 off]
+    | (_, VtStack off, _, VtReg r) => [movMR true off r]
+    | (_, VtStack off1, _, VtStack off2) =>
+        [movRM true Rax off2, movMR true off1 Rax]
+
+    | (_, VtStack off, _, VtConst c) =>
+        if fitsInNsx 32 c then
+          [movMV true off c]
+        else
+          [movRV true Rax c, movMR true off Rax]
+
+    | (_, VtConst _, _, _) | (_, VtUnk, _, _) | (_, _, _, VtUnk) =>
+        raise Unreachable
+  end
+   | emitSet I (vrd, I.SaConst w) =
+   let
+      val (_, t1) = getType I vrd
+     val c = VConst w
+   in
+     case t1 of
+       VtReg r => [movRV true r c]
+     | VtStack off =>
+         if fitsInNsx 32 c then
+           [movMV true off c]
+         else
+           [movRV true Rax c, movMR true off Rax]
+     | VtConst _ | VtUnk => raise Unreachable
+   end
+   | emitSet I (vrd, I.SaAddr p) =
+   let
+     val (_, t1) = getType I vrd
+     val c = VAddrConst p
+   in
+     case t1 of
+       VtReg r => [movRV true r c]
+     | VtStack off => [movRV true Rax c, movMR true off Rax]
+     | VtUnk | VtConst _ => raise Unreachable
+   end
+
+  fun emitAlloc E (vrd, _, SOME stackOffset) =
+  let
+    val (is8, t1) = getType E vrd
+    val () = if not is8 then raise Unreachable else ()
+  in
+    case t1 of
+      VtReg r =>
+      [ sprintf `"lea " A2 pr true r `", [rsp-" I stackOffset `"]" % ]
+    | _ => raise Unreachable
+  end
+    | emitAlloc _ (_, _, NONE) = raise Unreachable
+
+  fun jmp lid = sprintf `"jmp .L" I lid %
+
+  fun emitRet (E as { ops, ... }) vr idx =
+  let
+    val begin =
+      case vr of
+        NONE => []
+      | SOME vr =>
+        let
+          val (is8, t) = getType E vr
+        in
+          case t of
+            VtReg r => [movRR is8 Rax r]
+          | VtStack off => [movRM is8 Rax off]
+          | VtConst c => [movRV is8 Rax c]
+          | VtUnk => raise Unreachable
+        end
+  in
+    if idx < D.length ops - 2 then
+      begin @ [ jmp 0 ]
+    else
+      begin
+  end
+
+  fun emitCopy E (vr, lid, size) =
+  let
+    val (is8, t) = getType E vr
+    val () = if not is8 then raise Unreachable else ()
+    val (prolog, destReg) =
+      case t of
+        VtReg r => ([], r)
+      | VtStack off => ([movRM true Rdx off], Rdx)
+      | VtConst _ | VtUnk => raise Unreachable
+
+    fun loop off acc =
+      if off = size then
+        rev acc
+      else
+        let
+          val from = sprintf `"mov rax, qword [.I" I lid `"+" W off `"]" %
+          val to =
+            sprintf `"mov [" A2 pr true destReg `"+" W off `"], rax" %
+        in
+          loop (off + 0w8) (to :: from :: acc)
+        end
+  in
+    loop 0w0 prolog
+  end
+
+  fun wordIsZero w =
+    case Word.compare (w, 0w0) of
+       EQUAL => true
+     | _ => false
+
+   datatype cbv = CbvTrue | CbvFalse | CbvUnsure of int * word
+
+  fun constBoolVal (VConst w) = if wordIsZero w then CbvFalse else CbvTrue
+   | constBoolVal (VAddrConst (id, off)) =
+    if wordIsZero off then
+     CbvTrue
+    else
+     CbvUnsure (id, off)
+
+  fun emitJz E (vr, lid) isJz =
+  let
+    val (is8, vt) = getType E vr
+    val jmp' = sprintf `"j" `(if isJz then "z" else "nz") `" .L" I lid %
+  in
+    case vt of
+      VtReg reg =>
+        [sprintf `"test " A2 pr is8 reg `", " A2 pr is8 reg %, jmp']
+    | VtStack off => [sprintf `"cmp " A2 pm is8 off `", 0" %, jmp']
+    | VtConst c => (
+      case constBoolVal c of
+        CbvTrue => [ jmp lid ]
+      | CbvFalse => []
+      | CbvUnsure (id, off) => [
+          sprintf `"lea rax, [" PP.? id I.Pwc I.VR8 off `"]" %,
+          sprintf `"test rax, 0" %,
+          jmp'
+      ]
+    )
+    | VtUnk => raise Unreachable
+  end
+
+  fun emitOpStrList ins E idx =
+    case ins of
+      I.IrSet p => emitSet E p
+    | I.IrAdd t => emitGenComm E "add" t
+    | I.IrAnd t => emitGenComm E "and" t
+    | I.IrOr t => emitGenComm E "or" t
+    | I.IrXor t => emitGenComm E "xor" t
+
+    | I.IrSub t => emitSub E t
+
+    | I.IrShl t => emitShift E "shl" t
+    | I.IrShr t => emitShift E "shr" t
+    | I.IrSar t => emitShift E "sar" t
+
+    | I.IrAlloc t => emitAlloc E t
+    | I.IrRet vr => emitRet E vr idx
+    | I.IrCopy t => emitCopy E t
+    | I.IrNopLabel lid => [ sprintf `".L" I lid % ]
+    | I.IrJmp lid => [ jmp lid ]
+    | I.IrJz p => emitJz E p true
+    | I.IrJnz p => emitJz E p false
+    | _ => []
+
+  fun emitIns (I as { ops, ... }) =
+  let
+    val outputBuf = Array.array (D.length ops, [])
+
+    fun printFromBuf () =
+    let
+      fun printLine line = (
+        if String.sub (line, 0) <> #"." then
+          fprint `"\t" %
+        else
+          ();
+        fprint `line `"\n" %
+      )
+
+    in
+      Array.app
+        (fn lines => List.app printLine lines)
+        outputBuf
+    end
+
+    fun loop idx =
+      if idx < 0 then
+        printFromBuf ()
+      else
+        let
+          val (ins, _) = D.get ops idx
+        in
+          case ins of
+            SOME ins =>
+            let
+              val slist = emitOpStrList ins I idx
+            in
+              Array.update (outputBuf, idx, slist);
+              loop (idx - 1)
+            end
+          | NONE => loop (idx - 1)
+        end
+  in
+    loop (D.length ops - 1)
+  end
+
+  fun emitFunction info name = (
+    fprint `"\nsection .text\n" %;
+    emitPrologue info name;
+    emitIns info;
+    emitEpilogue info
+  )
+
+  fun emitFunc (F as I.Fi { name, ... }) =
   let
-    val () = regAlloc F vregs
+    val info = regAlloc F
   in
-    raise Unimplemented
+    emitFunction info name
   end
 
   fun openFile fname = file := SOME (TextIO.openOut fname)