source: Deliverables/D4.1/BitVectors.ml

Last change on this file was 163, checked in by mulligan, 9 years ago

Fixed bug with JNB not jumping correctly.

File size: 3.7 KB
RevLine 
[163]1open Util;;
2
[87]3type bit = bool
4type 'a vect = bit list
5type nibble = [`Four] vect
6type byte7 = [`Seven] vect
7type byte = [`Eight] vect
8type word = [`Sixteen] vect
9type word11 = [`Eleven] vect
[86]10
[92]11type sizes = [ `Four | `Seven | `Eight | `Eleven | `Sixteen ]
12
[87]13let mk_nibble b1 b2 b3 b4 = [b1; b2; b3; b4]
14let from_nibble =
15 function
16    [b1; b2; b3; b4] -> b1,b2,b3,b4
17  | _ -> assert false
18let mk_byte n1 n2 = n1 @ n2
[95]19let mk_byte_from_bits ((b1,b2,b3,b4),(b5,b6,b7,b8)) = ([b1;b2;b3;b4;b5;b6;b7;b8] : [`Eight] vect)
[87]20let from_byte =
21 function
22    b1::b2::b3::b4::r -> [b1;b2;b3;b4],r
23  | _ -> assert false
[97]24let 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
[87]28let mk_byte7 b1 b2 b3 n1 = b1::b2::b3::n1
29let from_byte7 =
30 function
31    b1::b2::b3::r -> b1,b2,b3,r
32  | _ -> assert false
33let mk_word = mk_byte
34let 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
38let mk_word11 = mk_byte7
39let from_word11 = from_byte7
[86]40
[163]41let get_bit l index =
[87]42  try
[163]43    List.nth (List.rev l) index
[162]44  with (Failure _ | Invalid_argument _) -> assert false
[86]45
[87]46let 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
[162]53          List.rev (aux index (List.rev l))
54  with Invalid_argument "" -> assert false
[86]55
[87]56let (-&-) l1 l2 = List.map2 (fun b1 b2 -> b1 & b2) l1 l2
57let (-|-) l1 l2 = List.map2 (fun b1 b2 -> b1 || b2) l1 l2
58let xor b1 b2 = b1 <> b2
59let (-^-) l1 l2 = List.map2 xor l1 l2
[95]60let complement l1 = List.map (not) l1
[86]61
[87]62let iter_bits f v = String.concat "" (List.map f v)
63let map_bits = List.map
64let map2_bits = List.map2
[86]65
[98]66let string_of_bit = function false -> "0" | true -> "1"
67let string_of_vect l = String.concat "" (List.map string_of_bit l)
[86]68
[87]69let 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,[])
70let half_add l r = full_add l r false
[86]71
[147]72let sign_extension =
73 function
74    [] -> assert false
75  | (he::_) as l ->
76      [he;he;he;he;he;he;he;he] @ l
77;;
78 
79
[88]80let 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
[86]87
[88]88let shift_left =
89  function
90    [] -> assert false
91  | _::tl -> tl @ [false]
[87]92let shift_right l = false :: snd (split_last l)
[88]93let rotate_left =
94  function
95    [] -> assert false
96  | he::tl -> tl @ [he]
97let rotate_right l =
98  let he,tl = split_last l in
99    he::tl
100
[140]101(* CSC: can overflow!!! *)
[88]102let 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)
[89]113
114let size_lookup =
115  function
116    `Four -> 4
117  | `Seven -> 7
118  | `Eight -> 8
119  | `Eleven -> 11
120  | `Sixteen -> 16
121
122let rec pow v p =
123  if p = 0 then
124    1
125  else
126    v * (pow v (p - 1))
127
128let divide_with_remainder x y = (x / y, x mod y)
129
130let 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
[138]142let rec pad i l = if i = 0 then l else false :: (pad (i - 1) l)
143
[89]144let vect_of_int i size =
145  let big_list = List.rev (aux i) in
[138]146    if List.length big_list > size_lookup size then
[89]147      raise (Invalid_argument "Size not big enough")
148    else
[138]149      let diff = size_lookup size - List.length big_list in
150        pad diff big_list
[89]151   
[138]152let zero size = pad (size_lookup size) []
[140]153
154(* CSC: can overflow!!! *)
[142]155(* CSC: only works properly with bytes!!! *)
[140]156let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);;
Note: See TracBrowser for help on using the repository browser.