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

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

Fixed checksum calculation check. Requires a *half add* (i.e. ignore
carry when summing), not a full add. This is not obvious from the Keil
website describing the calculation. Tested on example programs on Keil
website, and it works fine.

File size: 6.3 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: nibble * nibble;
16  record_addr: nibble * nibble * nibble * nibble;
17  record_type: intel_hex_entry_type;
18  data_field: nibble list;
19  data_checksum: nibble * nibble
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) `Four,
94                 vect_of_hex_string (String.make 1 b) `Four)
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) `Four,
103                   vect_of_hex_string (String.make 1 b) `Four,
104                   vect_of_hex_string (String.make 1 c) `Four,
105                   vect_of_hex_string (String.make 1 d) `Four)
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 `Four) 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) `Four,
129                 vect_of_hex_string (String.make 1 b) `Four)
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_byte l_u_b l_l_b) in
140    prs_data (2 * 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 (half_add hd bs) tl
201  in
202    aux (false, (vect_of_int 0 `Eight)) r
203
204(* DPM: Non exhaustive pattern as we always check list length is even! *)
205let rec lift_to_bytes =
206  function
207    [] -> []
208  | hd::hd'::tl ->
209      (mk_byte hd hd')::(lift_to_bytes tl)
210
211let checksum_valid hex_entry =
212  if List.length hex_entry.data_field mod 2 <> 0 then
213    false
214  else
215    let chk_1, chk_2 = hex_entry.data_checksum in
216    let checksum = mk_byte chk_1 chk_2 in
217    let len_1, len_2 = hex_entry.record_length in
218    let ln_total = mk_byte len_1 len_2 in
219    let ty_total = (flip vect_of_int $ `Eight) $ int_of_intel_hex_type hex_entry.record_type in
220    let adr_1, adr_2, adr_3, adr_4 = hex_entry.record_addr in
221    let ad_total1 = mk_byte adr_1 adr_2 in
222    let ad_total2 = mk_byte adr_3 adr_4 in
223    let _, dt_total = add_bytes <*> lift_to_bytes $ hex_entry.data_field in
224    let _, total = add_bytes [ln_total; ad_total1; ad_total2; ty_total; dt_total] in
225    let _,total = half_add (vect_of_int 1 `Eight) $ complement total in
226      checksum = total
227
228(* DPM: Debug
229   let tot = complement <*> snd $ add_bytes [vect_of_int 2 `Eight; vect_of_int 0 `Eight; vect_of_int 0 `Eight; vect_of_int 4 `Eight; vect_of_int 255 `Eight; vect_of_int 255 `Eight];;
230   let Some entry = intel_hex_format_of_string ":02000004FFFFFC";;
231   checksum_valid $ List.hd entry;;
232*)
Note: See TracBrowser for help on using the repository browser.