commit 6d6b1ef4b076e72623a46f45308aba80edc2b4e5
parent c65422a14fef7b7403ba21aa5cf672446393d359
Author: Quentin Carbonneaux <quentin.carbonneaux@yale.edu>
Date: Tue, 31 Mar 2015 13:23:37 -0400
better support for constants
Diffstat:
| M | lo2.ml | | | 60 | +++++++++++++++++++++++++++++++++++++++--------------------- |
1 file changed, 39 insertions(+), 21 deletions(-)
diff --git 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;
