From d051e0c21074a7e2450691d42a8d22dce219f541 Mon Sep 17 00:00:00 2001
From: Quentin Carbonneaux <quentin.carbonneaux@yale.edu>
Date: Wed, 14 Jan 2015 22:36:53 -0500
Subject: start hacking new regalloc

---
 lo2.ml | 101 +++++++++++++++++++++++++++++++++++++----------------------------
 1 file changed, 58 insertions(+), 43 deletions(-)

diff --git a/lo2.ml b/lo2.ml
index 337fccc..a6f8519 100644
--- a/lo2.ml
+++ b/lo2.ml
@@ -6,65 +6,67 @@ type 'op seqi = [ `Nop | `Uop of uop * 'op | `Bop of 'op * bop * 'op ]
 type 'op jmpi = [ `Brz of 'op * bref * bref | `Jmp of bref ]
 
 type ('ins, 'phi, 'jmp) bb =
-  { bb_name: string
-  ; bb_phis: [ `Phi of 'phi list ] array
-  ; bb_inss: 'ins array
-  ; bb_jmp: 'jmp
+  { mutable bb_name: string
+  ; mutable bb_phis: 'phi array
+  ; mutable bb_inss: 'ins array
+  ; mutable bb_jmp: 'jmp
   }
 
 
 (* ** Liveness analysis. ** *)
 type iref = IRPhi of (bref * int) | IRIns of (bref * int)
-type iprog = (iref seqi, iref, iref jmpi) bb array
+type iprog = (iref seqi, [`Phi of iref list], iref jmpi) bb array
 
 module IRSet = Set.Make(
   struct type t = iref let compare = compare end
 )
 
+let liveout lh ir =
+  try Hashtbl.find lh ir with Not_found ->
+  let e = IRSet.empty in Hashtbl.add lh ir e; e
+let livein lh p ir =
+  let gen (b, i) = IRSet.of_list begin
+    let {bb_inss; bb_jmp; _} = p.(b) in
+      if i = Array.length bb_inss
+      then match bb_jmp with
+      | `Brz (i1, _, _) -> [i1]
+      | `Jmp _ -> []
+      else match bb_inss.(i) with
+      | `Uop (_, i1) -> [i1]
+      | `Bop (i1, _, i2) -> [i1; i2]
+      | `Nop -> []
+    end in
+  let s = liveout lh ir in
+  let s = IRSet.union s (gen ir) in
+  IRSet.remove (IRIns ir) s
+
 let liveness (p: iprog) =
   let module H = Hashtbl in
   let changed = ref true in (* Witness for fixpoint. *)
+  let nbb = Array.length p in
   let lh = H.create 1001 in
-  let liveout ir =
-    try H.find lh ir with Not_found ->
-    let e = IRSet.empty in H.add lh ir e; e in
   let setlive ir ir' = (* Mark ir live at ir'. *)
-    let lir' = liveout ir' in
+    let lir' = liveout lh ir' in
     if not (IRSet.mem ir lir') then begin
       changed := true;
       H.replace lh ir' (IRSet.add ir lir');
     end in
   let succs (b, i) = (* Successor nodes of an instruction. *)
-    let bb = p.(b) in
-    if i+1 = Array.length bb.bb_inss then
-      if b+1 = Array.length p then [] else
-      match bb.bb_jmp with
+    let bb = {bb_inss; bb_jmp; _} in
+    if i = Array.length bb_inss then
+      if b+1 = nbb then [] else
+      match bb_jmp with
       | `Brz (_, b1, b2) -> [(b1, 0); (b2, 0)]
       | `Jmp b1 -> [(b1, 0)]
     else [(b, i+1)] in
-  let gen (b, i) = IRSet.of_list
-    begin match p.(b).bb_inss.(i) with
-    | `Uop (_, i1) -> [i1]
-    | `Bop (i1, _, i2) -> [i1; i2]
-    | `Nop -> []
-    end in
-  let livein ir =
-    let s = liveout ir in
-    let s = IRSet.union s (gen ir) in
-    IRSet.remove (IRIns ir) s in
   while !changed do
     changed := false;
-    for b = Array.length p - 1 downto 0 do
+    for b = nbb - 1 downto 0 do
       let bb = p.(b) in
-      begin match bb.bb_jmp with
-      | `Brz (ir', _, _) ->
-        setlive ir' (b, Array.length bb.bb_inss - 1)
-      | `Jmp _ -> ()
-      end;
-      for i = Array.length bb.bb_inss - 1 downto 0 do
+      for i = Array.length bb.bb_inss downto 0 do
         let ir = (b, i) in
         let live = List.fold_left (fun live ir' ->
-            IRSet.union live (livein ir')
+            IRSet.union live (livein lh p ir')
           ) IRSet.empty (succs ir) in
         IRSet.iter (fun ir' -> setlive ir' ir) live
       done;
@@ -74,7 +76,7 @@ let liveness (p: iprog) =
         List.iter (fun ir ->
           let br = blk ir in
           let bb = p.(br) in
-          setlive ir (br, Array.length bb.bb_inss - 1)
+          setlive ir (br, Array.length bb.bb_inss)
         ) il
       ) bb.bb_phis;
     done
@@ -84,19 +86,32 @@ let liveness (p: iprog) =
 
 (* ** Register allocation. ** *)
 type loc = LVoid | LReg of int | LSpill of int | LCon of int
-type 'op regi = [ 'op seqi | `Mov of 'op ]
-type 'op rins =
-  { mutable ri_loc: 'op
-  ; mutable ri_ins: 'op regi
-  ; mutable ri_hint: int
-  }
-(* Register program, still has phi nodes. *)
-type rprog = (loc rins, (bref * loc), loc jmpi) bb array
+type 'op rins = { ri_res: 'op; ri_ins: [ 'op seqi | `Mov of 'op ] }
+type 'op rphi = { rp_res: 'op; rp_list: (bref * loc) list }
+type rprog = (loc rins, loc rphi, loc jmpi) bb array
+
 
-(*
 let regalloc nr (p: iprog) =
-  let liveh = liveness p in
-*)
+  let module H = Hashtbl in
+  let lh = liveness p in
+  let nbb = Array.length p in
+  let bbmaps = Array.create nbb [] in
+  let rp = Array.init nbb (fun i ->
+      { bb_name = p.(i).bb_name
+      ; bb_phis = [| |]
+      ; bb_inss = [| |]
+      ; bb_jmp = `Jmp -1
+      }
+    ) in
+  let bb = ref [] in (* Basic block in construction. *)
+  let emiti l i = bb := {ri_res=l; ri_ins=i} :: !bb in
+  let m = H.create 101 in (* The map from iref to locations. *)
+  for b = nbb - 1 downto 0 do
+    (* At the end, spill everyting not in liveout of the predecessor block. *)
+    rp.(b).bb_inss <- Array.of_list !bb;
+    bb := [];
+  done;
+  rp
 
 
 (* ** Phi resolution. ** *)
-- 
cgit 1.4.1