Register map

4 files changed, 155 insertions, 33 deletions

diff --git a/common.sml b/common.sml
index f8adede..7ed59c3 100644
--- a/common.sml
+++ b/common.sml
@@ -124,6 +124,25 @@ in
   Fold.fold ((false, makePrintfBase output), finish)
 end g
 
+fun printfp n g =
+let
+  val buf = ref []
+  fun output s = buf := s :: !buf
+  fun finish _ =
+  let
+    val s = String.concat $ rev $ !buf
+    val s =
+      if size s < n then
+        implode (List.tabulate (n - size s, fn _ => #" ")) ^ s
+      else
+        s
+  in
+    TextIO.output (TextIO.stdOut, s)
+  end
+in
+  Fold.fold ((false, makePrintfBase output), finish)
+end g
+
 fun Printf out g = Fold.fold ((false, out), fn _ => ()) g
 
 local
@@ -152,6 +171,24 @@ fun F z = bind A0 (fn (_, mf) => mf ()) z
 val I = fn z => bindWith2str Int.toString z
 fun i v out = Printf out I v %
 
+val Ip = fn z =>
+let
+  fun f w i out =
+  let
+    val s = Int.toString i
+    val len = size s
+    val s =
+      if len < w then
+        implode (List.tabulate (w - len, fn _ => #" ")) ^ s
+      else
+        s
+  in
+    Printf out `s %
+  end
+in
+  bind A2 f
+end z
+
 val C = fn z => bindWith2str str z
 val B = fn z => bindWith2str Bool.toString z
 val W = fn z => bindWith2str (Word.fmt StringCvt.DEC) z
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
diff --git a/il.fun b/il.fun
index 9f8c2b7..416f4b0 100644
--- a/il.fun
+++ b/il.fun
@@ -1202,7 +1202,7 @@ functor IL(P: PARSER) = struct
     | P.StmtDoWhile pair => convDoWhile ctx pair
     | P.StmtBreak => convBreakOrCont true ctx
     | P.StmtContinue => convBreakOrCont false ctx
-    | P.StmtNone => raise Unreachable
+    | P.StmtNone => ()
 
   val Pl = fn z =>
   let
@@ -1382,7 +1382,7 @@ functor IL(P: PARSER) = struct
   let
     val c = if class = VR4 then "w4" else "w8"
 
-    val () = printf `"%" I idx `" " `c
+    val () = printf `"%" Ip 4 idx `" " `c
           `": defs = " Plist i defs (", ", true, 0)
           `", uses = " Plist i use (", ", true, 0) %
   in
diff --git a/parser.fun b/parser.fun
index ae5f2e3..d49f895 100644
--- a/parser.fun
+++ b/parser.fun
@@ -3781,7 +3781,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
         Printf out `"return " Popt pea ea `";" %
     | pstmt' _ StmtBreak out = Printf out `"break;" %
     | pstmt' _ StmtContinue out = Printf out `"continue;" %
-    | pstmt' _ StmtNone _ = raise Unreachable
+    | pstmt' _ StmtNone out =  Printf out `";" %
 
   and pCompBody off (S as (StmtCompound _)) out =
     Printf out A2 pstmt' (off - 1) S %