source: Deliverables/D2.2/8051/src/ASM/IntelHex.ml

Last change on this file was 664, checked in by mulligan, 11 years ago

Changed output of Intel HEX files so we no longer have those gargantuan blocks of zeroes at the end.

File size: 7.6 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 rec zeros len =
244  if len = 0 then
245    []
246  else
247    vect_of_int 0 `Eight :: zeros (len - 1)
248
249let post_process_exported_code_memory intel_hex =
250  let reversed = List.rev intel_hex in
251  let rec aux hex =
252    match hex with
253      [] -> []
254    | he::tl ->
255        if he.record_type = End then
256          aux tl
257        else if he.record_type = Data then
258          if he.data_field = zeros (int_of_vect he.record_length) then
259            aux tl
260          else
261            he::(aux tl)
262        else
263          tl
264  in
265    List.rev (aux reversed)
266
267let pack_exported_code_memory chunk_size max_addressable code_mem =
268  let export = export_code_memory chunk_size max_addressable code_mem in
269  let cleaned = clean_exported_code_memory export in
270  let processed = process_exported_code_memory cleaned in
271  let postprocessed = post_process_exported_code_memory processed in
272  let end_buffer =
273    [{ record_length = zero `Eight;
274      record_addr = zero `Sixteen;
275      record_type = End;
276      data_field = [];
277      data_checksum = vect_of_int 255 `Eight
278    }] in
279    postprocessed @ end_buffer
280;;
281
282let file_of_intel_hex path fmt =
283  let str_fmt = string_of_intel_hex_format fmt in
284  let channel = open_out path in
285    fprintf channel "%s\n" str_fmt;
286    close_out channel
287;;
Note: See TracBrowser for help on using the repository browser.