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

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

Wrote exportation code. Need to test it.

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