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

Last change on this file since 138 was 138, checked in by sacerdot, 9 years ago

Several bug fixes and code clean-up.
New main file: test.ml to parse and execute an HEX file.
Usage: ./test.native foo.hex

File size: 5.2 KB
Line 
1open BitVectors;;
2open ASM;;
3open Util;;
4open Parser;;
5
6exception WrongFormat of string
7
8type intel_hex_entry_type =
9    Data
10  | End
11  | ExtendedSeg
12  | ExtendedLinear
13;;
14
15type intel_hex_entry =
16{
17  record_length: byte;
18  record_addr: word;
19  record_type: intel_hex_entry_type;
20  data_field: byte list;
21  data_checksum: byte
22}
23;;
24
25type intel_hex_format = intel_hex_entry list;;
26
27let hex_digit_of_char =
28    function
29      '0' -> 0 | '1' -> 1 | '2' -> 2
30    | '3' -> 3 | '4' -> 4 | '5' -> 5
31    | '6' -> 6 | '7' -> 7 | '8' -> 8
32    | '9' -> 9 | 'A' -> 10 | 'B' -> 11
33    | 'C' -> 12 | 'D' -> 13 | 'E' -> 14
34    | 'F' -> 15 | _ -> assert false
35
36(* CSC: tipare piu' strettamente: prendere la taglia del vettore in input
37   come taglia della stringa *)
38let vect_of_hex_string s size =
39  let int_of_hex_string h =
40    let rec aux l p =
41      match l with
42        [] -> 0
43      | hd::tl ->
44          hex_digit_of_char hd * p + aux tl (p * 16)
45    in
46      aux (List.rev $ char_list_of_string h) 1
47  in
48    let i_str = int_of_hex_string s in
49      vect_of_int i_str size
50;;
51
52let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);;
53
54let intel_hex_entry_type_of_int =
55  function
56    0 -> Data
57  | 1 -> End
58  | 2 -> ExtendedSeg
59  | 4 -> ExtendedLinear
60  | _ -> assert false
61;;
62
63let int_of_intel_hex_entry_type =
64 function
65    Data -> 0
66  | End -> 1
67  | ExtendedSeg -> 2
68  | ExtendedLinear -> 4
69;;
70
71let prs_byte =
72         prs_hex_digit >>= 
73fun a -> prs_hex_digit >>=
74fun b -> return $ vect_of_hex_string (String.make 1 a ^ String.make 1 b) `Eight
75;;
76
77let prs_word =
78         prs_hex_digit >>= 
79fun a -> prs_hex_digit >>=
80fun b -> prs_hex_digit >>=
81fun c -> prs_hex_digit >>=
82fun d -> return $ vect_of_hex_string (String.make 1 a ^ String.make 1 b ^ String.make 1 c ^ String.make 1 d) `Sixteen
83;;
84
85let prs_length = prs_byte;;
86let prs_data len = prs_exact len prs_byte
87let prs_checksum = prs_byte;;
88let prs_addr = prs_word;;
89
90let prs_type =
91         prs_hex_digit >>=
92fun a -> prs_hex_digit >>=
93fun b ->
94  let a_as_hex = hex_digit_of_char a in
95  let b_as_hex = hex_digit_of_char b in
96  let total = a_as_hex + b_as_hex in
97    return $ intel_hex_entry_type_of_int total
98
99let add_bytes v  =
100  let r = List.rev v in
101  let rec aux (cry, bs) =
102    function
103      [] -> (cry, bs)
104    | hd::tl ->
105        aux (half_add hd bs) tl
106  in
107    aux (false, (vect_of_int 0 `Eight)) r
108
109let checksum_valid hex_entry =
110 let ty = (flip vect_of_int $ `Eight) $ int_of_intel_hex_entry_type hex_entry.record_type in
111 let addr1,addr2 = from_word hex_entry.record_addr in
112 let _, total = add_bytes (hex_entry.record_length :: addr1 :: addr2 :: ty :: hex_entry.data_field) in
113 let _,total = half_add (vect_of_int 1 `Eight) $ complement total in
114   hex_entry.data_checksum = total
115
116
117let prs_intel_hex_record =
118         prs_char ':'  >>=
119fun _ -> prs_length    >>=
120fun b -> prs_addr      >>=
121fun c -> prs_type      >>=
122fun d ->
123  let len = int_of_vect b in
124    prs_data len       >>=
125fun e -> prs_checksum  >>=
126fun f -> prs_eof       >>=
127fun _ ->
128 let entry =
129  { record_length = b;
130    record_addr = c;
131    record_type = d;
132    data_field = e;
133    data_checksum = f }
134 in
135  if checksum_valid entry then
136   return entry
137  else
138   prs_zero
139;;
140
141let prs_intel_hex_format =
142  prs_sep_by prs_intel_hex_record (prs_char '\n')
143;;
144
145let intel_hex_format_of_string s =
146  let chars = char_list_of_string s in
147    match prs_intel_hex_format chars with
148      [] -> None
149    | (prs,_)::_ -> Some prs
150
151(* DPM: BUG --- length and addr hex values are sometimes shortened if the hex
152        string begins with a zero.  All length strings should be two hex chars
153        long, and all addr strings should be four.                            *)
154let string_of_intel_hex_entry entry =
155  let length_string = hex_string_of_vect entry.record_length in
156  let addr_string = hex_string_of_vect entry.record_addr in
157  let checksum_string = hex_string_of_vect entry.data_checksum in
158  let type_string =
159    match entry.record_type with
160      Data -> "00"
161    | End -> "01"
162    | ExtendedSeg -> "02"
163    | ExtendedLinear -> "04" in
164  let data_string = String.concat "" (List.map hex_string_of_vect entry.data_field) in
165    ":" ^ length_string ^ addr_string ^ type_string ^ data_string ^ checksum_string
166;;
167
168let string_of_intel_hex_format f =
169  let strs = List.map string_of_intel_hex_entry f in
170  let rec aux =
171    function
172      [] -> ""
173    | [e] -> e
174    | hd::tl -> hd ^ "\n" ^ aux tl
175  in
176    aux strs
177
178let intel_hex_of_file path =
179 let fd = open_in path in
180 let rec aux () =
181  match try Some (input_line fd) with End_of_file -> None with
182     None -> []
183   | Some txt ->
184      let read = prs_intel_hex_record (Parser.chars_of_string txt) in
185      let read =
186       match read with
187          [x,[]] -> x
188        | _ -> raise (WrongFormat txt)
189      in
190       read::aux ()
191 in
192  aux ()
193;;
194
195let rec load_from mem addr =
196 function
197    [] -> mem
198  | he::tl ->
199     load_from (Physical.WordMap.add addr he mem) (snd (BitVectors.half_add addr (BitVectors.vect_of_int 1 `Sixteen))) tl
200;;
201
202let process_intel_hex =
203 let rec aux mem =
204  function
205     [] -> assert false
206   | he::tl ->
207      match he.record_type with
208         End -> assert (tl = []); mem
209       | Data -> aux (load_from mem he.record_addr he.data_field) tl
210       | _ -> assert false
211 in
212  aux Physical.WordMap.empty
213;;
Note: See TracBrowser for help on using the repository browser.