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

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

Commit again? Not sure what happened. All Parser files were already
under SVN control.

File size: 4.7 KB
Line 
1open BitVectors;;
2open ASM;;
3open Util;;
4open Parser;;
5
6type intel_hex_entry_type =
7    Data
8  | End
9  | ExtendedSeg
10  | ExtendedLinear
11;;
12
13type intel_hex_entry =
14{
15  record_length: byte * byte;
16  record_addr: byte * byte * byte * byte;
17  record_type: intel_hex_entry_type;
18  data_field: byte list;
19  data_checksum: byte * byte
20}
21;;
22
23type intel_hex_format = intel_hex_entry list;;
24
25let hex_digit_of_char =
26    function
27      '0' -> 0 | '1' -> 1 | '2' -> 2
28    | '3' -> 3 | '4' -> 4 | '5' -> 5
29    | '6' -> 6 | '7' -> 7 | '8' -> 8
30    | '9' -> 9 | 'A' -> 10 | 'B' -> 11
31    | 'C' -> 12 | 'D' -> 13 | 'E' -> 14
32    | 'F' -> 15 | _ -> assert false
33
34let vect_of_hex_string s size =
35  let int_of_hex_string h =
36    let rec aux l p =
37      match l with
38        [] -> 0
39      | hd::tl ->
40          hex_digit_of_char hd * p + aux tl (p * 16)
41    in
42      aux (List.rev $ char_list_of_string h) 1
43  in
44    let i_str = int_of_hex_string s in
45      vect_of_int i_str size
46;;
47
48let hex_string_of_vect v =
49  let hex_string_of_int i =
50    let digit_lookup =
51      function
52        0 -> "0" | 1 -> "1" | 2 -> "2"
53      | 3 -> "3" | 4 -> "4" | 5 -> "5"
54      | 6 -> "6" | 7 -> "7" | 8 -> "8"
55      | 9 -> "9" | 10 -> "A" | 11 -> "B"
56      | 12 -> "C" | 13 -> "D" | 14 -> "E"
57      | 15 -> "F" | _ -> assert false in
58
59    let rec aux i =
60      if i < 16 then
61        digit_lookup i
62      else
63        let div = i / 16 in
64        let rem = i mod 16 in
65           aux div ^ digit_lookup rem
66    in
67      aux i
68  in
69    let vect_int = int_of_vect v in
70      hex_string_of_int vect_int
71;;
72
73let intel_hex_entry_type_of_int =
74  function
75    0 -> Data
76  | 1 -> End
77  | 2 -> ExtendedSeg
78  | 4 -> ExtendedLinear
79  | _ -> assert false
80;;
81
82let prs_length =
83         prs_hex_digit >>=
84fun a -> prs_hex_digit >>=
85fun b -> return (vect_of_hex_string (String.make 1 a) `Eight,
86                 vect_of_hex_string (String.make 1 b) `Eight)
87;;
88
89let prs_addr =
90         prs_hex_digit >>= 
91fun a -> prs_hex_digit >>=
92fun b -> prs_hex_digit >>=
93fun c -> prs_hex_digit >>=
94fun d -> return $ (vect_of_hex_string (String.make 1 a) `Eight,
95                   vect_of_hex_string (String.make 1 b) `Eight,
96                   vect_of_hex_string (String.make 1 c) `Eight,
97                   vect_of_hex_string (String.make 1 d) `Eight)
98;;
99
100let prs_type =
101         prs_hex_digit >>=
102fun a -> prs_hex_digit >>=
103fun b ->
104  let a_as_hex = hex_digit_of_char a in
105  let b_as_hex = hex_digit_of_char b in
106  let total = a_as_hex + b_as_hex in
107    return $ intel_hex_entry_type_of_int total
108
109let prs_data len =
110         prs_exact len $ prs_hex_digit >>=
111fun a ->
112  let a_as_strs = List.map (String.make 1) a in
113  let byte_data = List.map (fun x -> vect_of_hex_string x `Eight) a_as_strs in
114    return $ byte_data
115;;
116
117let prs_checksum =
118         prs_hex_digit >>=
119fun a -> prs_hex_digit >>=
120fun b -> return (vect_of_hex_string (String.make 1 a) `Eight,
121                 vect_of_hex_string (String.make 1 b) `Eight)
122;;
123
124let prs_intel_hex_record =
125         prs_char ':'  >>=
126fun a -> prs_length    >>=
127fun b -> prs_addr      >>=
128fun c -> prs_type      >>=
129fun d ->
130  let (l_u_b, l_l_b) = b in
131  let len = int_of_vect (mk_word l_u_b l_l_b) in
132    prs_data len       >>=
133fun e -> prs_checksum  >>=
134fun f ->
135  return $ {
136    record_length = b;
137    record_addr = c;
138    record_type = d;
139    data_field = e;
140    data_checksum = f
141  }
142;;
143
144let prs_intel_hex_format =
145  prs_sep_by prs_intel_hex_record (prs_char '\n')
146;;
147
148let intel_hex_format_of_string s =
149  let chars = char_list_of_string s in
150    match prs_intel_hex_format chars with
151      [] -> None
152    | (prs,_)::_ -> Some prs
153
154let string_of_intel_hex_entry entry =
155  let record_length_l, record_length_r = entry.record_length in
156  let record_addr_1, record_addr_2, record_addr_3, record_addr_4 = entry.record_addr in
157  let data_checksum_l, data_checksum_r = entry.data_checksum in
158  let length_string = hex_string_of_vect record_length_l ^ 
159                      hex_string_of_vect record_length_l in
160  let addr_string = hex_string_of_vect record_addr_1 ^
161                    hex_string_of_vect record_addr_2 ^
162                    hex_string_of_vect record_addr_3 ^
163                    hex_string_of_vect record_addr_4 in
164  let checksum_string = hex_string_of_vect data_checksum_l ^ 
165                        hex_string_of_vect data_checksum_r in
166  let type_string =
167    match entry.record_type with
168      Data -> "00"
169    | End -> "01"
170    | ExtendedSeg -> "02"
171    | ExtendedLinear -> "04" in
172  let data_string = String.concat "" (List.map hex_string_of_vect entry.data_field) in
173    ":" ^ length_string ^ addr_string ^ type_string ^ data_string ^ checksum_string
174;;
175
176let string_of_intel_hex_format f =
177  let strs = List.map string_of_intel_hex_entry f in
178  let rec aux =
179    function
180      [] -> ""
181    | [e] -> e
182    | hd::tl -> hd ^ "\n" ^ aux tl
183  in
184    aux strs
Note: See TracBrowser for help on using the repository browser.