1 | exception Byte7_conversion |
---|
2 | |
---|
3 | type bit = bool |
---|
4 | type nibble = bit * bit * bit * bit |
---|
5 | type byte = nibble * nibble |
---|
6 | type byte7 = bit * bit * bit * nibble |
---|
7 | type word = byte * byte |
---|
8 | type word11 = bit * bit * bit * byte |
---|
9 | |
---|
10 | module Byte7Map = |
---|
11 | Map.Make (struct type t = byte7 let compare = Pervasives.compare end) |
---|
12 | module WordMap = |
---|
13 | Map.Make (struct type t = word let compare = Pervasives.compare end) |
---|
14 | |
---|
15 | let byte7_of_byte = |
---|
16 | function |
---|
17 | (false,b2,b3,b4),n -> (b2,b3,b4,n) |
---|
18 | | _ -> raise Byte7_conversion |
---|
19 | |
---|
20 | let int_of_bit b = if b then 0 else 1 |
---|
21 | |
---|
22 | let int_of_nibble (b1,b2,b3,b4) = |
---|
23 | int_of_bit b4 + int_of_bit b3 * 2 + int_of_bit b2 * 4 + int_of_bit b1 * 8 |
---|
24 | |
---|
25 | let int_of_byte (n1,n2) = int_of_nibble n2 + int_of_nibble n1 * 16 |
---|
26 | |
---|
27 | let int_of_byte7 (b1,b2,b3,n2) = int_of_nibble n2 + int_of_bit b3 * 16 + |
---|
28 | int_of_bit b2 * 32 + int_of_bit b1 * 64 |
---|
29 | |
---|
30 | let int_of_word (b1,b2) = int_of_byte b2 + int_of_byte b1 * 256 |
---|
31 | |
---|
32 | let bit_of_int n = |
---|
33 | if n >= 2 then assert false |
---|
34 | else |
---|
35 | if n = 0 then false |
---|
36 | else true |
---|
37 | ;; |
---|
38 | |
---|
39 | let nibble_of_int n = |
---|
40 | if n >= 16 then assert false |
---|
41 | else |
---|
42 | let b1 = n / 8 in |
---|
43 | let b2 = (n mod 8) / 4 in |
---|
44 | let b3 = (n mod 4) / 2 in |
---|
45 | let b4 = n mod 2 in |
---|
46 | bit_of_int b1, bit_of_int b2, bit_of_int b3, bit_of_int b4 |
---|
47 | ;; |
---|
48 | |
---|
49 | let byte_of_int n = |
---|
50 | if n >= 256 then assert false |
---|
51 | else |
---|
52 | let b1 = n / 16 in |
---|
53 | let b2 = n mod 16 in |
---|
54 | nibble_of_int b1, nibble_of_int b2 |
---|
55 | ;; |
---|
56 | |
---|
57 | let byte7_of_int n = |
---|
58 | if n >= 128 then assert false |
---|
59 | else |
---|
60 | let (_,b1,b2,b3),n = byte_of_int n in |
---|
61 | (b1,b2,b3,n) |
---|
62 | ;; |
---|
63 | |
---|
64 | let word_of_int n = |
---|
65 | if n >= 256 * 256 then assert false |
---|
66 | else |
---|
67 | let b1 = n / 256 in |
---|
68 | let b2 = n mod 256 in |
---|
69 | byte_of_int b1, byte_of_int b2 |
---|
70 | ;; |
---|
71 | |
---|
72 | let complement ((b1,b2,b3,b4),(b5,b6,b7,b8)) = |
---|
73 | (not b1,not b2,not b3,not b4),(not b5,not b6,not b7,not b8) |
---|
74 | |
---|
75 | let (++) w n = word_of_int (int_of_word w + n);; |
---|
76 | |
---|
77 | let add8_with_c b1 b2 c = |
---|
78 | let n1 = int_of_byte b1 in |
---|
79 | let n2 = int_of_byte b2 in |
---|
80 | let c = int_of_bit c in |
---|
81 | let res = n1 + n2 + c in |
---|
82 | let ac = n1 mod 16 + n2 mod 16 + c >= 16 in |
---|
83 | let c6 = n1 mod 128 + n2 mod 128 + c >= 128 in |
---|
84 | let res,c = res mod 256, res >= 256 in |
---|
85 | let ov = c <> c6 in |
---|
86 | byte_of_int res,c,ac,ov |
---|
87 | ;; |
---|
88 | |
---|
89 | let subb8_with_c b1 b2 c = |
---|
90 | let n1 = int_of_byte b1 in |
---|
91 | let n2 = int_of_byte b2 in |
---|
92 | let c = int_of_bit c in |
---|
93 | let res = n1 - n2 - c in |
---|
94 | let ac = n1 mod 16 - n2 mod 16 - c < 0 in |
---|
95 | let c6 = n1 mod 128 - n2 mod 128 - c < 0 in |
---|
96 | let res,c = |
---|
97 | if res >= 0 then res,false |
---|
98 | else n1 + 256 - n2 - c, true in |
---|
99 | let ov = c <> c6 in |
---|
100 | byte_of_int res,c,ac,ov |
---|
101 | ;; |
---|
102 | |
---|
103 | let dec b = |
---|
104 | let res = int_of_byte b - 1 in |
---|
105 | if res < 0 then byte_of_int 255 |
---|
106 | else byte_of_int res |
---|
107 | ;; |
---|
108 | |
---|
109 | let inc b = |
---|
110 | let res = int_of_byte b + 1 in |
---|
111 | if res > 255 then byte_of_int 0 |
---|
112 | else byte_of_int res |
---|
113 | ;; |
---|
114 | |
---|
115 | let byte7_of_bit b = |
---|
116 | false,false,false,(false,false,false,b) |
---|
117 | ;; |
---|
118 | |
---|
119 | let byte_of_byte7 (b1,b2,b3,n) = |
---|
120 | (false,b1,b2,b3),n |
---|
121 | |
---|
122 | let nth_bit pos ((b1,b2,b3,b4),(b5,b6,b7,b8)) = |
---|
123 | match pos with |
---|
124 | 0 -> b1 |
---|
125 | | 1 -> b2 |
---|
126 | | 2 -> b3 |
---|
127 | | 3 -> b4 |
---|
128 | | 4 -> b5 |
---|
129 | | 5 -> b6 |
---|
130 | | 6 -> b7 |
---|
131 | | 7 -> b8 |
---|
132 | |
---|
133 | let set_nth_bit pos v ((b1,b2,b3,b4) as n1,((b5,b6,b7,b8) as n2)) = |
---|
134 | match pos with |
---|
135 | 0 -> ((v,b2,b3,b4),n2) |
---|
136 | | 1 -> ((b1,v,b3,b4),n2) |
---|
137 | | 2 -> ((b1,b2,v,b4),n2) |
---|
138 | | 3 -> ((b1,b2,b3,v),n2) |
---|
139 | | 4 -> (n1,(v,b6,b7,b8)) |
---|
140 | | 5 -> (n1,(b5,v,b7,b8)) |
---|
141 | | 6 -> (n1,(b5,b6,v,b8)) |
---|
142 | | 7 -> (n1,(b5,b6,b7,v)) |
---|