From 6d6b1ef4b076e72623a46f45308aba80edc2b4e5 Mon Sep 17 00:00:00 2001
From: Quentin Carbonneaux <quentin.carbonneaux@yale.edu>
Date: Tue, 31 Mar 2015 13:23:37 -0400
Subject: better support for constants

---
 lo2.ml | 60 +++++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 39 insertions(+), 21 deletions(-)

diff --git a/lo2.ml b/lo2.ml
index 8623fff..d068e01 100644
--- a/lo2.ml
+++ b/lo2.ml
@@ -98,7 +98,14 @@ type rprog = (loc rins, loc rphi, loc jmpi) bb array
 let regalloc (p: iprog): rprog =
   let module H = struct
     include Hashtbl
-    let find h ir = try find h ir with Not_found -> LVoid
+    let find h ir =
+      try find h ir with Not_found ->
+      let k = ref 0 in
+      let isconst = function
+        `Con c -> k := c; true | _ -> false in
+      match ir with
+      | IRIns (b, i) when isconst p.(b).bb_inss.(i) -> LCon !k
+      | _ -> LVoid
   end in
 
   let lh = liveness p in
@@ -168,10 +175,11 @@ let regalloc (p: iprog): rprog =
 
   let regloc frz ir =
     match H.find act ir with
-    | LReg r -> r
+    | (LCon _ | LReg _) as loc -> loc
     | _ ->
       let r = getreg frz in
-      H.add act ir (LReg r); r in
+      H.add act ir (LReg r);
+      LReg r in
 
   for b = nbb - 1 downto 0 do
     let bi = p.(b).bb_inss in
@@ -195,7 +203,7 @@ let regalloc (p: iprog): rprog =
     for i = bl - 1 downto 0 do
       let ir = IRIns (b, i) in
       begin match H.find act ir with
-      | LVoid -> () (* Dead code. *)
+      | LCon _ | LVoid -> () (* Dead code. *)
       | lir ->
         let r, frz =
           match lir with
@@ -211,19 +219,19 @@ let regalloc (p: iprog): rprog =
         kill ir;
         let s = getspill ir in
         begin match bi.(i) with
-        | `Con k ->
-          if s >= 0 then emiti (LSpill s) (`Mov (LReg r));
-          emiti (LReg r) (`Mov (LCon k))
+        | `Con k -> ()
         | `Uop (op, ir') ->
-          let r' = regloc frz ir' in
+          let l' = regloc frz ir' in
           if s >= 0 then emiti (LSpill s) (`Mov (LReg r));
-          emiti (LReg r) (`Uop (op, LReg r'))
+          emiti (LReg r) (`Uop (op, l'))
         | `Bop (ir1, op, ir2) ->
-          let r1 = regloc frz ir1 in
-          let frz = r :: r1 :: frz in
-          let r2 = regloc frz ir2 in
+          let l1 = regloc frz ir1 in
+          let frz = match l1 with
+            | LReg r1 -> r :: r1 :: frz
+            | _ -> r :: frz in                                                             (* WHY? *)
+          let l2 = regloc frz ir2 in
           if s >= 0 then emiti (LSpill s) (`Mov (LReg r));
-          emiti (LReg r) (`Bop (LReg r1, op, LReg r2))
+          emiti (LReg r) (`Bop (l1, op, l2))
         end;
       end
     done;
@@ -408,10 +416,13 @@ let codegen (p: mprog): string =
       end in
     f 0 x; Bytes.unsafe_to_string byt in
 
+  let oins op r m =
+    let rex, r, m = rexp r m in
+    outb rex; outb op; outb (modrm r m) in
+
   let move l l1 = match l, l1 with
     | (LReg _ as r), LCon k ->
-      let rex, r, m = rexp 0 (regn r) in
-      outb rex; outb 0xc7; outb (modrm r m); outs (lite k)
+      oins 0xc7 0 (regn r); outs (lite k)
     | (LReg _ as r), (LReg _ as r1) ->
       let rex, r1, r = rexp (regn r1) (regn r) in
       outb rex; outb 0x89; outb (modrm r1 r)
@@ -423,10 +434,6 @@ let codegen (p: mprog): string =
       outb rex; outb 0x89; outb (modrm ~md:1 r m); outb (s*4)
     | _ -> failwith "invalid move" in
 
-  let oins op r m =
-    let rex, r, m = rexp r m in
-    outb rex; outb op; outb (modrm r m) in
-
   let nbb = Array.length p in
   let boffs = Array.make nbb (`Unk []) in
   let label b =
@@ -460,8 +467,18 @@ let codegen (p: mprog): string =
         if l1 <> l then
           move l l1;
         begin match op with
-        | Add -> oins 0x01 (regn l2) (regn l)
-        | Sub -> oins 0x29 (regn l2) (regn l)
+        | Add ->
+          begin match l2 with
+          | LCon k -> oins 0x83 0 (regn l); outs (lite k)
+          | LReg _ -> oins 0x01 (regn l2) (regn l)
+          | _ -> assert false
+          end
+        | Sub ->
+          begin match l2 with
+          | LCon k -> oins 0x81 5 (regn l); outs (lite k)
+          | LReg _ -> oins 0x29 (regn l2) (regn l)
+          | _ -> assert false
+          end
         | CLe -> failwith "CLe not implemented"
         | CEq -> failwith "CEq not implemented"
         end
@@ -578,6 +595,7 @@ let pspill: iprog =
 (* ------------------------------------------------------------------------ *)
 
 let _ =
+  if true then
   let oc = open_out "comp.bin" in
   let s = psum |> regalloc |> movgen |> codegen in
   output_string oc s;
-- 
cgit 1.4.1