1 files changed, 224 insertions, 0 deletions
diff --git a/cil/src/ext/bitmap.ml b/cil/src/ext/bitmap.ml
new file mode 100644
index 00000000..da1f8b99
--- /dev/null
+++ b/cil/src/ext/bitmap.ml
@@ -0,0 +1,224 @@
+
+                                        (* Imperative bitmaps *)
+type t = { mutable nrWords  : int;
+           mutable nrBits   : int;      (* This is 31 * nrWords *)
+           mutable bitmap   : int array }
+
+
+                                        (* Enlarge a bitmap to contain at 
+                                         * least newBits *)
+let enlarge b newWords = 
+  let newbitmap = 
+    if newWords > b.nrWords then
+      let a = Array.create newWords 0 in
+      Array.blit b.bitmap 0 a 0 b.nrWords;
+      a
+    else
+      b.bitmap in
+  b.nrWords <- newWords;
+  b.nrBits  <- (newWords lsl 5) - newWords;
+  b.bitmap  <- newbitmap
+        
+
+                                        (* Create a new empty bitmap *)
+let make size = 
+  let wrd = (size + 30) / 31 in
+  { nrWords  = wrd;
+    nrBits   = (wrd lsl 5) - wrd;
+    bitmap   = Array.make wrd 0
+  } 
+
+let size t = t.nrBits 
+                                        (* Make an initialized array *)
+let init size how = 
+  let wrd = (size + 30) / 31 in
+  let how' w = 
+    let first = (w lsl 5) - w in
+    let last  = min size (first + 31) in 
+    let rec loop i acc = 
+      if i >= last then acc 
+      else
+        let acc' = acc lsl 1 in
+        if how i then loop (i + 1) (acc' lor 1) 
+        else loop (i + 1) acc'
+    in
+    loop first 0
+  in
+  { nrWords  = wrd;
+    nrBits   = (wrd lsl 5) - wrd;
+    bitmap   = Array.init wrd how'
+  } 
+  
+let clone b = 
+  { nrWords  = b.nrWords;
+    nrBits   = b.nrBits;
+    bitmap   = Array.copy b.bitmap;
+  } 
+    
+let cloneEmpty b =
+  { nrWords  = b.nrWords;
+    nrBits   = b.nrBits;
+    bitmap   = Array.make b.nrWords 0;
+  } 
+
+let union b1 b2 = 
+  begin
+    let n = b2.nrWords in
+    if b1.nrWords < n then enlarge b1 n else ();
+    let a1 = b1.bitmap in
+    let a2 = b2.bitmap in
+    let changed = ref false in
+    for i=0 to n - 1 do
+      begin
+        let t = a1.(i) in
+        let upd = t lor a2.(i) in
+        let _ = if upd <> t then changed := true else () in
+        Array.unsafe_set a1 i upd
+      end
+    done;
+    ! changed
+  end
+                                        (* lin += (lout - def) *)
+let accLive lin lout def = 
+  begin                                 (* Need to enlarge def to lout *)
+    let n = lout.nrWords in
+    if def.nrWords < n then enlarge def n else ();
+                                        (* Need to enlarge lin to lout *)
+    if lin.nrWords < n then enlarge lin n else ();
+    let changed = ref false in
+    let alin  = lin.bitmap in
+    let alout = lout.bitmap in
+    let adef  = def.bitmap in
+    for i=0 to n - 1 do
+      begin
+        let old = alin.(i) in
+        let nw  = old lor (alout.(i) land (lnot adef.(i))) in
+        alin.(i) <- nw;
+        changed := (old <> nw) || (!changed)
+      end
+    done;
+    !changed
+  end
+
+                                        (* b1 *= b2 *)
+let inters b1 b2 = 
+  begin
+    let n = min b1.nrWords b2.nrWords in
+    let a1 = b1.bitmap in
+    let a2 = b2.bitmap in
+    for i=0 to n - 1 do
+      begin
+        a1.(i) <- a1.(i) land a2.(i)
+      end
+    done;
+    if n < b1.nrWords then
+      Array.fill a1 n (b1.nrWords - n) 0
+    else
+      ()
+  end
+
+let emptyInt b start = 
+  let n = b.nrWords in
+  let a = b.bitmap in
+  let rec loop i = i >= n || (a.(i) = 0 && loop (i + 1))
+  in
+  loop start
+
+let empty b = emptyInt b 0
+
+                                        (* b1 =? b2 *)
+let equal b1 b2 =
+  begin
+    let n = min b1.nrWords b2.nrWords in
+    let a1 = b1.bitmap in
+    let a2 = b2.bitmap in
+    let res = ref true in
+    for i=0 to n - 1 do
+      begin
+        if a1.(i) != a2.(i) then res := false else ()
+      end
+    done;
+    if !res then 
+      if b1.nrWords > n then
+        emptyInt b1 n
+      else if b2.nrWords > n then 
+        emptyInt b2 n
+      else
+        true
+    else
+      false
+  end
+
+let assign b1 b2 = 
+  begin
+    let n = b2.nrWords in
+    if b1.nrWords < n then enlarge b1 n else ();
+    let a1 = b1.bitmap in
+    let a2 = b2.bitmap in
+    Array.blit a2 0 a1 0 n 
+  end
+
+                                        (* b1 -= b2 *)
+let diff b1 b2 = 
+  begin
+    let n = min b1.nrWords b2.nrWords in
+    let a1 = b1.bitmap in
+    let a2 = b2.bitmap in
+    for i=0 to n - 1 do
+        a1.(i) <- a1.(i) land (lnot a2.(i))
+    done;
+    if n < b1.nrWords then 
+      Array.fill a1 n (b1.nrWords - n) 0
+    else
+      ()
+  end
+
+
+      
+
+let get bmp i = 
+  assert (i >= 0);
+  if i >= bmp.nrBits then enlarge bmp (i / 31 + 1) else ();
+  let wrd = i / 31 in
+  let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
+  bmp.bitmap.(wrd) land msk != 0 
+
+
+let set bmp i tv = 
+  assert(i >= 0);
+  let wrd = i / 31 in
+  let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
+  if i >= bmp.nrBits then enlarge bmp (wrd + 1) else ();
+  if tv then 
+    bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) lor msk
+  else
+    bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) land (lnot msk)
+
+  
+
+                                        (* Iterate over all elements in a 
+                                         * bitmap *)
+let fold f bmp arg =
+  let a = bmp.bitmap in
+  let n = bmp.nrWords in
+  let rec allWords i bit arg = 
+    if i >= n then
+      arg
+    else
+      let rec allBits msk bit left arg = 
+        if left = 0 then 
+          allWords (i + 1) bit arg
+        else
+          allBits ((lsr) msk 1) (bit + 1) (left - 1) 
+                 (if (land) msk 1 != 0 then f arg bit else arg)
+      in
+      allBits a.(i) bit 31 arg 
+  in
+  allWords 0 0 arg
+
+
+let iter f t = fold (fun x y -> f y) t ()
+
+let toList bmp = fold (fun acc i -> i :: acc) bmp []
+
+let card bmp   = fold (fun acc _ -> acc + 1) bmp 0