From 72a74b97ab3a946e54c5e75b2362740aa3a3ff65 Mon Sep 17 00:00:00 2001
From: Quentin Carbonneaux <quentin.carbonneaux@yale.edu>
Date: Mon, 5 Jan 2015 21:56:49 -0500
Subject: try to add code for phis

---
 lo.ml | 76 +++++++++++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 51 insertions(+), 25 deletions(-)

(limited to 'lo.ml')

diff --git a/lo.ml b/lo.ml
index 369a66d..06b7fc2 100644
--- a/lo.ml
+++ b/lo.ml
@@ -105,8 +105,7 @@ type spill = { sreg: int; soff: int }
 
 type regir =
   | RIR of int * (loc, int ref) ir
-  | RSSave of spill (* Spill save. *)
-  | RSRest of spill (* Spill restore. *)
+  | RMove of loc * loc
 
 (* The reg IR adds spill saves and restores to standard
    IR instructions.  The register allocator below uses
@@ -162,7 +161,7 @@ let regalloc nr p l =
         match try List.assoc sir !locs with _ -> L0 with
         | LSpl n -> n
         | _ -> setspill sir in
-      emit (RSRest {sreg; soff});
+      emit (RMove (LReg sreg, LSpl soff));
       ret sreg in
 
   (* Find a location for an operand. *)
@@ -174,32 +173,55 @@ let regalloc nr p l =
       | _ -> LReg (alloc hints.(i) i) in
 
   let loc2 i =
-    try List.assoc i !locs
-    with Not_found ->
-      match p.(i) with
-      | ICon k -> setloc i (LCon k); LCon k
-      | _ ->
-        (* Here, we just want to avoid using the
-           same register we used for the first
-           operand. *)
-        if free () = [] then LSpl (setspill i)
-        else LReg (alloc hints.(i) i) in
+    try List.assoc i !locs with Not_found ->
+    match p.(i) with
+    | ICon k -> setloc i (LCon k); LCon k
+    | _ ->
+      (* Here, we just want to avoid using the
+         same register we used for the first
+         operand. *)
+      if free () = [] then LSpl (setspill i)
+      else LReg (alloc hints.(i) i) in
 
   (* Find a register for a destination. *)
   let dst i =
     let li =
-      try List.assoc i !locs
-      with Not_found -> L0 in
+      try List.assoc i !locs with Not_found -> L0 in
     let r = match li with
       | LReg r -> r
       | _ -> alloc hints.(i) i in
     begin match li with
-    | LSpl l -> emit (RSSave {sreg=r; soff=l})
+    | LSpl l -> emit (RMove (LSpl l, LReg r))
     | _ -> ()
     end;
     locs := snd (List.partition (fun (j,_) -> j=i) !locs);
     r in
 
+  let phis = ref [] in
+  let philoc i =
+    match p.(i) with
+    | IPhi pl ->
+      (try List.assoc i !phis with Not_found ->
+      let l = loc2 i in
+      phis := (i, l) :: !phis;
+      begin match l with
+      | LReg h -> List.iter (fun x -> hints.(x.pvar) <- h) pl;
+      | _ -> ()
+      end;
+      l)
+    | _ -> failwith "regalloc: invalid call to philoc" in
+  let rec movs jmp i =
+    match p.(i) with
+    | IPhi l ->
+      let l = List.filter (fun x -> x.pjmp = jmp) l in
+      assert (List.length l = 1);
+      let pl = philoc i in
+      let v = (List.hd l).pvar in
+      emit (RMove (pl, List.assoc v !locs));          (* XXX problem here! the variables might not be allocated *)
+      movs jmp (i+1)
+    | _ -> () in
+
+
   (* Going backwards. *)
   for i = Array.length p -1 downto 0 do
 
@@ -214,8 +236,11 @@ let regalloc nr p l =
       let li' = loc i' in
       emit (RIR (-1, IBrz (li', ipos.(l1), ipos.(l2))))
     | IJmp l ->
+      movs i l;
       emit (RIR (-1, IJmp (ipos.(l))))
-    | IPhi l ->
+    | IPhi l -> ()
+
+      (*
       (* Try to ensure that variables merged by a phi
          use the same register. *)
       let f r {pvar;_} =
@@ -224,9 +249,11 @@ let regalloc nr p l =
             | _ -> r
         with Not_found -> r in
       let h = List.fold_left f (-1) l in
-      let _ = hints.(i) <- hints.(i) |> h in
-      let r = dst i in
-      emit (RIR (r, IPhi [])) (* FIXXXME *)
+      List.iter (fun {pvar;_} -> hints.(pvar) <- h) l;
+      let l = try List.assoc i !locs with Not_found -> L0 in
+      phis := (i, l) :: !phis
+      *)
+
     | IUop (op, i') ->
       let r = dst i in
       let li' = hints.(i') <- r; loc i' in
@@ -361,7 +388,8 @@ let t_sum =
   ; "f1:  phi [ jmp f2 ] [ k1 k1 ] ."
   ; "n1:  sub n0 k1"
   ; "f2:  add f1 n0"
-  ; "jmp: brz n1 end n0"
+  (* ; "jmp: brz n1 end n0" *)
+  ; "jmp: jmp n0"
   ; "end:"
   ]
 
@@ -447,10 +475,8 @@ let _ =
       printf "jmp %03d" !l
     | RIR (_, IPhi l) ->
       printf "phi"
-    | RSSave {sreg; soff} ->
-      printf "%d(sp) = %s" soff regs.(sreg)
-    | RSRest {sreg; soff} ->
-      printf "%s = %d(sp)" regs.(sreg) soff
+    | RMove (t, f) ->
+      printf "%s = %s" (loc t) (loc f)
     | _ -> ()
     end;
     printf "\n"
-- 
cgit 1.4.1