From b83133cbbedbbd4de94e293e439a3e21476619ad Mon Sep 17 00:00:00 2001
From: Quentin Carbonneaux <quentin.carbonneaux@yale.edu>
Date: Fri, 13 Feb 2015 22:37:07 -0500
Subject: attempt a new linear scan implementation

---
 heap.ml | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lo2.ml  | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lo3.ml  | 58 ----------------------------------------------------------
 3 files changed, 121 insertions(+), 58 deletions(-)
 create mode 100644 heap.ml
 delete mode 100644 lo3.ml

diff --git a/heap.ml b/heap.ml
new file mode 100644
index 0000000..502fd57
--- /dev/null
+++ b/heap.ml
@@ -0,0 +1,58 @@
+(* Generic binary heaps. *)
+module Heap: sig
+  type 'a t
+  val create: ('a -> 'a -> int) -> 'a t
+  val add: 'a t -> 'a -> unit
+  val pop: 'a t -> 'a option
+  val top: 'a t -> 'a option
+end = struct
+  type 'a t =
+    { mutable arr: 'a array
+    ; mutable len: int
+    ; cmp: 'a -> 'a -> int
+    }
+
+  let mkarray n = Array.make n (Obj.magic 0)
+  let create cmp = {arr = mkarray 2; len = 0; cmp }
+  let top {arr; len; _} =
+    if len = 0 then None else Some arr.(1)
+  let swap arr i j =
+    let tmp = arr.(i) in
+    arr.(i) <- arr.(j);
+    arr.(j) <- tmp
+
+  let rec bblup cmp arr i =
+    let prnt = i/2 in
+    if prnt = 0 then () else
+    if cmp arr.(prnt) arr.(i) < 0 then () else
+    (swap arr prnt i; bblup cmp arr prnt)
+  let add ({arr; len; cmp} as hp) x =
+    let arr =
+      let alen = Array.length arr in
+      if alen > len+1 then arr else
+      let arr' = mkarray (alen * 2) in
+      Array.blit arr 0 arr' 0 alen;
+      hp.arr <- arr';
+      arr' in
+    hp.len <- len + 1;
+    arr.(hp.len) <- x;
+    bblup cmp arr hp.len
+
+  let rec bbldn cmp arr i len =
+    let ch0 = 2*i in
+    let ch1 = ch0 + 1 in
+    if ch0 > len then () else
+    let mn =
+      if ch1 > len then ch0 else
+      if cmp arr.(ch0) arr.(ch1) < 0
+      then ch0 else ch1 in
+    if cmp arr.(i) arr.(mn) <= 0 then () else
+    (swap arr i mn; bbldn cmp arr mn len)
+  let pop ({arr; len; cmp} as hp) =
+    if len = 0 then None else
+    let t = top hp in
+    arr.(1) <- arr.(len);
+    hp.len <- len - 1;
+    bbldn cmp arr 1 len;
+    t
+end
diff --git a/lo2.ml b/lo2.ml
index f15d53a..7ff7e60 100644
--- a/lo2.ml
+++ b/lo2.ml
@@ -1,3 +1,5 @@
+#use "heap.ml";;
+
 type uop = Neg
 type bop = Add | Sub | CLe | CEq
 
@@ -245,6 +247,67 @@ let regalloc (p: iprog) =
  *)
 
 
+(* ** NEW attempt at a more clever allocator. ** *)
+
+let ircmp a b =
+  let blk = function IRPhi (b,_) | IRIns (b,_) -> b in
+  let cb = compare (blk a) (blk b) in
+  if cb <> 0 then cb else
+  match a, b with
+  | IRPhi _, IRIns _ -> -1
+  | IRIns _, IRPhi _ -> +1
+  | IRPhi (_,x), IRPhi (_,y)
+  | IRIns (_,x), IRIns (_,y) -> compare x y
+
+(* An interval specifies a region of the program text (usually where
+ * a variable is live. It has two bounds, lo and hi, they are both
+ * inclusive.  (We cannot have an empty interval.)
+ *)
+type inter = { lo: iref; hi: iref }
+
+(* The register type is used to store the usage of a given register
+ * by the program.  The list of intervals it stores has to be non-
+ * overlapping.
+ * Invariant: Intervals are stored.
+ *)
+type reg = { mutable busy: (iref * inter) list }
+
+let reg_dispo {busy} i =
+  let rec f = function
+    | (_, {lo; hi}) :: l ->
+      if ircmp hi i.lo < 0 then f l else  (* [lo, hi] ... [i] *)
+      if ircmp lo i.hi < 0 then true else (* [i] ... [lo, hi] *)
+      false                               (* overlap *)
+    | [] -> true in
+  f busy
+
+let reg_add r ir i =
+  assert (reg_dispo r i);
+  let c (_,a) (_,b) = ircmp a.lo b.lo in
+  r.busy <- List.sort c ((ir, i) :: r.busy)
+
+(*
+let mkinters p =
+  let module H = Hashtbl in
+  let lh = liveness p in
+  let ih = H.create 1001 in
+  let setlive ir loc =
+    let rec f = function                            (* STUCK! How to know if an iref follows another? *)
+      | [] -> [{lo=loc; hi=loc}]
+      | ({lo,hi} :: l') as l ->
+        let c = ircmp loc lo in
+        if ircmp loc lo < 0
+        then {lo=loc; hi=loc} :: l
+        else if
+  for b = 0 to Array.length p - 1 do
+    for i = -1 to Array.length p.(b).inss do
+      x
+
+let regalloc2 (p: iprog) =
+  let lh = liveness p in
+  let nr = 4 in
+*)
+
 (* Little test programs. *)
 let pbasic: iprog =
   [| { bb_name = "start"
diff --git a/lo3.ml b/lo3.ml
deleted file mode 100644
index 502fd57..0000000
--- a/lo3.ml
+++ /dev/null
@@ -1,58 +0,0 @@
-(* Generic binary heaps. *)
-module Heap: sig
-  type 'a t
-  val create: ('a -> 'a -> int) -> 'a t
-  val add: 'a t -> 'a -> unit
-  val pop: 'a t -> 'a option
-  val top: 'a t -> 'a option
-end = struct
-  type 'a t =
-    { mutable arr: 'a array
-    ; mutable len: int
-    ; cmp: 'a -> 'a -> int
-    }
-
-  let mkarray n = Array.make n (Obj.magic 0)
-  let create cmp = {arr = mkarray 2; len = 0; cmp }
-  let top {arr; len; _} =
-    if len = 0 then None else Some arr.(1)
-  let swap arr i j =
-    let tmp = arr.(i) in
-    arr.(i) <- arr.(j);
-    arr.(j) <- tmp
-
-  let rec bblup cmp arr i =
-    let prnt = i/2 in
-    if prnt = 0 then () else
-    if cmp arr.(prnt) arr.(i) < 0 then () else
-    (swap arr prnt i; bblup cmp arr prnt)
-  let add ({arr; len; cmp} as hp) x =
-    let arr =
-      let alen = Array.length arr in
-      if alen > len+1 then arr else
-      let arr' = mkarray (alen * 2) in
-      Array.blit arr 0 arr' 0 alen;
-      hp.arr <- arr';
-      arr' in
-    hp.len <- len + 1;
-    arr.(hp.len) <- x;
-    bblup cmp arr hp.len
-
-  let rec bbldn cmp arr i len =
-    let ch0 = 2*i in
-    let ch1 = ch0 + 1 in
-    if ch0 > len then () else
-    let mn =
-      if ch1 > len then ch0 else
-      if cmp arr.(ch0) arr.(ch1) < 0
-      then ch0 else ch1 in
-    if cmp arr.(i) arr.(mn) <= 0 then () else
-    (swap arr i mn; bbldn cmp arr mn len)
-  let pop ({arr; len; cmp} as hp) =
-    if len = 0 then None else
-    let t = top hp in
-    arr.(1) <- arr.(len);
-    hp.len <- len - 1;
-    bbldn cmp arr 1 len;
-    t
-end
-- 
cgit 1.4.1