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

Last change on this file since 130 was 130, checked in by mulligan, 10 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.