commit 08523a243816d556c72f5f96e44bbe8d3154cbe5
parent d051e0c21074a7e2450691d42a8d22dce219f541
Author: Quentin Carbonneaux <quentin.carbonneaux@yale.edu>
Date: Thu, 22 Jan 2015 11:37:16 -0500
implement linear scan ideas in lo2.ml
Diffstat:
| M | lo2.ml | | | 193 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------- |
1 file changed, 178 insertions(+), 15 deletions(-)
diff --git a/lo2.ml b/lo2.ml
@@ -2,7 +2,7 @@ type uop = Neg
type bop = Add | Sub | CLe | CEq
type bref = int (* Block references. *)
-type 'op seqi = [ `Nop | `Uop of uop * 'op | `Bop of 'op * bop * 'op ]
+type 'op seqi = [ `Con of int | `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 =
@@ -27,6 +27,7 @@ let liveout lh ir =
let livein lh p ir =
let gen (b, i) = IRSet.of_list begin
let {bb_inss; bb_jmp; _} = p.(b) in
+ if i = -1 then [] else
if i = Array.length bb_inss
then match bb_jmp with
| `Brz (i1, _, _) -> [i1]
@@ -34,11 +35,17 @@ let livein lh p ir =
else match bb_inss.(i) with
| `Uop (_, i1) -> [i1]
| `Bop (i1, _, i2) -> [i1; i2]
- | `Nop -> []
+ | `Con _ -> []
end in
+ let kill ((b, i) as ir) =
+ if i >= 0 then IRSet.singleton (IRIns ir) else
+ fst (Array.fold_left
+ (fun (k, i) _ -> (IRSet.add (IRPhi (b, i)) k, i+1))
+ (IRSet.empty, 0) p.(b).bb_phis
+ ) in
let s = liveout lh ir in
let s = IRSet.union s (gen ir) in
- IRSet.remove (IRIns ir) s
+ IRSet.diff s (kill ir)
let liveness (p: iprog) =
let module H = Hashtbl in
@@ -52,18 +59,18 @@ let liveness (p: iprog) =
H.replace lh ir' (IRSet.add ir lir');
end in
let succs (b, i) = (* Successor nodes of an instruction. *)
- let bb = {bb_inss; bb_jmp; _} in
+ let {bb_inss; bb_jmp; _} = p.(b) 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)]
+ | `Brz (_, b1, b2) -> [(b1, -1); (b2, -1)]
+ | `Jmp b1 -> [(b1, -1)]
else [(b, i+1)] in
while !changed do
changed := false;
for b = nbb - 1 downto 0 do
let bb = p.(b) in
- for i = Array.length bb.bb_inss downto 0 do
+ for i = Array.length bb.bb_inss downto -1 do
let ir = (b, i) in
let live = List.fold_left (fun live ir' ->
IRSet.union live (livein lh p ir')
@@ -75,8 +82,7 @@ let liveness (p: iprog) =
| IRPhi (b, _) | IRIns (b, _) -> b in
List.iter (fun ir ->
let br = blk ir in
- let bb = p.(br) in
- setlive ir (br, Array.length bb.bb_inss)
+ setlive ir (br, Array.length p.(br).bb_inss)
) il
) bb.bb_phis;
done
@@ -90,29 +96,186 @@ 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 module H = Hashtbl in
+ let module H = struct
+ include Hashtbl
+ let find h ir = try find h ir with Not_found -> LVoid
+ end 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
+ ; bb_jmp = `Jmp (-1)
}
) in
+ let outmaps = Array.make nbb [] in
+ let phimaps = Array.make nbb [| |] 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. *)
+ let act = H.create 101 in (* The active list. *)
+ let free = ref [0;1;2;3;4;5;6;7;8;9] in (* Free registers. *)
+
+ let nspill = ref 0 in
+ let newspill () = incr nspill; !nspill - 1 in
+ let getspill ir =
+ match H.find act ir with
+ | LSpill s -> s
+ | _ -> -1 in
+
+ let kill ir =
+ match H.find act ir with
+ | LReg r -> H.remove act ir; free := r :: !free
+ | _ -> () in
+
+ let loc ir =
+ match H.find act ir with
+ | LVoid ->
+ let l =
+ match !free with
+ | r :: f -> free := f; LReg r
+ | [] -> LSpill (newspill ()) (* Here we can try to spill the longer range instead. *)
+ in
+ H.add act ir l; l
+ | l -> l in
+
for b = nbb - 1 downto 0 do
- (* At the end, spill everyting not in liveout of the predecessor block. *)
+ let bi = p.(b).bb_inss in
+ let bl = Array.length bi in
+
+ (* Fill outmaps with the allocation state at
+ * the end of the block (after the final branch).
+ * Invariant 1: everything in registers is live.
+ *)
+
+ let lvout = liveout lh (b, bl) in
+ IRSet.iter (fun ir -> ignore (loc ir)) lvout;
+ outmaps.(b) <- begin
+ H.fold (fun ir l m ->
+ if IRSet.mem ir lvout
+ then (ir, l) :: m
+ else m
+ ) act []
+ end;
+
+ let jmp =
+ match p.(b).bb_jmp with
+ | `Jmp br -> `Jmp br
+ | `Brz (ir, br1, br2) -> `Brz (loc ir, br1, br2) in
+ rp.(b).bb_jmp <- jmp;
+
+ for i = bl - 1 downto 0 do
+ let ir = IRIns (b, i) in
+ begin match H.find act ir with
+ | LVoid -> () (* Dead code. *)
+ | lir ->
+ kill ir;
+ begin match bi.(i) with
+ | `Con k ->
+ emiti lir (`Mov (LCon k))
+ | `Uop (op, ir') ->
+ let lir' = loc ir' in
+ let spl = getspill ir in
+ if spl >= 0 && lir <> LSpill spl then
+ emiti (LSpill spl) (`Mov lir);
+ emiti lir (`Uop (op, lir'))
+ | `Bop (ir1, op, ir2) ->
+ let lir1 = loc ir1 in
+ let lir2 = loc ir2 in
+ let spl = getspill ir in
+ if spl >= 0 && lir <> LSpill spl then
+ emiti (LSpill spl) (`Mov lir);
+ emiti lir (`Bop (lir1, op, lir2))
+ end
+ end
+ done;
+
+ phimaps.(b) <- begin
+ Array.init (Array.length p.(b).bb_phis) (fun p ->
+ let pr = IRPhi (b, p) in
+ let ploc = H.find act pr in
+ kill pr; ploc
+ )
+ end;
+
+ (* Spill everyting not in liveout of the predecessor block.
+ * Remove them from the active list (ensures Invariant 1).
+ *)
+
+ let lvout =
+ if b = 0 then IRSet.empty else
+ liveout lh (b-1, Array.length p.(b-1).bb_inss) in
+ let spl = H.fold (fun ir l s ->
+ match l with
+ | LReg r ->
+ if IRSet.mem ir lvout then s else (ir, r) :: s
+ | _ -> s
+ ) act [] in
+ List.iter (fun (ir, r) ->
+ let spl = LSpill (newspill ()) in
+ free := r :: !free;
+ H.replace act ir spl;
+ emiti (LReg r) (`Mov spl)
+ ) spl;
+
rp.(b).bb_inss <- Array.of_list !bb;
bb := [];
done;
+
+ (* Compute phis. *)
+ for b = 0 to nbb - 1 do
+ rp.(b).bb_phis <- begin
+ Array.mapi (fun i (`Phi l) ->
+ { rp_res = phimaps.(b).(i)
+ ; rp_list = List.map (function
+ | IRPhi (b, p) -> b, phimaps.(b).(i)
+ | IRIns (b, _) as ir -> (b, List.assoc ir outmaps.(b))
+ ) l
+ }
+ ) p.(b).bb_phis
+ end
+ done;
+
rp
+(* Facts
+ * There are little lifetime holes in SSA (caused by block ordering)
+ *)
+
+
+(* Little tests. *)
+let pbasic: iprog =
+ [| { bb_name = "start"
+ ; bb_phis = [| |]
+ ; bb_inss =
+ [| `Con 2
+ ; `Con 3
+ ; `Bop (IRIns (0, 0), Add, IRIns (0, 1))
+ ; `Bop (IRIns (0, 0), Add, IRIns (0, 2))
+ |]
+ ; bb_jmp = `Brz (IRIns (0, 3), -1, -1)
+ }
+ |]
+
+let pcount: iprog =
+ [| { bb_name = "init"
+ ; bb_phis = [||]
+ ; bb_inss = [| `Con 100; `Con 1 |]
+ ; bb_jmp = `Jmp 1
+ }
+ ; { bb_name = "loop"
+ ; bb_phis = [| `Phi [IRIns (0, 0); IRIns (1, 0)] |]
+ ; bb_inss = [| `Bop (IRPhi (1, 0), Sub, IRIns (0, 1)) |]
+ ; bb_jmp = `Brz (IRIns (1, 0), 2, 1)
+ }
+ ; { bb_name = "end"
+ ; bb_phis = [||]
+ ; bb_inss = [| `Con 42 |]
+ ; bb_jmp = `Jmp (-1)
+ }
+ |]
(* ** Phi resolution. ** *)
(* Machine program, ready for code generation. *)
