]> matita.cs.unibo.it Git - pkg-cerco/acc.git/blob - src/ASM/BitVectors.ml
Package description and copyright added.
[pkg-cerco/acc.git] / 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);;