Changeset 138 for Deliverables/D4.1/IntelHex.ml
 Timestamp:
 Sep 29, 2010, 12:25:28 PM (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D4.1/IntelHex.ml
r137 r138 3 3 open Util;; 4 4 open Parser;; 5 6 exception WrongFormat of string 5 7 6 8 type intel_hex_entry_type = … … 13 15 type intel_hex_entry = 14 16 { 15 record_length: nibble * nibble;16 record_addr: nibble * nibble * nibble * nibble;17 record_length: byte; 18 record_addr: word; 17 19 record_type: intel_hex_entry_type; 18 data_field: nibble list;19 data_checksum: nibble * nibble20 data_field: byte list; 21 data_checksum: byte 20 22 } 21 23 ;; … … 32 34  'F' > 15  _ > assert false 33 35 36 (* CSC: tipare piu' strettamente: prendere la taglia del vettore in input 37 come taglia della stringa *) 34 38 let vect_of_hex_string s size = 35 39 let int_of_hex_string h = … … 46 50 ;; 47 51 48 let 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 ;; 52 let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);; 72 53 73 54 let intel_hex_entry_type_of_int = … … 80 61 ;; 81 62 82 let int_of_intel_hex_ type =83 63 let int_of_intel_hex_entry_type = 64 function 84 65 Data > 0 85 66  End > 1 … … 88 69 ;; 89 70 90 let prs_ length=91 prs_hex_digit >>= 71 let prs_byte = 72 prs_hex_digit >>= 92 73 fun a > prs_hex_digit >>= 93 fun b > return (vect_of_hex_string (String.make 1 a) `Four, 94 vect_of_hex_string (String.make 1 b) `Four) 95 ;; 96 97 let prs_addr = 74 fun b > return $ vect_of_hex_string (String.make 1 a ^ String.make 1 b) `Eight 75 ;; 76 77 let prs_word = 98 78 prs_hex_digit >>= 99 79 fun a > prs_hex_digit >>= 100 80 fun b > prs_hex_digit >>= 101 81 fun c > prs_hex_digit >>= 102 fun d > return $ (vect_of_hex_string (String.make 1 a) `Four, 103 vect_of_hex_string (String.make 1 b) `Four, 104 vect_of_hex_string (String.make 1 c) `Four, 105 vect_of_hex_string (String.make 1 d) `Four) 106 ;; 82 fun 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 85 let prs_length = prs_byte;; 86 let prs_data len = prs_exact len prs_byte 87 let prs_checksum = prs_byte;; 88 let prs_addr = prs_word;; 107 89 108 90 let prs_type = … … 115 97 return $ intel_hex_entry_type_of_int total 116 98 117 let prs_data len = 118 prs_exact len $ prs_hex_digit >>= 119 fun a > 120 let a_as_strs = List.map (String.make 1) a in 121 let byte_data = List.map (fun x > vect_of_hex_string x `Four) a_as_strs in 122 return $ byte_data 123 ;; 124 125 let prs_checksum = 126 prs_hex_digit >>= 127 fun a > prs_hex_digit >>= 128 fun b > return (vect_of_hex_string (String.make 1 a) `Four, 129 vect_of_hex_string (String.make 1 b) `Four) 130 ;; 99 let 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 109 let 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 131 116 132 117 let prs_intel_hex_record = 133 118 prs_char ':' >>= 134 fun a> prs_length >>=119 fun _ > prs_length >>= 135 120 fun b > prs_addr >>= 136 121 fun c > prs_type >>= 137 122 fun d > 138 let (l_u_b, l_l_b) = b in 139 let len = int_of_vect (mk_byte l_u_b l_l_b) in 140 prs_data (2 * len) >>= 123 let len = int_of_vect b in 124 prs_data len >>= 141 125 fun e > prs_checksum >>= 142 fun f > 143 return $ { 144 record_length = b; 126 fun f > prs_eof >>= 127 fun _ > 128 let entry = 129 { record_length = b; 145 130 record_addr = c; 146 131 record_type = d; 147 132 data_field = e; 148 data_checksum = f 149 } 133 data_checksum = f } 134 in 135 if checksum_valid entry then 136 return entry 137 else 138 prs_zero 150 139 ;; 151 140 … … 164 153 long, and all addr strings should be four. *) 165 154 let string_of_intel_hex_entry entry = 166 let record_length_l, record_length_r = entry.record_length in 167 let record_addr_1, record_addr_2, record_addr_3, record_addr_4 = entry.record_addr in 168 let data_checksum_l, data_checksum_r = entry.data_checksum in 169 let length_string = hex_string_of_vect $ mk_byte record_length_l record_length_r in 170 let addr_string = hex_string_of_vect record_addr_1 ^ 171 hex_string_of_vect record_addr_2 ^ 172 hex_string_of_vect record_addr_3 ^ 173 hex_string_of_vect record_addr_4 in 174 let checksum_string = hex_string_of_vect data_checksum_l ^ 175 hex_string_of_vect data_checksum_r in 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 176 158 let type_string = 177 159 match entry.record_type with … … 194 176 aux strs 195 177 196 let add_bytes v = 197 let r = List.rev v in 198 let rec aux (cry, bs) = 199 function 200 [] > (cry, bs) 201  hd::tl > 202 aux (half_add hd bs) tl 203 in 204 aux (false, (vect_of_int 0 `Eight)) r 205 206 (* DPM: Non exhaustive pattern as we always check list length is even! *) 207 let rec lift_to_bytes = 178 let 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 195 let 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 202 let process_intel_hex = 203 let rec aux mem = 208 204 function 209 [] > [] 210  hd::hd'::tl > 211 (mk_byte hd hd')::(lift_to_bytes tl) 212 213 let checksum_valid hex_entry = 214 if List.length hex_entry.data_field mod 2 <> 0 then 215 false 216 else 217 let chk_1, chk_2 = hex_entry.data_checksum in 218 let checksum = mk_byte chk_1 chk_2 in 219 let len_1, len_2 = hex_entry.record_length in 220 let ln_total = mk_byte len_1 len_2 in 221 let ty_total = (flip vect_of_int $ `Eight) $ int_of_intel_hex_type hex_entry.record_type in 222 let adr_1, adr_2, adr_3, adr_4 = hex_entry.record_addr in 223 let ad_total1 = mk_byte adr_1 adr_2 in 224 let ad_total2 = mk_byte adr_3 adr_4 in 225 let _, dt_total = add_bytes <*> lift_to_bytes $ hex_entry.data_field in 226 let _, total = add_bytes [ln_total; ad_total1; ad_total2; ty_total; dt_total] in 227 let _,total = half_add (vect_of_int 1 `Eight) $ complement total in 228 checksum = total 229 230 (* DPM: Debug 231 let Some entry = intel_hex_format_of_string ":10002F00EFF88DF0A4FFEDC5F0CEA42EFEEC88F016";; 232 checksum_valid $ List.hd entry;; 233 *) 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 TracChangeset
for help on using the changeset viewer.