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
Line 
1open Util;;
2
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
10
11type sizes = [ `Four | `Seven | `Eight | `Eleven | `Sixteen ]
12
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
19let mk_byte_from_bits ((b1,b2,b3,b4),(b5,b6,b7,b8)) = ([b1;b2;b3;b4;b5;b6;b7;b8] : [`Eight] vect)
20let from_byte =
21 function
22    b1::b2::b3::b4::r -> [b1;b2;b3;b4],r
23  | _ -> assert false
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
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
40
41let get_bit l index =
42  try
43    List.nth (List.rev l) index
44  with (Failure _ | Invalid_argument _) -> assert false
45
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
53          List.rev (aux index (List.rev l))
54  with Invalid_argument "" -> assert false
55
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
60let complement l1 = List.map (not) l1
61
62let iter_bits f v = String.concat "" (List.map f v)
63let map_bits = List.map
64let map2_bits = List.map2
65
66let string_of_bit = function false -> "0" | true -> "1"
67let string_of_vect l = String.concat "" (List.map string_of_bit l)
68
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
71
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
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
87
88let shift_left =
89  function
90    [] -> assert false
91  | _::tl -> tl @ [false]
92let shift_right l = false :: snd (split_last l)
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
101(* CSC: can overflow!!! *)
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)
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
142let rec pad i l = if i = 0 then l else false :: (pad (i - 1) l)
143
144let 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 "Size not big enough")
148    else
149      let diff = size_lookup size - List.length big_list in
150        pad diff big_list
151   
152let zero size = pad (size_lookup size) []
153
154(* CSC: can overflow!!! *)
155(* CSC: only works properly with bytes!!! *)
156let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);;
Note: See TracBrowser for help on using the repository browser.