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

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

More cleanup.

File size: 4.4 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
36let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);;
37
38let intel_hex_entry_type_of_int =
39  function
40    0 -> Data
41  | 1 -> End
42  | 2 -> ExtendedSeg
43  | 4 -> ExtendedLinear
44  | _ -> assert false
45;;
46
47let int_of_intel_hex_entry_type =
48 function
49    Data -> 0
50  | End -> 1
51  | ExtendedSeg -> 2
52  | ExtendedLinear -> 4
53;;
54
55let prs_nibble =
56         prs_hex_digit >>= 
57fun a -> return $ vect_of_int (hex_digit_of_char a) `Four
58;;
59
60let prs_byte =
61         prs_nibble >>= 
62fun a -> prs_nibble >>=
63fun b -> return $ mk_byte a b
64;;
65
66let prs_word =
67         prs_byte >>= 
68fun a -> prs_byte >>=
69fun b -> return $ mk_word a b
70;;
71
72let prs_length = prs_byte;;
73let prs_data len = prs_exact len prs_byte
74let prs_checksum = prs_byte;;
75let prs_addr = prs_word;;
76
77let prs_type =
78         prs_hex_digit >>=
79fun a -> prs_hex_digit >>=
80fun b ->
81  let a_as_hex = hex_digit_of_char a in
82  let b_as_hex = hex_digit_of_char b in
83(*CSC: is next line correct??? *)
84  let total = a_as_hex + b_as_hex in
85    return $ intel_hex_entry_type_of_int total
86
87let add_bytes v  =
88  let r = List.rev v in
89  let rec aux (cry, bs) =
90    function
91      [] -> (cry, bs)
92    | hd::tl ->
93        aux (half_add hd bs) tl
94  in
95    aux (false, (vect_of_int 0 `Eight)) r
96
97let checksum_valid hex_entry =
98 let ty = (flip vect_of_int $ `Eight) $ int_of_intel_hex_entry_type hex_entry.record_type in
99 let addr1,addr2 = from_word hex_entry.record_addr in
100 let _, total = add_bytes (hex_entry.record_length :: addr1 :: addr2 :: ty :: hex_entry.data_field) in
101 let _,total = half_add (vect_of_int 1 `Eight) $ complement total in
102   hex_entry.data_checksum = total
103
104
105let prs_intel_hex_record =
106         prs_char ':'  >>=
107fun _ -> prs_length    >>=
108fun b -> prs_addr      >>=
109fun c -> prs_type      >>=
110fun d -> prs_data (int_of_vect b) >>=
111fun e -> prs_checksum  >>=
112fun f -> prs_eof       >>=
113fun _ ->
114 let entry =
115  { record_length = b;
116    record_addr = c;
117    record_type = d;
118    data_field = e;
119    data_checksum = f }
120 in
121  if checksum_valid entry then
122   return entry
123  else
124   prs_zero
125;;
126
127let prs_intel_hex_format =
128  prs_sep_by prs_intel_hex_record (prs_char '\n')
129;;
130
131let intel_hex_format_of_string s =
132  let chars = char_list_of_string s in
133    match prs_intel_hex_format chars with
134      [] -> None
135    | (prs,_)::_ -> Some prs
136
137let string_of_intel_hex_entry entry =
138  let length_string = hex_string_of_vect entry.record_length in
139  let addr_string = hex_string_of_vect entry.record_addr in
140  let checksum_string = hex_string_of_vect entry.data_checksum in
141  let type_string = Printf.sprintf "%0 2d" (int_of_intel_hex_entry_type entry.record_type) in
142  let data_string = String.concat "" (List.map hex_string_of_vect entry.data_field) in
143    ":" ^ length_string ^ addr_string ^ type_string ^ data_string ^ checksum_string
144;;
145
146let string_of_intel_hex_format f =
147  let strs = List.map string_of_intel_hex_entry f in
148  let rec aux =
149    function
150      [] -> ""
151    | [e] -> e
152    | hd::tl -> hd ^ "\n" ^ aux tl
153  in
154    aux strs
155
156let intel_hex_of_file path =
157 let fd = open_in path in
158 let rec aux () =
159  match try Some (input_line fd) with End_of_file -> None with
160     None -> []
161   | Some txt ->
162      let read = prs_intel_hex_record (Parser.chars_of_string txt) in
163      let read =
164       match read with
165          [x,[]] -> x
166        | _ -> raise (WrongFormat txt)
167      in
168       read::aux ()
169 in
170  aux ()
171;;
172
173let rec load_from mem addr =
174 function
175    [] -> mem
176  | he::tl ->
177     load_from (Physical.WordMap.add addr he mem) (snd (BitVectors.half_add addr (BitVectors.vect_of_int 1 `Sixteen))) tl
178;;
179
180let process_intel_hex =
181 let rec aux mem =
182  function
183     [] -> assert false
184   | he::tl ->
185      match he.record_type with
186         End -> assert (tl = []); mem
187       | Data -> aux (load_from mem he.record_addr he.data_field) tl
188       | _ -> assert false
189 in
190  aux Physical.WordMap.empty
191;;
Note: See TracBrowser for help on using the repository browser.