src/ASM/BitVectors.ml

   1 open Util;;
   2
   3 type bit = bool
   4 type 'a vect = bit list
   5 type nibble = [`Four] vect
   6 type byte7 = [`Seven] vect
   7 type byte = [`Eight] vect
   8 type word = [`Sixteen] vect
   9 type word11 = [`Eleven] vect
  10
  11 type sizes = [ `Four | `Seven | `Eight | `Eleven | `Sixteen ]
  12
  13 let mk_nibble b1 b2 b3 b4 = [b1; b2; b3; b4]
  14 let from_nibble =
  15  function
  16     [b1; b2; b3; b4] -> b1,b2,b3,b4
  17   | _ -> assert false
  18 let mk_byte n1 n2 = n1 @ n2
  19 let mk_byte_from_bits ((b1,b2,b3,b4),(b5,b6,b7,b8)) = ([b1;b2;b3;b4;b5;b6;b7;b8] : [`Eight] vect)
  20 let from_byte =
  21  function
  22     b1::b2::b3::b4::r -> [b1;b2;b3;b4],r
  23   | _ -> assert false
  24 let bits_of_byte =
  25  function
  26     [b1;b2;b3;b4;b5;b6;b7;b8] -> (b1,b2,b3,b4),(b5,b6,b7,b8)
  27   | _ -> assert false
  28 let mk_byte7 b1 b2 b3 n1 = b1::b2::b3::n1
  29 let from_byte7 =
  30  function
  31     b1::b2::b3::r -> b1,b2,b3,r
  32   | _ -> assert false
  33 let mk_word = mk_byte
  34 let from_word =
  35  function
  36     b1::b2::b3::b4::b5::b6::b7::b8::r -> [b1;b2;b3;b4;b5;b6;b7;b8],r
  37   | _ -> assert false
  38 let mk_word11 = mk_byte7
  39 let from_word11 = from_byte7
  40
  41 let get_bit l index =
  42   try
  43     List.nth (List.rev l) index
  44   with (Failure _ | Invalid_argument _) -> assert false
  45
  46 let set_bit l index new_val =
  47   try
  48     let rec aux index l =
  49       match index, l with
  50         _, [] -> raise (Invalid_argument "")
  51       | 0,_::tl -> new_val::tl
  52       | n,hd::tl -> hd::(aux (n-1) tl) in
  53           List.rev (aux index (List.rev l))
  54   with Invalid_argument "" -> assert false
  55
  56 let (-&-) l1 l2 = List.map2 (fun b1 b2 -> b1 & b2) l1 l2
  57 let (-|-) l1 l2 = List.map2 (fun b1 b2 -> b1 || b2) l1 l2
  58 let xor b1 b2 = b1 <> b2
  59 let (-^-) l1 l2 = List.map2 xor l1 l2
  60 let complement l1 = List.map (not) l1
  61
  62 let iter_bits f v = String.concat "" (List.map f v)
  63 let map_bits = List.map
  64 let map2_bits = List.map2
  65
  66 let string_of_bit = function false -> "0" | true -> "1"
  67 let string_of_vect l = String.concat "" (List.map string_of_bit l)
  68
  69 let full_add l r c = List.fold_right2 (fun b1 b2 (c,r) -> b1 & b2 || c & (b1 || b2),xor (xor b1 b2) c::r) l r (c,[])
  70 let half_add l r = full_add l r false
  71
  72 let sign_extension =
  73  function
  74     [] -> assert false
  75   | (he::_) as l ->
  76       [he;he;he;he;he;he;he;he] @ l
  77 ;;
  78
  79
  80 let rec split_last =
  81   function
  82     [] -> assert false
  83   | [he] -> he,[]
  84   | he::tl ->
  85       let l,res = split_last tl in
  86         l,he::res
  87
  88 let shift_left =
  89   function
  90     [] -> assert false
  91   | _::tl -> tl @ [false]
  92 let shift_right l = false :: snd (split_last l)
  93 let rotate_left =
  94   function
  95     [] -> assert false
  96   | he::tl -> tl @ [he]
  97 let rotate_right l =
  98   let he,tl = split_last l in
  99     he::tl
 100
 101 (* CSC: can overflow!!! *)
 102 let int_of_vect v =
 103   let rec aux pow v =
 104     match v with
 105       [] -> 0
 106     | hd::tl ->
 107         if hd = true then
 108           pow + (aux (pow * 2) tl)
 109         else
 110           aux (pow * 2) tl
 111   in
 112     aux 1 (List.rev v)
 113
 114 let size_lookup =
 115   function
 116     `Four -> 4
 117   | `Seven -> 7
 118   | `Eight -> 8
 119   | `Eleven -> 11
 120   | `Sixteen -> 16
 121
 122 let rec pow v p =
 123   if p = 0 then
 124     1
 125   else
 126     v * (pow v (p - 1))
 127
 128 let divide_with_remainder x y = (x / y, x mod y)
 129
 130 let rec aux i =
 131   if i < 0 then
 132     raise (Invalid_argument "Negative index")
 133   else
 134     let (d, r) = divide_with_remainder i 2 in
 135       if (d, r) = (0, 0) then
 136         []
 137       else if r = 0 then
 138         false :: aux d
 139       else
 140         true :: aux d
 141
 142 let rec pad i l = if i = 0 then l else false :: (pad (i - 1) l)
 143
 144 let vect_of_int i size =
 145   let big_list = List.rev (aux i) in
 146     if List.length big_list > size_lookup size then
 147       raise (Invalid_argument "BitVectors.vect_of_int: size not big enough")
 148     else
 149       let diff = size_lookup size - List.length big_list in
 150         pad diff big_list
 151
 152 let zero size = pad (size_lookup size) []
 153
 154 (* CSC: can overflow!!! *)
 155 (* CSC: only works properly with bytes!!! *)
 156 let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);;
 157
 158 module WordMap =
 159   Map.Make (struct type t = word let compare = compare end);;