source: Deliverables/D4.1/IntelHex.ml

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

Got Intel HEX format exportation working.

File size: 7.0 KB
Line 
1open BitVectors;;
2open ASM;;
3open Util;;
4open Parser;;
5open Printf;;
6
7exception WrongFormat of string
8
9type intel_hex_entry_type =
10    Data
11  | End
12  | ExtendedSeg
13  | ExtendedLinear
14;;
15
16type intel_hex_entry =
17{
18  record_length: byte;
19  record_addr: word;
20  record_type: intel_hex_entry_type;
21  data_field: byte list;
22  data_checksum: byte
23}
24;;
25
26type intel_hex_format = intel_hex_entry list;;
27
28let hex_digit_of_char =
29    function
30      '0' -> 0 | '1' -> 1 | '2' -> 2
31    | '3' -> 3 | '4' -> 4 | '5' -> 5
32    | '6' -> 6 | '7' -> 7 | '8' -> 8
33    | '9' -> 9 | 'A' -> 10 | 'B' -> 11
34    | 'C' -> 12 | 'D' -> 13 | 'E' -> 14
35    | 'F' -> 15 | 'a' -> 10 | 'b' -> 11
36    | 'c' -> 12 | 'd' -> 13 | 'e' -> 14
37    | 'f' -> 15 | _ -> assert false
38
39let intel_hex_entry_type_of_int =
40  function
41    0 -> Data
42  | 1 -> End
43  | 2 -> ExtendedSeg
44  | 4 -> ExtendedLinear
45  | _ -> assert false
46;;
47
48let int_of_intel_hex_entry_type =
49 function
50    Data -> 0
51  | End -> 1
52  | ExtendedSeg -> 2
53  | ExtendedLinear -> 4
54;;
55
56let prs_nibble =
57         prs_hex_digit >>= 
58fun a -> return $ vect_of_int (hex_digit_of_char a) `Four
59;;
60
61let prs_byte =
62         prs_nibble >>= 
63fun a -> prs_nibble >>=
64fun b -> return $ mk_byte a b
65;;
66
67let prs_word =
68         prs_byte >>= 
69fun a -> prs_byte >>=
70fun b -> return $ mk_word a b
71;;
72
73let prs_length = prs_byte;;
74let prs_data len = prs_exact len prs_byte
75let prs_checksum = prs_byte;;
76let prs_addr = prs_word;;
77
78let prs_type =
79         prs_hex_digit >>=
80fun a -> prs_hex_digit >>=
81fun b ->
82  let a_as_hex = hex_digit_of_char a in
83  let b_as_hex = hex_digit_of_char b in
84(*CSC: is next line correct??? *)
85  let total = a_as_hex + b_as_hex in
86    return $ intel_hex_entry_type_of_int total
87
88let add_bytes v  =
89  let r = List.rev v in
90  let rec aux (cry, bs) =
91    function
92      [] -> (cry, bs)
93    | hd::tl ->
94        aux (half_add hd bs) tl
95  in
96    aux (false, (vect_of_int 0 `Eight)) r
97
98let calculate_checksum hex_entry =
99 let ty = (flip vect_of_int $ `Eight) $ int_of_intel_hex_entry_type hex_entry.record_type in
100 let addr1,addr2 = from_word hex_entry.record_addr in
101 let _, total = add_bytes (hex_entry.record_length :: addr1 :: addr2 :: ty :: hex_entry.data_field) in
102 let _,total = half_add (vect_of_int 1 `Eight) $ complement total in
103  total
104
105let checksum_valid hex_entry =
106  let total = calculate_checksum hex_entry in
107    hex_entry.data_checksum = total
108
109let prs_intel_hex_record =
110         prs_char ':'  >>=
111fun _ -> prs_length    >>=
112fun b -> prs_addr      >>=
113fun c -> prs_type      >>=
114fun d -> prs_data (int_of_vect b) >>=
115fun e -> prs_checksum  >>=
116fun f -> prs_eof       >>=
117fun _ ->
118 let entry =
119  { record_length = b;
120    record_addr = c;
121    record_type = d;
122    data_field = e;
123    data_checksum = f }
124 in
125  if checksum_valid entry then
126   return entry
127  else
128   prs_zero
129;;
130
131let prs_intel_hex_format =
132  prs_sep_by prs_intel_hex_record (prs_char '\n')
133;;
134
135let intel_hex_format_of_string s =
136  let chars = char_list_of_string s in
137    match prs_intel_hex_format chars with
138      [] -> None
139    | (prs,_)::_ -> Some prs
140
141let string_of_intel_hex_entry entry =
142  let length_string = hex_string_of_vect entry.record_length in
143  let addr_string = Printf.sprintf "%04X" (int_of_vect entry.record_addr) in
144  let checksum_string = Printf.sprintf "%02X" (int_of_vect entry.data_checksum) in
145  let type_string = Printf.sprintf "%02d" (int_of_intel_hex_entry_type entry.record_type) in
146  let data_string = String.concat "" (List.map hex_string_of_vect entry.data_field) in
147    ":" ^ length_string ^ addr_string ^ type_string ^ data_string ^ checksum_string
148;;
149
150let string_of_intel_hex_format f =
151  let strs = List.map string_of_intel_hex_entry f in
152  let rec aux =
153    function
154      [] -> ""
155    | [e] -> e
156    | hd::tl -> hd ^ "\n" ^ aux tl
157  in
158    aux strs
159
160let intel_hex_of_file path =
161 let fd = open_in path in
162 let rec aux () =
163  match try Some (input_line fd) with End_of_file -> None with
164     None -> []
165   | Some txt ->
166      let read = prs_intel_hex_record (Parser.chars_of_string txt) in
167      let read =
168       match read with
169          [x,[]] -> x
170        | _ -> raise (WrongFormat txt)
171      in
172       read::aux ()
173 in
174  aux ()
175;;
176
177let rec load_from mem addr =
178 function
179    [] -> mem
180  | he::tl ->
181     load_from (Physical.WordMap.add addr he mem) (snd (BitVectors.half_add addr (BitVectors.vect_of_int 1 `Sixteen))) tl
182;;
183
184let process_intel_hex =
185 let rec aux mem =
186  function
187     [] -> assert false
188   | he::tl ->
189      match he.record_type with
190         End -> assert (tl = []); mem
191       | Data -> aux (load_from mem he.record_addr he.data_field) tl
192       | _ -> assert false
193 in
194  aux Physical.WordMap.empty
195;;
196
197(* DPM: this needs some comment:
198     We aim to extract code memory into segmented lists of bytes, with a maximum
199     length (chunk_size).  The code memory map has a fixed size (max_addressable)
200     on the 8051.  Further, the chunks we extract get segmented when we find an
201     unitialized zone in the code memory.
202*)
203let export_code_memory chunk_size max_addressable code_mem =
204  let rec aux chunk address start_address rbuff lbuff =
205    if address = max_addressable then
206      (start_address, List.rev rbuff)::lbuff
207    else if chunk = 0 then
208      aux chunk_size address address [] ((start_address, List.rev rbuff)::lbuff)
209    else
210      let code = Physical.WordMap.find (vect_of_int address `Sixteen) code_mem in
211        aux (chunk - 1) (address + 1) start_address (code::rbuff) lbuff
212  in
213    List.rev (aux chunk_size 0 0 [] [])
214;;
215
216let clean_exported_code_memory = List.filter (fun x -> snd x <> [])
217;;
218
219let calculate_data_checksum (record_length, record_addr, record_type, data_field) =
220  let ty = (flip vect_of_int $ `Eight) $ int_of_intel_hex_entry_type record_type in
221  let addr1,addr2 = from_word record_addr in
222  let _, total = add_bytes (record_length :: addr1 :: addr2 :: ty :: data_field) in
223  let _,total = half_add (vect_of_int 0 `Eight) $ complement total in
224    total
225;;
226
227let process_exported_code_memory =
228  List.map (fun x ->
229    let record_length = vect_of_int (List.length (snd x)) `Eight in
230    let record_addr = vect_of_int (fst x) `Sixteen in
231    let record_type = Data in
232    let data_field = snd x in
233    let temp_record =
234      { record_length = record_length;
235        record_addr = record_addr;
236        record_type = record_type;
237        data_field = data_field;
238        data_checksum = zero `Eight
239      } in
240    { temp_record with data_checksum = calculate_checksum temp_record })
241;;
242
243let pack_exported_code_memory chunk_size max_addressable code_mem =
244  let export = export_code_memory chunk_size max_addressable code_mem in
245  let cleaned = clean_exported_code_memory export in
246  let processed = process_exported_code_memory cleaned in
247  let end_buffer =
248    [{ record_length = zero `Eight;
249      record_addr = zero `Sixteen;
250      record_type = End;
251      data_field = [];
252      data_checksum = vect_of_int 255 `Eight
253    }] in
254    processed @ end_buffer
255;;
256
257let file_of_intel_hex path fmt =
258  let str_fmt = string_of_intel_hex_format fmt in
259  let channel = open_out path in
260    fprintf channel "%s\n" str_fmt;
261    close_out channel
262;;
Note: See TracBrowser for help on using the repository browser.