source: Deliverables/D4.1/Byte.ml @ 75

Last change on this file since 75 was 67, checked in by mulligan, 11 years ago

DJNZ instruction finished.

File size: 7.4 KB
Line 
1(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
2(* FILENAME:    Byte.ml                                                      *)
3(* DESCRIPTION: An ADT implementing standard 8 bit bytes, and common         *)
4(*              operations on them.                                          *)
5(* CREATED:     10/09/2010, Dominic Mulligan                                 *)
6(* BUGS:                                                                     *)
7(*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*^*)
8
9open Bit;;
10open Nibble;;
11
12module type BYTE =
13sig
14  type bit
15  type nibble
16  type byte
17
18  val from_bits: bit -> bit -> bit -> bit -> bit -> bit -> bit -> bit -> byte
19  val from_bit: bit -> byte
20  val from_nibbles: nibble -> nibble -> byte
21  val from_nibble: nibble -> byte
22(*
23  val from_int: int -> byte
24*)
25  val to_bit: byte -> bit option
26  val to_nibble: byte -> nibble option
27  val to_int: byte -> int
28
29  val get_nibble_at: int -> byte -> nibble option
30  val set_nibble_at: int -> nibble -> byte -> byte option
31  val get_bit_at: int -> byte -> bit option
32  val set_bit_at: int -> bit -> byte -> byte option
33
34  val (-&-): byte -> byte -> byte
35  val (-|-): byte -> byte -> byte
36  val (-^-): byte -> byte -> byte
37  val rotate_right: byte -> byte
38  val rotate_left: byte -> byte
39  val shift_right: byte -> byte
40  val shift_left: byte -> byte
41  val not: byte -> byte
42
43  val map_nibble: (nibble -> nibble) -> byte -> byte
44  val map_bit: (bit -> bit) -> byte -> byte
45  val iter_nibble: (nibble -> string) -> byte -> string
46  val iter_bit: (bit -> string) -> byte -> string
47  val zip_nibble: (nibble -> nibble -> nibble) -> byte -> byte -> byte
48  val zip_bit: (bit -> bit -> bit) -> byte -> byte -> byte
49  val to_string: byte -> string
50end
51
52module ByteFunctor(Bit: BIT)
53                  (Nibble: NIBBLE with type bit = Bit.bit): BYTE
54  with type bit = Bit.bit
55  and  type nibble = Nibble.nibble =
56struct
57  type bit = Bit.bit
58  type nibble = Nibble.nibble
59  type byte = nibble * nibble
60
61  let from_bits b1 b2 b3 b4 b5 b6 b7 b8 =
62    let n1 = Nibble.from_bits b1 b2 b3 b4 in
63    let n2 = Nibble.from_bits b5 b6 b7 b8 in
64      (n1, n2)
65  let from_bit b =
66    let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
67                              (Bit.from_bool false) (Bit.from_bool false) in
68    let n2 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
69                              (Bit.from_bool false) b in
70      (n1, n2)
71  let from_nibbles n1 n2 = (n1, n2)
72  let from_nibble n2 =
73    let n1 = Nibble.from_bits (Bit.from_bool false) (Bit.from_bool false)
74                              (Bit.from_bool false) (Bit.from_bool false) in
75      (n1, n2)
76
77  let get_nibble_at index (n1, n2) =
78    match index with
79      0 -> Some n2
80    | 1 -> Some n1
81    | _ -> None
82  let get_bit_at index (n1, n2) =
83    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
84    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
85      match index with
86        0 -> Some b8
87      | 1 -> Some b7
88      | 2 -> Some b6
89      | 3 -> Some b5
90      | 4 -> Some b4
91      | 3 -> Some b3
92      | 2 -> Some b2
93      | 1 -> Some b1
94      | _ -> None
95
96  let set_nibble_at index new_val (n1, n2) =
97    match index with
98      0 -> Some (n1, new_val)
99    | 1 -> Some (new_val, n2)
100    | _ -> None
101  let set_bit_at index new_val (n1, n2) =
102    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
103    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
104      match index with
105        0 -> Some (from_bits b1 b2 b3 b4 b5 b6 b7 new_val)
106      | 1 -> Some (from_bits b1 b2 b3 b4 b5 b6 new_val b8)
107      | 2 -> Some (from_bits b1 b2 b3 b4 b5 new_val b7 b8)
108      | 3 -> Some (from_bits b1 b2 b3 b4 new_val b6 b7 b8)
109      | 4 -> Some (from_bits b1 b2 b3 new_val b5 b6 b7 b8)
110      | 3 -> Some (from_bits b1 b2 new_val b4 b5 b6 b7 b8)
111      | 2 -> Some (from_bits b1 new_val b3 b4 b5 b6 b7 b8)
112      | 1 -> Some (from_bits new_val b2 b3 b4 b5 b6 b7 b8)
113      | _ -> None
114
115  let to_bit (n1, n2) =
116    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
117    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
118      if (Bit.to_bool b1, Bit.to_bool b2,
119          Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then
120        if Bit.to_bool b5 = false && Bit.to_bool b6 = false && Bit.to_bool b7 = false then
121          Some b8
122        else
123          None
124      else
125        None
126  let to_nibble (n1, n2) =
127    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
128      if (Bit.to_bool b1, Bit.to_bool b2,
129          Bit.to_bool b3, Bit.to_bool b4) = (false, false, false, false) then
130        Some n2
131      else None
132  let to_int (n1, n2) =
133    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
134    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
135      (128 * Bit.to_int b8) + (64 * Bit.to_int b8) +
136      (32 * Bit.to_int b8) + (16 * Bit.to_int b8) + 
137      (8 * Bit.to_int b8) + (4 * Bit.to_int b6) + 
138      (2 * Bit.to_int b7) + Bit.to_int b8
139
140  let (-&-) (l1, l2) (r1, r2) = (Nibble.(-&-) l1 r1, Nibble.(-&-) l2 r2)
141  let (-|-) (l1, l2) (r1, r2) = (Nibble.(-|-) l1 r1, Nibble.(-|-) l2 r2)
142  let (-^-) (l1, l2) (r1, r2) = (Nibble.(-^-) l1 r1, Nibble.(-^-) l2 r2)
143
144  let shift_right (n1, n2) =
145    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
146    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
147    let new_n1 = Nibble.from_bits (Bit.from_bool false) b1 b2 b3 in
148    let new_n2 = Nibble.from_bits b4 b5 b6 b7 in
149      (new_n1, new_n2)
150  let shift_left (n1, n2) =
151    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
152    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
153    let new_n1 = Nibble.from_bits b1 b2 b3 b4 in
154    let new_n2 = Nibble.from_bits b5 b6 b7 (Bit.from_bool false) in
155      (new_n1, new_n2)
156  let rotate_right (n1, n2) =
157    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
158    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
159    let new_n1 = Nibble.from_bits b8 b1 b2 b3 in
160    let new_n2 = Nibble.from_bits b4 b5 b6 b7 in
161      (new_n1, new_n2)
162  let rotate_left (n1, n2) =
163    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
164    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
165    let new_n1 = Nibble.from_bits b2 b3 b4 b5 in
166    let new_n2 = Nibble.from_bits b5 b6 b7 b1 in
167      (new_n1, new_n2)
168  let not (n1, n2) = (Nibble.not n1, Nibble.not n2)
169
170  let map_nibble f (n1, n2) = (f n1, f n2)
171  let map_bit f (n1, n2) =
172    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
173    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
174    let new_n1 = Nibble.from_bits (f b1) (f b2) (f b3) (f b4) in
175    let new_n2 = Nibble.from_bits (f b5) (f b6) (f b7) (f b8) in
176      (new_n1, new_n2)
177  let iter_nibble f (n1, n2) =
178    let str_n1 = f n1 in
179    let str_n2 = f n2 in
180      str_n1 ^ str_n2
181  let iter_bit f (n1, n2) =
182    let (b1, b2, b3, b4) = Nibble.to_bits n1 in
183    let (b5, b6, b7, b8) = Nibble.to_bits n2 in
184    let new_n1 = (f b1) ^ (f b2) ^ (f b3) ^ (f b4) in
185    let new_n2 = (f b5) ^ (f b6) ^ (f b7) ^ (f b8) in
186      new_n1 ^ new_n2
187  let zip_nibble f (l1, l2) (r1, r2) = (f l1 r1, f l2 r2)
188  let zip_bit f (l1, l2) (r1, r2) =
189    let (lb1, lb2, lb3, lb4) = Nibble.to_bits l1 in
190    let (lb5, lb6, lb7, lb8) = Nibble.to_bits l2 in
191    let (rb1, rb2, rb3, rb4) = Nibble.to_bits r1 in
192    let (rb5, rb6, rb7, rb8) = Nibble.to_bits r2 in
193    let (b1, b2, b3, b4) = (f lb1 rb1), (f lb2 rb2), (f lb3 rb3), (f lb4 rb4) in
194    let (b5, b6, b7, b8) = (f lb5 rb5), (f lb6 rb6), (f lb7 rb7), (f lb8 rb8) in
195    let new_n1 = Nibble.from_bits b1 b2 b3 b4 in
196    let new_n2 = Nibble.from_bits b5 b6 b7 b8 in
197      (new_n1, new_n2)
198  let to_string = iter_nibble Nibble.to_string
199end;;
200
201module Byte = ByteFunctor(Bit) (Nibble);;
Note: See TracBrowser for help on using the repository browser.