Changeset 138 for Deliverables/D4.1


Ignore:
Timestamp:
Sep 29, 2010, 12:25:28 PM (10 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

Location:
Deliverables/D4.1
Files:
2 added
10 edited

Legend:

Unmodified
Added
Removed

  • Deliverables/D4.1/ASMInterpret.ml

    r130 r138  
    1313type line = [`P0 | `P1 ];; (* ??? *)
    1414type continuation =
    15  time ->
    16    [`In of line * byte * continuation
    17    |`Out of (line -> byte -> continuation) ]
     15unit (*
     16 [`In of time * line * byte * continuation] option *
     17 [`Out of (time -> line -> byte -> continuation) ]
     18*)
    1819
    1920(* no differentiation between internal and external code memory *)
    … …  
    9091  timer2 = zero `Sixteen;
    9192
    92   io = (fun _ -> assert false)
     93  io = ()
    9394}
    9495
    … …  
    114115let fetch pmem pc =
    115116 let next pc =
    116    let (carry, res) = half_add pc (vect_of_int 1 `Sixteen) in
     117   let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
    117118     res, WordMap.find pc pmem
    118119 in
    119  let instr = WordMap.find pc pmem in
    120  let cy, pc = half_add pc (vect_of_int 1 `Sixteen) in
    121  let (un, ln) = from_byte instr in
     120 let pc,instr = next pc in
     121 let un, ln = from_byte instr in
    122122 let bits = (from_nibble un, from_nibble ln) in
    123123  match bits with
    … …  
    667667let load_code_memory = fold_lefti (fun i mem v -> WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty
    668668
    669 let load l status = { status with code_memory = load_code_memory l }
     669let load_mem mem status = { status with code_memory = mem }
     670let load l = load_mem (load_code_memory l)
    670671
    671672module StringMap = Map.Make(String);;
     673module IntMap = Map.Make(struct type t = int let compare = compare end);;
    672674
    673675let assembly l =
    … …  
    677679     match i with
    678680        `Label s -> pc, StringMap.add s pc labels, costs
    679       | `Cost s -> pc, labels, StringMap.add s pc costs
    680       | `Jmp s
    681       | `Call s -> pc + 3, labels, costs  (*CSC: very stupid: always expand to worst opcode *)
     681      | `Cost s -> pc, labels, IntMap.add pc s costs
     682      | `Jmp _
     683      | `Call _ -> pc + 3, labels, costs  (*CSC: very stupid: always expand to worst opcode *)
    682684      | #instruction as i ->
    683685        let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in
    684686         assert (i = i');
    685687         (pc + int_of_vect pc',labels, costs)
    686    ) (0,StringMap.empty,StringMap.empty) l
     688   ) (0,StringMap.empty,IntMap.empty) l
    687689 in
    688690  if pc >= 65536 then
    … …  
    691693      List.flatten (List.map
    692694         (function
    693             `Label s -> []
    694           | `Cost s -> []
     695            `Label _
     696          | `Cost _ -> []
    695697          | `Jmp s ->
    696698              let pc_offset = StringMap.find s labels in
    … …  
    699701              let pc_offset = StringMap.find s labels in
    700702                assembly1 (`LCALL (`ADDR16 (vect_of_int pc_offset `Sixteen)))
    701           | #instruction as i -> assembly1 i) l)
     703          | #instruction as i -> assembly1 i) l), costs
    702704;;
    703705
    704706let get_address_of_register status (b1,b2,b3) =
    705  let bu,bl = from_byte status.psw in
     707 let bu,_bl = from_byte status.psw in
    706708 let (_,_,rs1,rs0) = from_nibble bu in
    707709 let base =
    … …  
    763765;;
    764766
    765 let get_arg_16 status =
    766   function
    767                 `DATA16 w -> w
     767let get_arg_16 _status = function `DATA16 w -> w
    768768
    769769let get_arg_1 status =
    … …  
    820820           (*CSC: SFR access, TO BE IMPLEMENTED *)
    821821           (* assert false for now. Try to understand what DEC really does *)
    822            assert false)
     822prerr_endline ("!!! SFR USED !!!");
     823           status (*assert false*))
    823824  | `INDIRECT b ->
    824825     let (b1, b2) = from_byte (get_register status (false,false,b)) in
    … …  
    956957   | `CLR `A -> set_arg_8 status (zero `Eight) `A
    957958   | `CLR `C -> set_arg_1 status false `C
    958    | `CLR ((`BIT b) as a) -> set_arg_1 status false a
     959   | `CLR ((`BIT _) as a) -> set_arg_1 status false a
    959960   | `CPL `A -> { status with acc = complement status.acc }
    960961   | `CPL `C -> set_arg_1 status (not $ get_arg_1 status `C) `C
    … …  
    10901091       let status = { status with low_internal_ram = lower_mem } in
    10911092       let n1, n2 = from_byte pc_upper_byte in
    1092        let (b1,b2,b3,b) = from_word11 a in
     1093       let (b1,b2,b3,_) = from_word11 a in
    10931094       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
    10941095       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
    … …  
    11691170
    11701171let rec execute f s =
    1171  let s = execute1 s in
    11721172 let cont =
    11731173  try f s; true
    11741174  with Halt -> false
    11751175 in
    1176   if cont then execute f s
     1176  if cont then execute f (execute1 s)
    11771177  else s
    11781178;;

  • Deliverables/D4.1/ASMInterpret.mli

    r101 r138  
     1open BitVectors;;
     2open Physical;;
     3
    14exception CodeTooLarge
    25
    3 type status
     6type time = int;;
     7type line = [`P0 | `P1 ];; (* ??? *)
     8type continuation =
     9unit (*
     10 [`In of time * line * byte * continuation] option *
     11 [`Out of (time -> line -> byte -> continuation) ]
     12*)
    413
    5 val assembly: ASM.labelled_instruction list -> BitVectors.byte list
     14type status = private
     15 { code_memory: WordMap.map;        (* can be reduced *)
     16   low_internal_ram: Byte7Map.map;
     17   high_internal_ram: Byte7Map.map;
     18   external_ram: WordMap.map;
     19
     20   pc: word;
     21
     22   (* sfr *)
     23   p0: byte;
     24   sp: byte;
     25   dpl: byte;
     26   dph: byte;
     27   pcon: byte;
     28   tcon: byte;
     29   tmod: byte;
     30   tl0: byte;
     31   tl1: byte;
     32   th0: byte;
     33   th1: byte;
     34   p1: byte;
     35   scon: byte;
     36   sbuf: byte;
     37   p2: byte;
     38   ie: byte;
     39   p3: byte;
     40   ip: byte;
     41   psw: byte;
     42   acc: byte;
     43   b: byte;
     44
     45   clock: time;
     46   timer0: word;
     47   timer1: word;
     48   timer2: word;  (* can be missing *)
     49   io: continuation
     50 }
     51
     52module IntMap: Map.S with type key = int
     53
     54val assembly:
     55 ASM.labelled_instruction list -> BitVectors.byte list (*ASM.instruction list * symbol_table *) * string IntMap.t
     56
     57(*
     58val link:
     59 (ASM.instruction list * symbol_table * cost_map) list -> BitVectors.byte list
     60*)
    661
    762val initialize: status
    863
     64val load_mem: Physical.WordMap.map -> status -> status
    965val load: BitVectors.byte list -> status -> status
    1066
    … …  
    1571   the processor never halts. *)
    1672val execute: (status -> unit) -> status -> status
     73
     74val fetch: Physical.WordMap.map -> word -> ASM.instruction * word * int

  • Deliverables/D4.1/BitVectors.ml

    r137 r138  
    101101    aux 1 (List.rev v)
    102102
    103 let string_of_vect v =
    104  String.concat "" (List.map (function false -> "0" | _ -> "1") v)
    105 
    106103let size_lookup =
    107104  function
    … …  
    132129        true :: aux d
    133130
     131let rec pad i l = if i = 0 then l else false :: (pad (i - 1) l)
     132
    134133let vect_of_int i size =
    135134  let big_list = List.rev (aux i) in
    136     if List.length big_list > (size_lookup size) then
     135    if List.length big_list > size_lookup size then
    137136      raise (Invalid_argument "Size not big enough")
    138137    else
    139       let diff = (size_lookup size) - (List.length big_list) in
    140         pad false diff big_list
     138      let diff = size_lookup size - List.length big_list in
     139        pad diff big_list
    141140   
    142 let zero size = pad false (size_lookup size) []
     141let zero size = pad (size_lookup size) []

  • 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;;

  • Deliverables/D4.1/IntelHex.mli

    r133 r138  
    1212type intel_hex_entry =
    1313{
    14   record_length: nibble * nibble;
    15   record_addr: nibble * nibble * nibble * nibble;
     14  record_length: byte;
     15  record_addr: word;
    1616  record_type: intel_hex_entry_type;
    17   data_field: nibble list;
    18   data_checksum: nibble * nibble
    19 };;
     17  data_field: byte list;
     18  data_checksum: byte
     19}
     20;;
    2021
    2122type intel_hex_format = intel_hex_entry list;;
    … …  
    2728val hex_string_of_vect: 'a vect -> string;;
    2829
     30exception WrongFormat of string
     31
     32val intel_hex_of_file: string -> intel_hex_format
     33val process_intel_hex: intel_hex_format -> Physical.WordMap.map
     34
    2935val checksum_valid: intel_hex_entry -> bool;;

  • Deliverables/D4.1/Makefile

    r28 r138  
    11all:
    2         ocamlbuild ASMInterpret.native
     2        ocamlbuild -cflags "-w Ae" test.native
    33
    44.PHONY: all

  • Deliverables/D4.1/Parser.ml

    r130 r138  
    22open BitVectors;;
    33open ASM;;
     4
     5let chars_of_string s =
     6 let len = String.length s in
     7 let rec aux n =
     8  if n < len then
     9   s.[n] :: aux (n + 1)
     10  else
     11   []
     12 in
     13  aux 0
     14;;
    415
    516type 'a parser = char list -> ('a * char list) list
    … …  
    1324      List.concat $ List.map (fun (a, x') -> (g a) x') frst
    1425
    15 let prs_zero = fun x -> []
     26let prs_zero = fun _ -> []
    1627;;
     28
     29let prs_eof = function [] -> [(),[]] | _ -> [];;
    1730
    1831let prs_predicate p =
    … …  
    3548    match (f ++ g) x with
    3649      [] -> []
    37     | hd::tl -> [hd]
     50    | hd::_ -> [hd]
    3851;;
    3952

  • Deliverables/D4.1/Parser.mli

    r130 r138  
     1val chars_of_string: string -> char list
     2
    13type 'a parser = char list -> ('a * char list) list
    24
    … …  
    46val (>>=): 'a parser -> ('a -> 'b parser) -> 'b parser
    57val prs_zero: 'a parser
     8val prs_eof: unit parser
    69val prs_predicate: (char -> bool) -> char parser;;
    710val prs_many1: 'a parser -> ('a list) parser;;

  • Deliverables/D4.1/Pretty.ml

    r122 r138  
    224224  | `XRL(`U2(`DIRECT b1, `DATA b2)) ->
    225225  "XRL direct #data (" ^ string_of_vect b2 ^ ")"
    226   | _ -> "BUG: Unimplemented!"

  • Deliverables/D4.1/Pretty.mli

    r122 r138  
    1 val pp_instruction: ASM.labelled_instruction -> string
     1val pp_instruction: [< ASM.labelled_instruction] -> string
Note: See TracChangeset for help on using the changeset viewer.