Ignore:
Timestamp:
Jan 18, 2011, 7:23:28 PM (9 years ago)
Author:
sacerdot
Message:

CSC + Nicolas + Dominic:

1) back-porting of changes by Nicolas from the compiler
2) new file ASMCosts to compute the cost of labels
3) several changes here and there to implement 2)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D4.1/ASMInterpret.ml

    r444 r454  
    6161{
    6262  (* Memory *)
    63   code_memory: WordMap.map;        (* can be reduced *)
     63  code_memory: Physical.WordMap.map;        (* can be reduced *)
    6464  low_internal_ram: Byte7Map.map;
    6565  high_internal_ram: Byte7Map.map;
    66   external_ram: WordMap.map;
     66  external_ram: Physical.WordMap.map;
    6767
    6868  (* Program counter *)
     
    219219
    220220let initialize = {
    221   code_memory = WordMap.empty;
     221  code_memory = Physical.WordMap.empty;
    222222  low_internal_ram = Byte7Map.empty;
    223223  high_internal_ram = Byte7Map.empty;
    224   external_ram = WordMap.empty;
     224  external_ram = Physical.WordMap.empty;
    225225 
    226226  pc = zero `Sixteen;
     
    378378  let next pc =
    379379    let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
    380     res, WordMap.find pc pmem
     380    res, Physical.WordMap.find pc pmem
    381381  in
    382382  let pc,instr = next pc in
     
    918918;;
    919919
    920 let fold_lefti f =
    921  let rec aux i acc =
    922   function
    923      [] -> acc
    924    | he::tl -> aux (i+1) (f i acc he) tl
    925  in
    926   aux 0
    927 ;;
    928 
    929 let load_code_memory = fold_lefti (fun i mem v -> WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty
     920let load_code_memory = Util.fold_lefti (fun i mem v -> Physical.WordMap.add (vect_of_int i `Sixteen) v mem) Physical.WordMap.empty
    930921
    931922let load_mem mem status = { status with code_memory = mem }
     
    933924
    934925module StringMap = Map.Make(String);;
    935 module IntMap = Map.Make(struct type t = int let compare = compare end);;
    936 
     926module WordMap = Map.Make(struct type t = BitVectors.word let compare = compare end);;
     927
     928type labelled_memory = BitVectors.byte list * string WordMap.t * bool (* has main *)
    937929
    938930let assembly_jump addr_of =
     
    949941;;
    950942
    951 let assembly (preamble,l) =
     943let half_add_with_overflow = assert false;;
     944
     945let assembly p =
    952946 let datalabels,_ =
    953947  List.fold_left
     
    955949     let addr16 = vect_of_int addr `Sixteen in
    956950      StringMap.add name addr16 datalabels, addr+size
    957    ) (StringMap.empty,0) preamble
     951   ) (StringMap.empty,0) p.ASM.preamble
    958952 in
    959953 let pc,labels,costs =
     
    962956     match i with
    963957        `Label s -> pc, StringMap.add s pc labels, costs
    964       | `Cost s -> pc, labels, IntMap.add pc s costs
     958      | `Cost s -> pc, labels, WordMap.add pc s costs
    965959      | `Mov (_,_) -> pc, labels, costs
    966960      | `Jmp _
    967       | `Call _ -> pc + 3, labels, costs  (*CSC: very stupid: always expand to worst opcode *)
     961      | `Call _ -> (snd (half_add_with_overflow pc (BitVectors.vect_of_int 3 `Sixteen))), labels, costs  (*CSC: very stupid: always expand to worst opcode *)
    968962      | `WithLabel i ->
    969963          let fake_addr _ = `REL (zero `Eight) in
     
    971965          let i',pc',_ = fetch (load_code_memory (assembly1 fake_jump)) (vect_of_int 0 `Sixteen) in
    972966           assert (fake_jump = i');
    973            (pc + int_of_vect pc',labels, costs)
     967           (snd (half_add_with_overflow pc pc'),labels, costs)
    974968      | #instruction as i ->
    975969        let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in
    976970         assert (i = i');
    977          (pc + int_of_vect pc',labels, costs)
    978    ) (0,StringMap.empty,IntMap.empty) l
     971         (snd (half_add_with_overflow pc pc'),labels, costs)
     972   ) (BitVectors.zero `Sixteen,StringMap.empty,WordMap.empty) p.ASM.code
    979973 in
    980   if pc >= 65536 then
    981    raise CodeTooLarge
    982   else
    983       List.flatten (List.map
    984          (function
    985             `Label _
    986           | `Cost _ -> []
    987           | `WithLabel i ->
    988               let addr_of (`Label s) =
    989                let addr = StringMap.find s labels in
    990                (* NOT IMPLEMENTED YET; NEEDS SMART ALGORITHM *)
    991                 assert (addr < 256);
    992                 `REL (vect_of_int addr `Eight)
    993               in
    994                assembly1 (assembly_jump addr_of i)
    995           | `Mov (`DPTR,s) ->
    996               let addrr16 = StringMap.find s datalabels in
    997                assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
    998           | `Jmp s ->
    999               let pc_offset = StringMap.find s labels in
    1000                 assembly1 (`LJMP (`ADDR16 (vect_of_int pc_offset `Sixteen)))
    1001           | `Call s ->
    1002               let pc_offset = StringMap.find s labels in
    1003                 assembly1 (`LCALL (`ADDR16 (vect_of_int pc_offset `Sixteen)))
    1004           | #instruction as i -> assembly1 i) l), costs
     974  List.flatten (List.map
     975     (function
     976        `Label _
     977      | `Cost _ -> []
     978      | `WithLabel i ->
     979          let addr_of (`Label s) =
     980           let addr = StringMap.find s labels in
     981            (* NOT IMPLEMENTED YET; NEEDS SMART ALGORITHM *)
     982            `REL (assert false) (*addr*)
     983          in
     984           assembly1 (assembly_jump addr_of i)
     985      | `Mov (`DPTR,s) ->
     986          let addrr16 = StringMap.find s datalabels in
     987           assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
     988      | `Jmp s ->
     989          let pc_offset = StringMap.find s labels in
     990            assembly1 (`LJMP (`ADDR16 pc_offset))
     991      | `Call s ->
     992          let pc_offset = StringMap.find s labels in
     993            assembly1 (`LCALL (`ADDR16 pc_offset ))
     994      | #instruction as i -> assembly1 i) p.ASM.code), costs, p.ASM.has_main
    1005995;;
    1006996
     
    10351025          assert false for now. Try to understand what DEC really does *)
    10361026       let cry,addr = half_add dpr (mk_word (vect_of_int 0 `Eight) status.acc) in
    1037          WordMap.find addr status.external_ram
     1027         Physical.WordMap.find addr status.external_ram
    10381028  | `A_PC ->
    10391029       (* CSC: what is the right behaviour in case of overflow?
    10401030          assert false for now *)
    10411031       let cry,addr = half_add status.pc (mk_word (vect_of_int 0 `Eight) status.acc) in
    1042          WordMap.find addr status.external_ram
     1032         Physical.WordMap.find addr status.external_ram
    10431033  | `EXT_INDIRECT b ->
    10441034         let addr = get_register status (false,false,b) in
    1045            WordMap.find (mk_word (zero `Eight) addr) status.external_ram
     1035           Physical.WordMap.find (mk_word (zero `Eight) addr) status.external_ram
    10461036  | `EXT_IND_DPTR ->
    10471037       let dpr = mk_word status.dph status.dpl in
    1048          WordMap.find dpr status.external_ram
     1038         Physical.WordMap.find dpr status.external_ram
    10491039;;
    10501040
     
    11181108      let dpr = mk_word status.dph status.dpl in
    11191109      { status with external_ram =
    1120           WordMap.add dpr v status.external_ram }
     1110          Physical.WordMap.add dpr v status.external_ram }
    11211111    | `EXT_INDIRECT b ->
    11221112      let addr = get_register status (false,false,b) in
    11231113      { status with external_ram =
    1124           WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
     1114          Physical.WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
    11251115;;
    11261116
     
    17281718        let dptr = mk_word status.dph status.dpl in
    17291719        let cry, addr = half_add dptr big_acc in
    1730         let lookup = WordMap.find addr status.code_memory in
     1720        let lookup = Physical.WordMap.find addr status.code_memory in
    17311721        { status with acc = lookup }
    17321722      | `MOVC (`A, `A_PC) ->
     
    17371727        let status = { status with pc = inc_pc } in
    17381728        let cry,addr = half_add inc_pc big_acc in
    1739         let lookup = WordMap.find addr status.code_memory in
     1729        let lookup = Physical.WordMap.find addr status.code_memory in
    17401730        { status with acc = lookup }
    17411731      (* data transfer *)
     
    17441734      | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
    17451735      | `SETB b -> set_arg_1 status true b
    1746       | `PUSH (`DIRECT b) ->
     1736      | `PUSH a ->
    17471737       (* DPM: What happens if we overflow? *)
    17481738        let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    17491739        let status = { status with sp = new_sp } in
    1750         write_at_sp status b
     1740        write_at_sp status (get_arg_8 status false a)
    17511741      | `POP (`DIRECT b) ->
    17521742        let contents = read_at_sp status in
     
    18241814        let status = { status with sp = new_sp } in
    18251815        let status = write_at_sp status pc_upper_byte in
    1826         let n1, n2 = from_byte pc_upper_byte in
    1827         let (b1,b2,b3,_) = from_word11 a in
    1828         let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
    1829         let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
     1816        let addr = addr16_of_addr11 status.pc a in
    18301817        { status with pc = addr }
    18311818      | `LCALL (`ADDR16 addr) ->
     
    18391826        { status with pc = addr }
    18401827      | `AJMP (`ADDR11 a) ->
    1841         let pc_upper_byte, pc_lower_byte = from_word status.pc in
    1842         let n1, n2 = from_byte pc_upper_byte in
    1843         let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
    1844         let (b1,b2,b3,b) = from_word11 a in
    1845         let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
    1846         let cry, new_pc = half_add status.pc addr in
    1847         { status with pc = new_pc }
     1828        let addr = addr16_of_addr11 status.pc a in
     1829        { status with pc = addr }
    18481830      | `LJMP (`ADDR16 a) ->
    18491831        { status with pc = a }
Note: See TracChangeset for help on using the changeset viewer.