Register map

1 files changed, 115 insertions, 30 deletions

diff --git a/emit.fun b/emit.fun
index ada0217..f3aa799 100644
--- a/emit.fun
+++ b/emit.fun
@@ -20,27 +20,27 @@ functor Emit(I: IL) = struct
   datatype affinity = AfHard of reg | AfSoft of int list | AfUnk
 
   val regs = [
-    (Rax, 0),
-    (Rdx, 1),
-    (Rsp, 2),
-    (Rbp, 3),
-
-    (Rcx, 4),
-    (Rsi, 5),
-    (Rdi, 6),
-    (R8, 7),
-    (R9, 8),
-    (R10, 9),
-    (R11, 10),
-
-    (Rbx, 11),
-    (R12, 12),
-    (R13, 13),
-    (R14, 14),
-    (R15, 15)
+    (Rcx, 0),
+    (Rsi, 1),
+    (Rdi, 2),
+    (R8, 3),
+    (R9, 4),
+    (R10, 5),
+    (R11, 6),
+
+    (Rbx, 7),
+    (R12, 8),
+    (R13, 9),
+    (R14, 10),
+    (R15, 11),
+
+    (Rax, 12),
+    (Rdx, 13),
+    (Rsp, 14),
+    (Rbp, 15)
   ]
 
-  val firstUsedReg = 4
+  val callerSavedRegs = 7
   val usedRegNum = 12
 
   fun reg2idx reg =
@@ -512,7 +512,7 @@ functor Emit(I: IL) = struct
 
   fun returnToPool pool reg =
   let
-    val idx = reg2idx reg - firstUsedReg
+    val idx = reg2idx reg
   in
     Array.update (pool, idx, NONE)
   end
@@ -577,7 +577,7 @@ functor Emit(I: IL) = struct
           | NONE =>
             let
               val () = Array.update (pool, idx, SOME vr);
-              val reg = idx2reg (firstUsedReg + idx)
+              val reg = idx2reg idx
 
               val () = printfn R poff
                 `"assigned (first) reg " Preg reg `" to %" ip vr %
@@ -596,7 +596,7 @@ functor Emit(I: IL) = struct
         rev acc
       else
         case Array.sub (pool, idx) of
-          NONE => loop (idx + 1) (idx2reg (idx + firstUsedReg) :: acc)
+          NONE => loop (idx + 1) (idx2reg idx :: acc)
         | SOME _ => loop (idx + 1) acc
   in
     loop 0 []
@@ -658,7 +658,7 @@ functor Emit(I: IL) = struct
       let
       in
         updReg rinfo vr (VtReg reg);
-        Array.update (pool, reg2idx reg - firstUsedReg, SOME vr);
+        Array.update (pool, reg2idx reg, SOME vr);
         printfn R (poff + 1)
           `"assigned (by affinity) reg " Preg reg `" to %" ip vr %;
         printfn R (poff + 1)
@@ -680,7 +680,7 @@ functor Emit(I: IL) = struct
     val () = printfn R poff
       `"trying to assign hard reg " A1 preg reg `" to %" ip vr %
 
-    val regIdx = reg2idx reg - firstUsedReg
+    val regIdx = reg2idx reg
     val user = Array.sub (pool, regIdx)
 
     fun setOurReg () =
@@ -731,7 +731,7 @@ functor Emit(I: IL) = struct
   let
     val vr = #1 int
 
-    val regIdx = reg2idx reg - firstUsedReg
+    val regIdx = reg2idx reg
     val u = valOf $ Array.sub (pool, regIdx)
 
     val (uAff, _) = Array.sub (rinfo, u)
@@ -789,7 +789,7 @@ functor Emit(I: IL) = struct
           val () = printfn `"spilling!!!" %
         in
           Array.update (pool, idx, SOME vr);
-          updReg rinfo vr (VtReg $ idx2reg (idx + firstUsedReg));
+          updReg rinfo vr (VtReg $ idx2reg idx);
           putToStack 1 I (#1 spill);
           changeInActive active int (#1 spill)
         end
@@ -859,7 +859,7 @@ functor Emit(I: IL) = struct
           val (_, vt) = Array.sub (rinfo, idx)
         in
           case vt of
-            VtReg reg => Array.update (regs, reg2idx reg - firstUsedReg, true)
+            VtReg reg => Array.update (regs, reg2idx reg, true)
           | _ => ();
           loop (idx + 1)
         end
@@ -870,13 +870,95 @@ functor Emit(I: IL) = struct
         acc
       else
         if Array.sub (regs, idx) then
-          collect (idx + 1) (idx2reg (idx + firstUsedReg) :: acc)
+          collect (idx + 1) (idx2reg idx :: acc)
         else
           collect (idx + 1) acc
   in
     collect 0 []
   end
 
+  fun getRegsToSave rinfo =
+  let
+    val regs = getUsedRegs rinfo
+  in
+    List.filter (fn r => reg2idx r >= callerSavedRegs) regs
+  end
+
+  fun initMap len =
+  let
+    open Array
+    val map = array (len, array (callerSavedRegs, NONE))
+    val i = ref 1
+  in
+    while !i < len do (
+        update (map, !i, array (callerSavedRegs, NONE));
+        i := !i + 1
+    );
+    map
+  end
+
+  fun computeMap len intervals rinfo =
+  let
+    val map = initMap len
+
+    fun addInt (vr, startp, endp) =
+      case #2 $ Array.sub (rinfo, vr) of
+        VtReg reg =>
+          let
+            fun f idx =
+              if reg2idx reg >= callerSavedRegs orelse idx = endp then
+                ()
+              else
+                let
+                  val row = Array.sub (map, idx)
+                in
+                  Array.update (row, reg2idx reg, SOME vr);
+                  f (idx + 1)
+                end
+          in
+            f (startp + 1)
+          end
+      | _ => ()
+  in
+    List.app addInt intervals;
+    map
+  end
+
+  fun printMap map =
+  let
+    val () = printfn `"Register map\n" %
+
+    fun printHeader idx =
+      if idx = callerSavedRegs then
+        printf `"\n" %
+      else (
+        printfp 5 `" " Preg (idx2reg idx) `" " %;
+        printHeader (idx + 1)
+      )
+
+    val () = printf `"      " %
+    val () = printHeader 0
+
+    fun printRow (idx, row) =
+    let
+      val () = printf Ip 4 idx `": " %
+
+      fun loop idx =
+        if idx = callerSavedRegs then
+          printf `"\n" %
+        else (
+          case Array.sub (row, idx) of
+            NONE => printf `"     " %
+          | SOME vr => printfp 5 `"%" I vr `" " %;
+          loop (idx + 1)
+        )
+    in
+      loop 0
+    end
+  in
+    Array.appi printRow map
+  end
+
   fun regAlloc (F as I.Fi { vregs, ops, paramNum, ... }) =
   let
     val (toAlloc, regInfo) = prepareRegInfo paramNum ops vregs
@@ -889,9 +971,12 @@ functor Emit(I: IL) = struct
     val () = linearscan regInfo intervals
     val () = printAlloced regInfo toAlloc
 
-    val usedRegs = getUsedRegs regInfo
+    val regsToSave = getRegsToSave regInfo
     val () = printfn
-      `"used registers: " Plist preg usedRegs (", ", true, 0) %
+      `"registers to save: " Plist preg regsToSave (", ", true, 0) %
+
+    val regMap = computeMap (D.length ops) intervals regInfo
+    val () = printMap regMap
   in
     raise Unimplemented
   end