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

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

Got Test.native to compile. Added functions for exporting intel hex format records to a file.

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