source: Deliverables/D4.1/IntelHex.ml @ 131

Last change on this file since 131 was 131, checked in by mulligan, 9 years ago

Changes from this morning: checking checksum is correct for a
intel_hex_entry. Also some new useful functions in Util and elsewhere.

File size: 5.7 KB
Line 
1open BitVectors;;
2open ASM;;
3open Util;;
4open Parser;;
5
6type intel_hex_entry_type =
7    Data
8  | End
9  | ExtendedSeg
10  | ExtendedLinear
11;;
12
13type intel_hex_entry =
14{
15  record_length: byte * byte;
16  record_addr: byte * byte * byte * byte;
17  record_type: intel_hex_entry_type;
18  data_field: byte list;
19  data_checksum: byte * byte
20}
21;;
22
23type intel_hex_format = intel_hex_entry list;;
24
25let hex_digit_of_char =
26    function
27      '0' -> 0 | '1' -> 1 | '2' -> 2
28    | '3' -> 3 | '4' -> 4 | '5' -> 5
29    | '6' -> 6 | '7' -> 7 | '8' -> 8
30    | '9' -> 9 | 'A' -> 10 | 'B' -> 11
31    | 'C' -> 12 | 'D' -> 13 | 'E' -> 14
32    | 'F' -> 15 | _ -> assert false
33
34let vect_of_hex_string s size =
35  let int_of_hex_string h =
36    let rec aux l p =
37      match l with
38        [] -> 0
39      | hd::tl ->
40          hex_digit_of_char hd * p + aux tl (p * 16)
41    in
42      aux (List.rev $ char_list_of_string h) 1
43  in
44    let i_str = int_of_hex_string s in
45      vect_of_int i_str size
46;;
47
48let hex_string_of_vect v =
49  let hex_string_of_int i =
50    let digit_lookup =
51      function
52        0 -> "0" | 1 -> "1" | 2 -> "2"
53      | 3 -> "3" | 4 -> "4" | 5 -> "5"
54      | 6 -> "6" | 7 -> "7" | 8 -> "8"
55      | 9 -> "9" | 10 -> "A" | 11 -> "B"
56      | 12 -> "C" | 13 -> "D" | 14 -> "E"
57      | 15 -> "F" | _ -> assert false in
58
59    let rec aux i =
60      if i < 16 then
61        digit_lookup i
62      else
63        let div = i / 16 in
64        let rem = i mod 16 in
65           aux div ^ digit_lookup rem
66    in
67      aux i
68  in
69    let vect_int = int_of_vect v in
70      hex_string_of_int vect_int
71;;
72
73let intel_hex_entry_type_of_int =
74  function
75    0 -> Data
76  | 1 -> End
77  | 2 -> ExtendedSeg
78  | 4 -> ExtendedLinear
79  | _ -> assert false
80;;
81
82let int_of_intel_hex_type =
83  function
84    Data -> 0
85  | End -> 1
86  | ExtendedSeg -> 2
87  | ExtendedLinear -> 4
88;;
89
90let prs_length =
91         prs_hex_digit >>=
92fun a -> prs_hex_digit >>=
93fun b -> return (vect_of_hex_string (String.make 1 a) `Eight,
94                 vect_of_hex_string (String.make 1 b) `Eight)
95;;
96
97let prs_addr =
98         prs_hex_digit >>= 
99fun a -> prs_hex_digit >>=
100fun b -> prs_hex_digit >>=
101fun c -> prs_hex_digit >>=
102fun d -> return $ (vect_of_hex_string (String.make 1 a) `Eight,
103                   vect_of_hex_string (String.make 1 b) `Eight,
104                   vect_of_hex_string (String.make 1 c) `Eight,
105                   vect_of_hex_string (String.make 1 d) `Eight)
106;;
107
108let prs_type =
109         prs_hex_digit >>=
110fun a -> prs_hex_digit >>=
111fun b ->
112  let a_as_hex = hex_digit_of_char a in
113  let b_as_hex = hex_digit_of_char b in
114  let total = a_as_hex + b_as_hex in
115    return $ intel_hex_entry_type_of_int total
116
117let prs_data len =
118         prs_exact len $ prs_hex_digit >>=
119fun a ->
120  let a_as_strs = List.map (String.make 1) a in
121  let byte_data = List.map (fun x -> vect_of_hex_string x `Eight) a_as_strs in
122    return $ byte_data
123;;
124
125let prs_checksum =
126         prs_hex_digit >>=
127fun a -> prs_hex_digit >>=
128fun b -> return (vect_of_hex_string (String.make 1 a) `Eight,
129                 vect_of_hex_string (String.make 1 b) `Eight)
130;;
131
132let prs_intel_hex_record =
133         prs_char ':'  >>=
134fun a -> prs_length    >>=
135fun b -> prs_addr      >>=
136fun c -> prs_type      >>=
137fun d ->
138  let (l_u_b, l_l_b) = b in
139  let len = int_of_vect (mk_word l_u_b l_l_b) in
140    prs_data len       >>=
141fun e -> prs_checksum  >>=
142fun f ->
143  return $ {
144    record_length = b;
145    record_addr = c;
146    record_type = d;
147    data_field = e;
148    data_checksum = f
149  }
150;;
151
152let prs_intel_hex_format =
153  prs_sep_by prs_intel_hex_record (prs_char '\n')
154;;
155
156let intel_hex_format_of_string s =
157  let chars = char_list_of_string s in
158    match prs_intel_hex_format chars with
159      [] -> None
160    | (prs,_)::_ -> Some prs
161
162let string_of_intel_hex_entry entry =
163  let record_length_l, record_length_r = entry.record_length in
164  let record_addr_1, record_addr_2, record_addr_3, record_addr_4 = entry.record_addr in
165  let data_checksum_l, data_checksum_r = entry.data_checksum in
166  let length_string = hex_string_of_vect record_length_l ^ 
167                      hex_string_of_vect record_length_l in
168  let addr_string = hex_string_of_vect record_addr_1 ^
169                    hex_string_of_vect record_addr_2 ^
170                    hex_string_of_vect record_addr_3 ^
171                    hex_string_of_vect record_addr_4 in
172  let checksum_string = hex_string_of_vect data_checksum_l ^ 
173                        hex_string_of_vect data_checksum_r in
174  let type_string =
175    match entry.record_type with
176      Data -> "00"
177    | End -> "01"
178    | ExtendedSeg -> "02"
179    | ExtendedLinear -> "04" in
180  let data_string = String.concat "" (List.map hex_string_of_vect entry.data_field) in
181    ":" ^ length_string ^ addr_string ^ type_string ^ data_string ^ checksum_string
182;;
183
184let string_of_intel_hex_format f =
185  let strs = List.map string_of_intel_hex_entry f in
186  let rec aux =
187    function
188      [] -> ""
189    | [e] -> e
190    | hd::tl -> hd ^ "\n" ^ aux tl
191  in
192    aux strs
193
194let add_bytes v  =
195  let r = List.rev v in
196  let rec aux (cry, bs) =
197    function
198      [] -> (cry, bs)
199    | hd::tl ->
200        aux (full_add hd bs cry) tl
201  in
202    aux (false, (vect_of_int 0 `Eight)) r
203
204let checksum_valid hex_entry =
205  if List.length hex_entry.data_field mod 2 <> 0 then
206    false
207  else
208    let chk_1, chk_2 = hex_entry.data_checksum in
209    let _, cs_total = half_add chk_1 chk_2 in
210    let len_1, len_2 = hex_entry.record_length in
211    let _, ln_total = half_add len_1 len_2 in
212    let adr_1, adr_2, adr_3, adr_4 = hex_entry.record_addr in
213    let _, ad_total1 = half_add adr_1 adr_2 in
214    let _, ad_total2 = half_add adr_3 adr_4 in
215    let _, dt_total = add_bytes hex_entry.data_field in
216    let _, total = add_bytes [cs_total; ln_total; ad_total1; ad_total2; dt_total] in
217      cs_total = total
Note: See TracBrowser for help on using the repository browser.