Ignore:
Timestamp:
Mar 2, 2011, 3:27:41 PM (9 years ago)
Author:
ayache
Message:

Update of D2.2 from Paris.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/ASM/ASMInterpret.ml

    r486 r619  
    22open Physical;;
    33open ASM;;
    4 open ASMPrinter;;
    54open IntelHex;;
    65open Util;;
     
    5655      (* let _ = prerr_endline <*> string_of_line $ line in *)
    5756      (time + 1),debug_continuation)
    58 
    59 module IntMap = Map.Make(struct type t = int let compare = compare end);;
    60 type costs = CostLabel.t IntMap.t
    61 
     57   
    6258(* no differentiation between internal and external code memory *)
    6359type status =
    6460{
    6561  (* Memory *)
    66   code_memory: WordMap.map;        (* can be reduced *)
     62  code_memory: Physical.WordMap.map;        (* can be reduced *)
    6763  low_internal_ram: Byte7Map.map;
    6864  high_internal_ram: Byte7Map.map;
    69   external_ram: WordMap.map;
     65  external_ram: Physical.WordMap.map;
    7066
    7167  (* Program counter *)
     
    134130  es_running: bool;
    135131
    136   exit_pc: word option;
    137   costs: costs;
     132  exit_addr   : BitVectors.word;
     133  cost_labels : string BitVectors.WordMap.t
    138134}
    139135
     
    225221
    226222let initialize = {
    227   code_memory = WordMap.empty;
     223  code_memory = Physical.WordMap.empty;
    228224  low_internal_ram = Byte7Map.empty;
    229225  high_internal_ram = Byte7Map.empty;
    230   external_ram = WordMap.empty;
     226  external_ram = Physical.WordMap.empty;
    231227 
    232228  pc = zero `Sixteen;
     
    287283  es_running = false;
    288284
    289   costs = IntMap.empty;
    290   exit_pc = None;
     285  exit_addr = BitVectors.zero `Sixteen;
     286  cost_labels = BitVectors.WordMap.empty
    291287}
    292288
     
    387383  let next pc =
    388384    let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
    389     res, WordMap.find pc pmem
     385    res, Physical.WordMap.find pc pmem
    390386  in
    391387  let pc,instr = next pc in
     
    693689       let pc,b2 = next pc in
    694690         `XRL(`U2(`DIRECT b1, `DATA b2)), pc, 2
    695    | _,_ -> assert false
     691   | (true,false,true,false),(false,true,false,true) ->
     692       (* undefined opcode *) assert false
    696693;;
    697694
     
    927924;;
    928925
    929 let fold_lefti f =
    930  let rec aux i acc =
    931   function
    932      [] -> acc
    933    | he::tl -> aux (i+1) (f i acc he) tl
    934  in
    935   aux 0
    936 ;;
    937 
    938 let load_code_memory = fold_lefti (fun i mem v -> WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty
    939 
    940 let load_mem mem exit_pc costs status =
    941   { status with code_memory = mem ;
    942                 exit_pc = exit_pc ;
    943                 costs = costs }
    944 let load l exit_pc costs = load_mem (load_code_memory l) exit_pc costs
    945 
    946 module StringMap = Map.Make(String);;
    947 
     926let load_code_memory = MiscPottier.foldi (fun i mem v -> Physical.WordMap.add (vect_of_int i `Sixteen) v mem) Physical.WordMap.empty
     927
     928let load_mem mem status = { status with code_memory = mem }
     929let load l = load_mem (load_code_memory l)
    948930
    949931let assembly_jump addr_of =
     
    965947   (fun (datalabels,addr) (name,size) ->
    966948     let addr16 = vect_of_int addr `Sixteen in
    967       StringMap.add name addr16 datalabels, addr+size
    968    ) (StringMap.empty,0) p.ASM.preamble
     949      StringTools.Map.add name addr16 datalabels, addr+size
     950   ) (StringTools.Map.empty,0) p.ASM.ppreamble
    969951 in
    970  let pc,labels,costs =
     952 let pc,exit_addr,labels,costs =
    971953  List.fold_left
    972    (fun (pc,labels,costs) i ->
     954   (fun (pc,exit_addr,labels,costs) i ->
    973955     match i with
    974         `Label s -> pc, StringMap.add s pc labels, costs
    975       | `Cost s -> pc, labels, IntMap.add pc s costs
    976       | `Mov (_,_) -> pc, labels, costs
     956        `Label s when s = p.ASM.pexit_label ->
     957          pc, pc, StringTools.Map.add s pc labels, costs
     958      | `Label s ->
     959          pc, exit_addr, StringTools.Map.add s pc labels, costs
     960      | `Cost s -> pc, exit_addr, labels, BitVectors.WordMap.add pc s costs
     961      | `Mov (_,_) -> pc, exit_addr, labels, costs
    977962      | `Jmp _
    978       | `Call _ -> pc + 3, labels, costs  (*CSC: very stupid: always expand to worst opcode *)
     963      | `Call _ ->
     964        (snd (half_add pc (BitVectors.vect_of_int 3 `Sixteen))),
     965        exit_addr, labels, costs
     966      (*CSC: very stupid: always expand to worst opcode *)
    979967      | `WithLabel i ->
    980           let fake_addr _ = `REL (zero `Eight) in
    981           let fake_jump = assembly_jump fake_addr i in
    982           let i',pc',_ = fetch (load_code_memory (assembly1 fake_jump)) (vect_of_int 0 `Sixteen) in
    983            assert (fake_jump = i');
    984            (pc + int_of_vect pc',labels, costs)
     968        let fake_addr _ = `REL (zero `Eight) in
     969        let fake_jump = assembly_jump fake_addr i in
     970        let i',pc',_ = fetch (load_code_memory (assembly1 fake_jump)) (vect_of_int 0 `Sixteen) in
     971        assert (fake_jump = i');
     972        (snd (half_add pc pc'), exit_addr, labels, costs)
    985973      | #instruction as i ->
    986974        let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in
    987975         assert (i = i');
    988          (pc + int_of_vect pc',labels, costs)
    989    ) (0,StringMap.empty,IntMap.empty) p.ASM.code
     976         (snd (half_add pc pc'),exit_addr,labels, costs)
     977   )
     978    (BitVectors.zero `Sixteen,BitVectors.zero `Sixteen,
     979     StringTools.Map.empty, BitVectors.WordMap.empty) p.ASM.pcode
    990980 in
    991   if pc >= 65536 then
    992    raise CodeTooLarge
    993   else
    994       List.flatten (List.map
    995          (function
    996             `Label _
    997           | `Cost _ -> []
    998           | `WithLabel i ->
    999               let addr_of (`Label s) =
    1000                let addr = StringMap.find s labels in
    1001                (* NOT IMPLEMENTED YET; NEEDS SMART ALGORITHM *)
    1002                 assert (addr < 256);
    1003                 `REL (vect_of_int addr `Eight)
    1004               in
    1005                assembly1 (assembly_jump addr_of i)
    1006           | `Mov (`DPTR,s) ->
    1007               let addrr16 = StringMap.find s datalabels in
    1008                assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
    1009           | `Jmp s ->
    1010               let pc_offset = StringMap.find s labels in
    1011                 assembly1 (`LJMP (`ADDR16 (vect_of_int pc_offset `Sixteen)))
    1012           | `Call s ->
    1013               let pc_offset = StringMap.find s labels in
    1014                 assembly1 (`LCALL (`ADDR16 (vect_of_int pc_offset `Sixteen)))
    1015           | #instruction as i -> assembly1 i) p.ASM.code),
    1016     vect_of_int (StringMap.find p.ASM.exit_label labels) `Sixteen,
    1017     costs
     981 let code =
     982  List.flatten (List.map
     983     (function
     984        `Label _
     985      | `Cost _ -> []
     986      | `WithLabel i ->
     987          let addr_of (`Label s) =
     988           let addr = StringTools.Map.find s labels in
     989            (* NOT IMPLEMENTED YET; NEEDS SMART ALGORITHM *)
     990            `REL (assert false) (*addr*)
     991          in
     992           assembly1 (assembly_jump addr_of i)
     993      | `Mov (`DPTR,s) ->
     994          let addrr16 = StringTools.Map.find s datalabels in
     995           assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
     996      | `Jmp s ->
     997          let pc_offset = StringTools.Map.find s labels in
     998            assembly1 (`LJMP (`ADDR16 pc_offset))
     999      | `Call s ->
     1000          let pc_offset = StringTools.Map.find s labels in
     1001            assembly1 (`LCALL (`ADDR16 pc_offset ))
     1002      | #instruction as i -> assembly1 i) p.ASM.pcode) in
     1003 { ASM.code = code ; ASM.cost_labels = costs ;
     1004   ASM.exit_addr = exit_addr ; ASM.has_main = p.ASM.phas_main }
    10181005;;
    10191006
     
    10481035          assert false for now. Try to understand what DEC really does *)
    10491036       let cry,addr = half_add dpr (mk_word (vect_of_int 0 `Eight) status.acc) in
    1050          WordMap.find addr status.external_ram
     1037         Physical.WordMap.find addr status.external_ram
    10511038  | `A_PC ->
    10521039       (* CSC: what is the right behaviour in case of overflow?
    10531040          assert false for now *)
    10541041       let cry,addr = half_add status.pc (mk_word (vect_of_int 0 `Eight) status.acc) in
    1055          WordMap.find addr status.external_ram
     1042         Physical.WordMap.find addr status.external_ram
    10561043  | `EXT_INDIRECT b ->
    10571044         let addr = get_register status (false,false,b) in
    1058            WordMap.find (mk_word (zero `Eight) addr) status.external_ram
     1045           Physical.WordMap.find (mk_word (zero `Eight) addr) status.external_ram
    10591046  | `EXT_IND_DPTR ->
    10601047       let dpr = mk_word status.dph status.dpl in
    1061          WordMap.find dpr status.external_ram
     1048         Physical.WordMap.find dpr status.external_ram
    10621049;;
    10631050
     
    11311118      let dpr = mk_word status.dph status.dpl in
    11321119      { status with external_ram =
    1133           WordMap.add dpr v status.external_ram }
     1120          Physical.WordMap.add dpr v status.external_ram }
    11341121    | `EXT_INDIRECT b ->
    11351122      let addr = get_register status (false,false,b) in
    11361123      { status with external_ram =
    1137           WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
     1124          Physical.WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
    11381125;;
    11391126
     
    17411728        let dptr = mk_word status.dph status.dpl in
    17421729        let cry, addr = half_add dptr big_acc in
    1743         let lookup = WordMap.find addr status.code_memory in
     1730        let lookup = Physical.WordMap.find addr status.code_memory in
    17441731        { status with acc = lookup }
    17451732      | `MOVC (`A, `A_PC) ->
     
    17501737        let status = { status with pc = inc_pc } in
    17511738        let cry,addr = half_add inc_pc big_acc in
    1752         let lookup = WordMap.find addr status.code_memory in
     1739        let lookup = Physical.WordMap.find addr status.code_memory in
    17531740        { status with acc = lookup }
    17541741      (* data transfer *)
     
    18131800          status
    18141801      | `RET ->
    1815         let high_bits = read_at_sp status in
    1816         let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    1817         let status = { status with sp = new_sp } in
    1818         let low_bits = read_at_sp status in
    1819         let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
    1820         let status = { status with sp = new_sp } in
    1821         { status with pc = mk_word high_bits low_bits }
    1822 (*
    18231802        (* DPM: What happens when we underflow? *)
    18241803        let high_bits = read_at_sp status in
     
    18291808        let status = { status with sp = new_sp } in
    18301809        { status with pc = mk_word high_bits low_bits }
    1831 *)
    18321810      | `RETI ->
    18331811        let high_bits = read_at_sp status in
     
    18461824        let status = { status with sp = new_sp } in
    18471825        let status = write_at_sp status pc_upper_byte in
    1848         let n1, n2 = from_byte pc_upper_byte in
    1849         let (b1,b2,b3,_) = from_word11 a in
    1850         let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
    1851         let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
     1826        let addr = addr16_of_addr11 status.pc a in
    18521827        { status with pc = addr }
    18531828      | `LCALL (`ADDR16 addr) ->
     
    18611836        { status with pc = addr }
    18621837      | `AJMP (`ADDR11 a) ->
    1863         let pc_upper_byte, pc_lower_byte = from_word status.pc in
    1864         let n1, n2 = from_byte pc_upper_byte in
    1865         let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
    1866         let (b1,b2,b3,b) = from_word11 a in
    1867         let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
    1868         let cry, new_pc = half_add status.pc addr in
    1869         { status with pc = new_pc }
     1838        let addr = addr16_of_addr11 status.pc a in
     1839        { status with pc = addr }
    18701840      | `LJMP (`ADDR16 a) ->
    18711841        { status with pc = a }
     
    19541924;;
    19551925
    1956 let eq_pc pc1 pc2 =
    1957   let to_int = BitVectors.int_of_vect in
    1958   to_int pc1 = to_int pc2
    1959 
    1960 let end_of_program st = match st.exit_pc with
    1961   | None -> false
    1962   | Some exit_pc -> eq_pc st.pc exit_pc
    1963 
    1964 let print_result st =
    1965   Printf.printf "Result : DPL = %d DPH = %d\n%!"
    1966     (BitVectors.int_of_vect st.dpl) (BitVectors.int_of_vect st.dph)
    1967 
    1968 let print_instr instr =
    1969   Printf.printf "%s\n%!" (ASMPrinter.pp_instruction instr)
     1926
     1927let load_program p =
     1928  let st = load p.ASM.code initialize in
     1929  { st with exit_addr = p.ASM.exit_addr ; cost_labels = p.ASM.cost_labels }
    19701930
    19711931let observe_trace trace_ref st =
    1972   let pc = st.pc in
    1973   let (instr, _, _) = fetch st.code_memory pc in
    1974   let ipc = BitVectors.int_of_vect pc in
    1975   (* <DEBUG> *)
    1976   print_result st ;
    1977   Printf.printf "%d: %!" ipc ;
    1978   print_instr instr ;
    1979   (* </DEBUG> *)
    19801932  let cost_label =
    1981     if IntMap.mem ipc st.costs then [IntMap.find ipc st.costs]
     1933    if BitVectors.WordMap.mem st.pc st.cost_labels then
     1934      [BitVectors.WordMap.find st.pc st.cost_labels]
    19821935    else [] in
    19831936  trace_ref := cost_label @ !trace_ref ;
    1984   if end_of_program st then raise Halt else st
    1985 
    1986 let interpret p =
     1937  if st.pc = st.exit_addr (* <=> end of program *) then raise Halt else st
     1938
     1939let result st =
     1940  let i = BitVectors.int_of_vect st.dpl in
     1941  IntValue.Int8.of_int i
     1942
     1943let interpret print_result p =
    19871944  if p.ASM.has_main then
    1988     let (insts, exit_pc, costs) = assembly p in
    1989     let st = load insts (Some exit_pc) costs initialize in
     1945    let st = load_program p in
    19901946    let trace = ref [] in
    19911947    let callback = observe_trace trace in
    19921948    let st = execute callback st in
    1993     (* <DEBUG> *)
    1994     print_result st ;
    1995     (* </DEBUG> *)
    1996     List.rev !trace
    1997   else []
    1998 
    1999 let parse_and_interpret_hex file =
    2000   let intel_hex = IntelHex.intel_hex_of_file file in
    2001   let physical = IntelHex.process_intel_hex intel_hex in
    2002   let st = load_mem physical None IntMap.empty initialize in
    2003   let callback = observe_trace (ref []) in
    2004   ignore (execute callback st)
     1949    let res = result st in
     1950    if print_result then
     1951      Printf.printf "8051: %s\n%!" (IntValue.Int8.to_string res) ;
     1952    (res, List.rev !trace)
     1953  else (IntValue.Int8.zero, [])
Note: See TracChangeset for help on using the changeset viewer.