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

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

Got Intel HEX format exportation working.

File size: 7.0 KB
RevLine 
[122]1open BitVectors;;
2open ASM;;
[128]3open Util;;
[130]4open Parser;;
[444]5open Printf;;
[122]6
[138]7exception WrongFormat of string
8
[122]9type intel_hex_entry_type =
10    Data
11  | End
12  | ExtendedSeg
13  | ExtendedLinear
[130]14;;
[122]15
16type intel_hex_entry =
17{
[138]18  record_length: byte;
19  record_addr: word;
[122]20  record_type: intel_hex_entry_type;
[138]21  data_field: byte list;
22  data_checksum: byte
[130]23}
24;;
[122]25
[130]26type intel_hex_format = intel_hex_entry list;;
[123]27
[130]28let hex_digit_of_char =
[128]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
[448]35    | 'F' -> 15 | 'a' -> 10 | 'b' -> 11
36    | 'c' -> 12 | 'd' -> 13 | 'e' -> 14
37    | 'f' -> 15 | _ -> assert false
[128]38
[130]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
[138]48let int_of_intel_hex_entry_type =
49 function
[131]50    Data -> 0
51  | End -> 1
52  | ExtendedSeg -> 2
53  | ExtendedLinear -> 4
54;;
55
[139]56let prs_nibble =
[138]57         prs_hex_digit >>= 
[139]58fun a -> return $ vect_of_int (hex_digit_of_char a) `Four
[130]59;;
60
[139]61let prs_byte =
62         prs_nibble >>= 
63fun a -> prs_nibble >>=
64fun b -> return $ mk_byte a b
65;;
66
[138]67let prs_word =
[139]68         prs_byte >>= 
69fun a -> prs_byte >>=
70fun b -> return $ mk_word a b
[130]71;;
72
[138]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
[130]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
[139]84(*CSC: is next line correct??? *)
[130]85  let total = a_as_hex + b_as_hex in
86    return $ intel_hex_entry_type_of_int total
87
[138]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
[130]97
[448]98let calculate_checksum hex_entry =
[138]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
[448]103  total
[130]104
[448]105let checksum_valid hex_entry =
106  let total = calculate_checksum hex_entry in
107    hex_entry.data_checksum = total
[138]108
[130]109let prs_intel_hex_record =
110         prs_char ':'  >>=
[138]111fun _ -> prs_length    >>=
[130]112fun b -> prs_addr      >>=
113fun c -> prs_type      >>=
[139]114fun d -> prs_data (int_of_vect b) >>=
[130]115fun e -> prs_checksum  >>=
[138]116fun f -> prs_eof       >>=
117fun _ ->
118 let entry =
119  { record_length = b;
[130]120    record_addr = c;
121    record_type = d;
122    data_field = e;
[138]123    data_checksum = f }
124 in
125  if checksum_valid entry then
126   return entry
127  else
128   prs_zero
[130]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
[123]141let string_of_intel_hex_entry entry =
[138]142  let length_string = hex_string_of_vect entry.record_length in
[448]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
[445]145  let type_string = Printf.sprintf "%02d" (int_of_intel_hex_entry_type entry.record_type) in
[123]146  let data_string = String.concat "" (List.map hex_string_of_vect entry.data_field) in
[130]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
[131]159
[138]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;;
[131]176
[138]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 =
[134]186  function
[138]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;;
[442]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*)
[443]203let export_code_memory chunk_size max_addressable code_mem =
[445]204  let rec aux chunk address start_address rbuff lbuff =
205    if address = max_addressable then
[448]206      (start_address, List.rev rbuff)::lbuff
[445]207    else if chunk = 0 then
[448]208      aux chunk_size address address [] ((start_address, List.rev rbuff)::lbuff)
[442]209    else
210      let code = Physical.WordMap.find (vect_of_int address `Sixteen) code_mem in
[445]211        aux (chunk - 1) (address + 1) start_address (code::rbuff) lbuff
[442]212  in
[445]213    List.rev (aux chunk_size 0 0 [] [])
[443]214;;
215
216let clean_exported_code_memory = List.filter (fun x -> snd x <> [])
217;;
218
[446]219let calculate_data_checksum (record_length, record_addr, record_type, data_field) =
[447]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
[448]223  let _,total = half_add (vect_of_int 0 `Eight) $ complement total in
[447]224    total
[446]225;;
226
[443]227let process_exported_code_memory =
228  List.map (fun x ->
[446]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
[448]233    let temp_record =
[446]234      { record_length = record_length;
235        record_addr = record_addr;
236        record_type = record_type;
237        data_field = data_field;
[448]238        data_checksum = zero `Eight
239      } in
240    { temp_record with data_checksum = calculate_checksum temp_record })
[443]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 = [];
[448]252      data_checksum = vect_of_int 255 `Eight
[443]253    }] in
254    processed @ end_buffer
255;;
[444]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.