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

open BitVectors;;
open ASM;;
open Util;;
open Parser;;

type intel_hex_entry_type =
    Data
  | End
  | ExtendedSeg
  | ExtendedLinear
;;

type intel_hex_entry =
{
  record_length: byte * byte;
  record_addr: byte * byte * byte * byte;
  record_type: intel_hex_entry_type;
  data_field: byte list;
  data_checksum: byte * byte
}
;;

type intel_hex_format = intel_hex_entry list;;

let hex_digit_of_char =
    function
      '0' -> 0 | '1' -> 1 | '2' -> 2
    | '3' -> 3 | '4' -> 4 | '5' -> 5
    | '6' -> 6 | '7' -> 7 | '8' -> 8
    | '9' -> 9 | 'A' -> 10 | 'B' -> 11
    | 'C' -> 12 | 'D' -> 13 | 'E' -> 14
    | 'F' -> 15 | _ -> assert false

let vect_of_hex_string s size =
  let int_of_hex_string h =
    let rec aux l p =
      match l with
        [] -> 0
      | hd::tl ->
          hex_digit_of_char hd * p + aux tl (p * 16)
    in
      aux (List.rev $ char_list_of_string h) 1
  in
    let i_str = int_of_hex_string s in
      vect_of_int i_str size
;;

let hex_string_of_vect v =
  let hex_string_of_int i =
    let digit_lookup =
      function
        0 -> "0" | 1 -> "1" | 2 -> "2"
      | 3 -> "3" | 4 -> "4" | 5 -> "5"
      | 6 -> "6" | 7 -> "7" | 8 -> "8"
      | 9 -> "9" | 10 -> "A" | 11 -> "B"
      | 12 -> "C" | 13 -> "D" | 14 -> "E"
      | 15 -> "F" | _ -> assert false in

    let rec aux i =
      if i < 16 then
        digit_lookup i
      else
        let div = i / 16 in
        let rem = i mod 16 in
           aux div ^ digit_lookup rem
    in
      aux i
  in
    let vect_int = int_of_vect v in
      hex_string_of_int vect_int
;;

let intel_hex_entry_type_of_int =
  function
    0 -> Data
  | 1 -> End
  | 2 -> ExtendedSeg
  | 4 -> ExtendedLinear
  | _ -> assert false
;;

let prs_length =
         prs_hex_digit >>=
fun a -> prs_hex_digit >>=
fun b -> return (vect_of_hex_string (String.make 1 a) `Eight,
                 vect_of_hex_string (String.make 1 b) `Eight)
;;

let prs_addr =
         prs_hex_digit >>= 
fun a -> prs_hex_digit >>=
fun b -> prs_hex_digit >>=
fun c -> prs_hex_digit >>=
fun d -> return $ (vect_of_hex_string (String.make 1 a) `Eight,
                   vect_of_hex_string (String.make 1 b) `Eight,
                   vect_of_hex_string (String.make 1 c) `Eight,
                   vect_of_hex_string (String.make 1 d) `Eight)
;;

let prs_type =
         prs_hex_digit >>=
fun a -> prs_hex_digit >>=
fun b ->
  let a_as_hex = hex_digit_of_char a in
  let b_as_hex = hex_digit_of_char b in
  let total = a_as_hex + b_as_hex in
    return $ intel_hex_entry_type_of_int total

let prs_data len =
         prs_exact len $ prs_hex_digit >>=
fun a ->
  let a_as_strs = List.map (String.make 1) a in
  let byte_data = List.map (fun x -> vect_of_hex_string x `Eight) a_as_strs in
    return $ byte_data
;;

let prs_checksum =
         prs_hex_digit >>=
fun a -> prs_hex_digit >>=
fun b -> return (vect_of_hex_string (String.make 1 a) `Eight,
                 vect_of_hex_string (String.make 1 b) `Eight)
;;

let prs_intel_hex_record =
         prs_char ':'  >>=
fun a -> prs_length    >>=
fun b -> prs_addr      >>=
fun c -> prs_type      >>=
fun d ->
  let (l_u_b, l_l_b) = b in
  let len = int_of_vect (mk_word l_u_b l_l_b) in
    prs_data len       >>=
fun e -> prs_checksum  >>=
fun f ->
  return $ {
    record_length = b;
    record_addr = c;
    record_type = d;
    data_field = e;
    data_checksum = f
  }
;;

let prs_intel_hex_format =
  prs_sep_by prs_intel_hex_record (prs_char '\n')
;;

let intel_hex_format_of_string s =
  let chars = char_list_of_string s in
    match prs_intel_hex_format chars with
      [] -> None
    | (prs,_)::_ -> Some prs

let string_of_intel_hex_entry entry =
  let record_length_l, record_length_r = entry.record_length in
  let record_addr_1, record_addr_2, record_addr_3, record_addr_4 = entry.record_addr in
  let data_checksum_l, data_checksum_r = entry.data_checksum in
  let length_string = hex_string_of_vect record_length_l ^ 
                      hex_string_of_vect record_length_l in
  let addr_string = hex_string_of_vect record_addr_1 ^
                    hex_string_of_vect record_addr_2 ^
                    hex_string_of_vect record_addr_3 ^
                    hex_string_of_vect record_addr_4 in
  let checksum_string = hex_string_of_vect data_checksum_l ^ 
                        hex_string_of_vect data_checksum_r in
  let type_string =
    match entry.record_type with
      Data -> "00"
    | End -> "01"
    | ExtendedSeg -> "02"
    | ExtendedLinear -> "04" in
  let data_string = String.concat "" (List.map hex_string_of_vect entry.data_field) in
    ":" ^ length_string ^ addr_string ^ type_string ^ data_string ^ checksum_string
;;

let string_of_intel_hex_format f =
  let strs = List.map string_of_intel_hex_entry f in
  let rec aux =
    function
      [] -> ""
    | [e] -> e
    | hd::tl -> hd ^ "\n" ^ aux tl
  in
    aux strs