[120] | 1 | open BitVectors;; |
---|
| 2 | |
---|
[44] | 3 | exception Byte7_conversion |
---|
[28] | 4 | |
---|
[120] | 5 | module type Map = |
---|
| 6 | sig |
---|
| 7 | type key |
---|
| 8 | type map |
---|
| 9 | val empty : map |
---|
| 10 | val find : key -> map -> byte |
---|
| 11 | val add : key -> byte -> map -> map |
---|
[442] | 12 | val fold : (key -> byte -> 'b -> 'b) -> map -> 'b -> 'b |
---|
[448] | 13 | val equal: (byte -> byte -> bool) -> map -> map -> bool |
---|
[120] | 14 | end |
---|
| 15 | ;; |
---|
[28] | 16 | |
---|
[120] | 17 | module Byte7Map : Map with type key = byte7 = |
---|
| 18 | struct |
---|
| 19 | include Map.Make (struct type t = byte7 let compare = Pervasives.compare end) |
---|
| 20 | type map = byte t |
---|
| 21 | let find k m = |
---|
| 22 | try |
---|
| 23 | find k m |
---|
| 24 | with Not_found -> zero `Eight |
---|
[442] | 25 | let fold = fold |
---|
[448] | 26 | let equal = equal |
---|
[120] | 27 | end;; |
---|
| 28 | |
---|
| 29 | module WordMap : Map with type key = word = |
---|
| 30 | struct |
---|
| 31 | include Map.Make (struct type t = word let compare = Pervasives.compare end) |
---|
| 32 | type map = byte t |
---|
| 33 | let find k m = |
---|
| 34 | try |
---|
| 35 | find k m |
---|
| 36 | with Not_found -> zero `Eight |
---|
[442] | 37 | let fold = fold |
---|
[448] | 38 | let equal = equal |
---|
[120] | 39 | end;; |
---|
| 40 | |
---|
[91] | 41 | let int_of_bit = |
---|
| 42 | function |
---|
| 43 | false -> 0 |
---|
| 44 | | true -> 1 |
---|
[28] | 45 | |
---|
[92] | 46 | let add8_with_c (b1 : [`Eight] vect) (b2 : [`Eight] vect) (c : bit) = |
---|
[90] | 47 | let n1 = int_of_vect b1 in |
---|
| 48 | let n2 = int_of_vect b2 in |
---|
[92] | 49 | let c = int_of_bit c in |
---|
[28] | 50 | let res = n1 + n2 + c in |
---|
| 51 | let ac = n1 mod 16 + n2 mod 16 + c >= 16 in |
---|
| 52 | let c6 = n1 mod 128 + n2 mod 128 + c >= 128 in |
---|
| 53 | let res,c = res mod 256, res >= 256 in |
---|
| 54 | let ov = c <> c6 in |
---|
[92] | 55 | vect_of_int res `Eight,c,ac,ov |
---|
[28] | 56 | ;; |
---|
| 57 | |
---|
[161] | 58 | let add16_with_c (b1 : [`Sixteen] vect) (b2 : [`Sixteen] vect) (c : bit) = |
---|
| 59 | let n1 = int_of_vect b1 in |
---|
| 60 | let n2 = int_of_vect b2 in |
---|
| 61 | let c = int_of_bit c in |
---|
| 62 | let res = n1 + n2 + c in |
---|
| 63 | let ac = n1 mod 256 + n2 mod 256 + c >= 256 in |
---|
| 64 | let c6 = n1 mod 2097152 + n2 mod 2097152 + c >= 2097152 in |
---|
| 65 | let res,c = res mod 4194304, res >= 4194304 in |
---|
| 66 | let ov = c <> c6 in |
---|
| 67 | vect_of_int res `Sixteen,c,ac,ov |
---|
| 68 | ;; |
---|
| 69 | |
---|
[91] | 70 | let subb8_with_c (b1 : [`Eight] vect) (b2 : [`Eight] vect) (c : bit) = |
---|
[90] | 71 | let n1 = int_of_vect b1 in |
---|
| 72 | let n2 = int_of_vect b2 in |
---|
[91] | 73 | let c = int_of_bit c in |
---|
[28] | 74 | let res = n1 - n2 - c in |
---|
| 75 | let ac = n1 mod 16 - n2 mod 16 - c < 0 in |
---|
| 76 | let c6 = n1 mod 128 - n2 mod 128 - c < 0 in |
---|
| 77 | let res,c = |
---|
| 78 | if res >= 0 then res,false |
---|
| 79 | else n1 + 256 - n2 - c, true in |
---|
| 80 | let ov = c <> c6 in |
---|
[90] | 81 | (vect_of_int res `Eight,c,ac,ov) |
---|
[28] | 82 | ;; |
---|
| 83 | |
---|
| 84 | let dec b = |
---|
[90] | 85 | let res = int_of_vect b - 1 in |
---|
| 86 | if res < 0 then vect_of_int 255 `Eight |
---|
| 87 | else vect_of_int res `Eight |
---|
[28] | 88 | ;; |
---|
| 89 | |
---|
| 90 | let inc b = |
---|
[90] | 91 | let res = int_of_vect b + 1 in |
---|
[92] | 92 | if res > 255 then (vect_of_int 0 `Eight : byte) |
---|
| 93 | else (vect_of_int res `Eight : byte) |
---|
[28] | 94 | ;; |
---|
[41] | 95 | |
---|
[42] | 96 | let byte7_of_bit b = |
---|
[91] | 97 | [false;false;false;false;false;false;b] |
---|
[41] | 98 | ;; |
---|
[42] | 99 | |
---|
[97] | 100 | let byte_of_byte7 = |
---|
| 101 | function |
---|
| 102 | ([b1;b2;b3]::n) -> [false;b1;b2;b3]::n |
---|
| 103 | | _ -> assert false |
---|
[88] | 104 | ;; |
---|
[454] | 105 | |
---|
| 106 | let addr16_of_addr11 pc a = |
---|
| 107 | let pc_upper, _ = from_word pc in |
---|
| 108 | let n1, n2 = from_byte pc_upper in |
---|
| 109 | let (b1,b2,b3,b) = from_word11 a in |
---|
| 110 | let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in |
---|
| 111 | mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b |
---|
| 112 | ;; |
---|