Ignore:
Timestamp:
Sep 29, 2010, 12:25:28 PM (9 years ago)
Author:
sacerdot
Message:

Several bug fixes and code clean-up.
New main file: test.ml to parse and execute an HEX file.
Usage: ./test.native foo.hex

File:
1 edited

Legend:

Unmodified
Added
Removed

  • Deliverables/D4.1/IntelHex.ml

    r137 r138  
    33open Util;;
    44open Parser;;
     5
     6exception WrongFormat of string
    57
    68type intel_hex_entry_type =
    … …  
    1315type intel_hex_entry =
    1416{
    15   record_length: nibble * nibble;
    16   record_addr: nibble * nibble * nibble * nibble;
     17  record_length: byte;
     18  record_addr: word;
    1719  record_type: intel_hex_entry_type;
    18   data_field: nibble list;
    19   data_checksum: nibble * nibble
     20  data_field: byte list;
     21  data_checksum: byte
    2022}
    2123;;
    … …  
    3234    | 'F' -> 15 | _ -> assert false
    3335
     36(* CSC: tipare piu' strettamente: prendere la taglia del vettore in input
     37   come taglia della stringa *)
    3438let vect_of_hex_string s size =
    3539  let int_of_hex_string h =
    … …  
    4650;;
    4751
    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 ;;
     52let hex_string_of_vect v = Printf.sprintf "%0 2X" (int_of_vect v);;
    7253
    7354let intel_hex_entry_type_of_int =
    … …  
    8061;;
    8162
    82 let int_of_intel_hex_type =
    83   function
     63let int_of_intel_hex_entry_type =
     64 function
    8465    Data -> 0
    8566  | End -> 1
    … …  
    8869;;
    8970
    90 let prs_length =
    91          prs_hex_digit >>=
     71let prs_byte =
     72         prs_hex_digit >>= 
    9273fun 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 =
     74fun b -> return $ vect_of_hex_string (String.make 1 a ^ String.make 1 b) `Eight
     75;;
     76
     77let prs_word =
    9878         prs_hex_digit >>=
    9979fun a -> prs_hex_digit >>=
    10080fun b -> prs_hex_digit >>=
    10181fun 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 ;;
     82fun 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
     85let prs_length = prs_byte;;
     86let prs_data len = prs_exact len prs_byte
     87let prs_checksum = prs_byte;;
     88let prs_addr = prs_word;;
    10789
    10890let prs_type =
    … …  
    11597    return $ intel_hex_entry_type_of_int total
    11698
    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 ;;
     99let 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
     109let 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
    131116
    132117let prs_intel_hex_record =
    133118         prs_char ':'  >>=
    134 fun a -> prs_length    >>=
     119fun _ -> prs_length    >>=
    135120fun b -> prs_addr      >>=
    136121fun c -> prs_type      >>=
    137122fun 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       >>=
    141125fun e -> prs_checksum  >>=
    142 fun f ->
    143   return $ {
    144     record_length = b;
     126fun f -> prs_eof       >>=
     127fun _ ->
     128 let entry =
     129  { record_length = b;
    145130    record_addr = c;
    146131    record_type = d;
    147132    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
    150139;;
    151140
    … …  
    164153        long, and all addr strings should be four.                            *)
    165154let 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
    176158  let type_string =
    177159    match entry.record_type with
    … …  
    194176    aux strs
    195177
    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 =
     178let 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
     195let 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
     202let process_intel_hex =
     203 let rec aux mem =
    208204  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.