src/ASM/IntelHex.ml

   1 open BitVectors;;
   2 open ASM;;
   3 open Util;;
   4 open Parser;;
   5 open Printf;;
   6
   7 exception WrongFormat of string
   8
   9 type intel_hex_entry_type =
  10     Data
  11   | End
  12   | ExtendedSeg
  13   | ExtendedLinear
  14 ;;
  15
  16 type intel_hex_entry =
  17 {
  18   record_length: byte;
  19   record_addr: word;
  20   record_type: intel_hex_entry_type;
  21   data_field: byte list;
  22   data_checksum: byte
  23 }
  24 ;;
  25
  26 type intel_hex_format = intel_hex_entry list;;
  27
  28 let hex_digit_of_char =
  29     function
  30       '0' -> 0 | '1' -> 1 | '2' -> 2
  31     | '3' -> 3 | '4' -> 4 | '5' -> 5
  32     | '6' -> 6 | '7' -> 7 | '8' -> 8
  33     | '9' -> 9 | 'A' -> 10 | 'B' -> 11
  34     | 'C' -> 12 | 'D' -> 13 | 'E' -> 14
  35     | 'F' -> 15 | 'a' -> 10 | 'b' -> 11
  36     | 'c' -> 12 | 'd' -> 13 | 'e' -> 14
  37     | 'f' -> 15 | _ -> assert false
  38
  39 let intel_hex_entry_type_of_int =
  40   function
  41     0 -> Data
  42   | 1 -> End
  43   | 2 -> ExtendedSeg
  44   | 4 -> ExtendedLinear
  45   | _ -> assert false
  46 ;;
  47
  48 let int_of_intel_hex_entry_type =
  49  function
  50     Data -> 0
  51   | End -> 1
  52   | ExtendedSeg -> 2
  53   | ExtendedLinear -> 4
  54 ;;
  55
  56 let prs_nibble =
  57          prs_hex_digit >>=
  58 fun a -> return $ vect_of_int (hex_digit_of_char a) `Four
  59 ;;
  60
  61 let prs_byte =
  62          prs_nibble >>=
  63 fun a -> prs_nibble >>=
  64 fun b -> return $ mk_byte a b
  65 ;;
  66
  67 let prs_word =
  68          prs_byte >>=
  69 fun a -> prs_byte >>=
  70 fun b -> return $ mk_word a b
  71 ;;
  72
  73 let prs_length = prs_byte;;
  74 let prs_data len = prs_exact len prs_byte
  75 let prs_checksum = prs_byte;;
  76 let prs_addr = prs_word;;
  77
  78 let prs_type =
  79          prs_hex_digit >>=
  80 fun a -> prs_hex_digit >>=
  81 fun b ->
  82   let a_as_hex = hex_digit_of_char a in
  83   let b_as_hex = hex_digit_of_char b in
  84 (*CSC: is next line correct??? *)
  85   let total = a_as_hex + b_as_hex in
  86     return $ intel_hex_entry_type_of_int total
  87
  88 let add_bytes v  =
  89   let r = List.rev v in
  90   let rec aux (cry, bs) =
  91     function
  92       [] -> (cry, bs)
  93     | hd::tl ->
  94         aux (half_add hd bs) tl
  95   in
  96     aux (false, (vect_of_int 0 `Eight)) r
  97
  98 let calculate_checksum hex_entry =
  99  let ty = (flip vect_of_int $ `Eight) $ int_of_intel_hex_entry_type hex_entry.record_type in
 100  let addr1,addr2 = from_word hex_entry.record_addr in
 101  let _, total = add_bytes (hex_entry.record_length :: addr1 :: addr2 :: ty :: hex_entry.data_field) in
 102  let _,total = half_add (vect_of_int 1 `Eight) $ complement total in
 103   total
 104
 105 let checksum_valid hex_entry =
 106   let total = calculate_checksum hex_entry in
 107     hex_entry.data_checksum = total
 108
 109 let prs_intel_hex_record =
 110          prs_char ':'  >>=
 111 fun _ -> prs_length    >>=
 112 fun b -> prs_addr      >>=
 113 fun c -> prs_type      >>=
 114 fun d -> prs_data (int_of_vect b) >>=
 115 fun e -> prs_checksum  >>=
 116 fun f -> prs_eof       >>=
 117 fun _ ->
 118  let entry =
 119   { record_length = b;
 120     record_addr = c;
 121     record_type = d;
 122     data_field = e;
 123     data_checksum = f }
 124  in
 125   if checksum_valid entry then
 126    return entry
 127   else
 128    prs_zero
 129 ;;
 130
 131 let prs_intel_hex_format =
 132   prs_sep_by prs_intel_hex_record (prs_char '\n')
 133 ;;
 134
 135 let intel_hex_format_of_string s =
 136   let chars = char_list_of_string s in
 137     match prs_intel_hex_format chars with
 138       [] -> None
 139     | (prs,_)::_ -> Some prs
 140
 141 let string_of_intel_hex_entry entry =
 142   let b = Buffer.create 655536 in
 143   let length_string = hex_string_of_vect entry.record_length in
 144   let addr_string = Printf.sprintf "%04X" (int_of_vect entry.record_addr) in
 145   let checksum_string = Printf.sprintf "%02X" (int_of_vect entry.data_checksum) in
 146   let type_string = Printf.sprintf "%02d" (int_of_intel_hex_entry_type entry.record_type) in
 147   List.iter (Buffer.add_string b)
 148     [
 149       ":"; length_string; addr_string; type_string
 150     ];
 151   List.iter (fun e -> Buffer.add_string b (hex_string_of_vect e)) entry.data_field;
 152   Buffer.add_string b checksum_string;
 153   Buffer.contents b
 154 ;;
 155
 156 let string_of_intel_hex_format f =
 157   let strs = List.map string_of_intel_hex_entry f in
 158   let rec aux =
 159     function
 160       [] -> ""
 161     | [e] -> e
 162     | hd::tl -> hd ^ "\n" ^ aux tl
 163   in
 164     aux strs
 165
 166 let intel_hex_of_file path =
 167  let fd = open_in path in
 168  let rec aux () =
 169   match try Some (input_line fd) with End_of_file -> None with
 170      None -> []
 171    | Some txt ->
 172       let read = prs_intel_hex_record (Parser.chars_of_string txt) in
 173       let read =
 174        match read with
 175           [x,[]] -> x
 176         | _ -> raise (WrongFormat txt)
 177       in
 178        read::aux ()
 179  in
 180   aux ()
 181 ;;
 182
 183 let rec load_from mem addr =
 184  function
 185     [] -> mem
 186   | he::tl ->
 187      load_from (Physical.WordMap.add addr he mem) (snd (BitVectors.half_add addr (BitVectors.vect_of_int 1 `Sixteen))) tl
 188 ;;
 189
 190 let process_intel_hex =
 191  let rec aux mem =
 192   function
 193      [] -> assert false
 194    | he::tl ->
 195       match he.record_type with
 196          End -> assert (tl = []); mem
 197        | Data -> aux (load_from mem he.record_addr he.data_field) tl
 198        | _ -> assert false
 199  in
 200   aux Physical.WordMap.empty
 201 ;;
 202
 203 (* DPM: this needs some comment:
 204      We aim to extract code memory into segmented lists of bytes, with a maximum
 205      length (chunk_size).  The code memory map has a fixed size (max_addressable)
 206      on the 8051.  Further, the chunks we extract get segmented when we find an
 207      unitialized zone in the code memory.
 208 *)
 209 let export_code_memory chunk_size max_addressable code_mem =
 210   let rec aux chunk address start_address rbuff lbuff =
 211     if address = max_addressable then
 212       (start_address, List.rev rbuff)::lbuff
 213     else if chunk = 0 then
 214       aux chunk_size address address [] ((start_address, List.rev rbuff)::lbuff)
 215     else
 216       let code = Physical.WordMap.find (vect_of_int address `Sixteen) code_mem in
 217         aux (chunk - 1) (address + 1) start_address (code::rbuff) lbuff
 218   in
 219     List.rev (aux chunk_size 0 0 [] [])
 220 ;;
 221
 222 let clean_exported_code_memory = List.filter (fun x -> snd x <> [])
 223 ;;
 224
 225 let calculate_data_checksum (record_length, record_addr, record_type, data_field) =
 226   let ty = (flip vect_of_int $ `Eight) $ int_of_intel_hex_entry_type record_type in
 227   let addr1,addr2 = from_word record_addr in
 228   let _, total = add_bytes (record_length :: addr1 :: addr2 :: ty :: data_field) in
 229   let _,total = half_add (vect_of_int 0 `Eight) $ complement total in
 230     total
 231 ;;
 232
 233 let process_exported_code_memory =
 234   List.map (fun x ->
 235     let record_length = vect_of_int (List.length (snd x)) `Eight in
 236     let record_addr = vect_of_int (fst x) `Sixteen in
 237     let record_type = Data in
 238     let data_field = snd x in
 239     let temp_record =
 240       { record_length = record_length;
 241         record_addr = record_addr;
 242         record_type = record_type;
 243         data_field = data_field;
 244         data_checksum = zero `Eight
 245       } in
 246     { temp_record with data_checksum = calculate_checksum temp_record })
 247 ;;
 248
 249 let rec zeros len =
 250   if len = 0 then
 251     []
 252   else
 253     vect_of_int 0 `Eight :: zeros (len - 1)
 254
 255 let post_process_exported_code_memory intel_hex =
 256   let reversed = List.rev intel_hex in
 257   let rec aux hex =
 258     match hex with
 259       [] -> []
 260     | he::tl ->
 261         if he.record_type = End then
 262           aux tl
 263         else if he.record_type = Data then
 264           if he.data_field = zeros (int_of_vect he.record_length) then
 265             aux tl
 266           else
 267             he::(aux tl)
 268         else
 269           tl
 270   in
 271     List.rev (aux reversed)
 272
 273 let pack_exported_code_memory chunk_size max_addressable code_mem =
 274   let export = export_code_memory chunk_size max_addressable code_mem in
 275   let cleaned = clean_exported_code_memory export in
 276   let processed = process_exported_code_memory cleaned in
 277   let postprocessed = post_process_exported_code_memory processed in
 278   let end_buffer =
 279     [{ record_length = zero `Eight;
 280       record_addr = zero `Sixteen;
 281       record_type = End;
 282       data_field = [];
 283       data_checksum = vect_of_int 255 `Eight
 284     }] in
 285     postprocessed @ end_buffer
 286 ;;
 287
 288 let file_of_intel_hex path fmt =
 289   let str_fmt = string_of_intel_hex_format fmt in
 290   let channel = open_out path in
 291     fprintf channel "%s\n" str_fmt;
 292     close_out channel
 293 ;;