path: root/cil/src/ext/bitmap.ml

                                        (* 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