Changeset 634


Ignore:
Timestamp:
Mar 4, 2011, 5:59:34 PM (9 years ago)
Author:
ayache
Message:

Bug fix in ASMCosts in D2.2.

File:
1 edited

Legend:

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

    r632 r634  
    99  | Other
    1010
    11 let inst_nature pc = function
    12   | `LCALL (`ADDR16 addr16) -> Direct_fun_call addr16
    13   | `ACALL (`ADDR11 addr11) ->
    14     Direct_fun_call (Physical.addr16_of_addr11 pc addr11)
    15   | `LJMP (`ADDR16 addr16) -> Goto addr16
    16   | `AJMP (`ADDR11 addr11) -> Goto (Physical.addr16_of_addr11 pc addr11)
    17   | `SJMP (`REL addr) ->
    18       let _, addr = BitVectors.half_add pc (BitVectors.sign_extension addr) in
    19        Goto addr
    20   | `JMP idptr -> Other (* Indirect jump; precondition: every possible
    21                            destination should start with its own label *)
    22   | `JC addr
    23   | `JNC addr
    24   | `JB (_,addr)
    25   | `JNB (_,addr)
    26   | `JBC (_,addr)
    27   | `JZ addr
    28   | `JNZ addr
    29   | `CJNE (_,addr)
    30   | `DJNZ (_,addr) ->
     11let inst_infos mem pc =
     12  let (inst, next_pc, inst_cost) = ASMInterpret.fetch mem pc in
     13  let (nature, next_pcs) = match inst with
     14    | `LCALL (`ADDR16 addr16) -> (Direct_fun_call addr16, [next_pc])
     15    | `ACALL (`ADDR11 addr11) ->
     16      (Direct_fun_call (Physical.addr16_of_addr11 pc addr11), [next_pc])
     17    | `LJMP (`ADDR16 addr16) -> (Goto addr16, [addr16])
     18    | `AJMP (`ADDR11 addr11) ->
     19      let addr = Physical.addr16_of_addr11 pc addr11 in
     20      (Goto addr, [addr])
     21    | `SJMP (`REL addr) ->
     22      let _, addr =
     23        BitVectors.half_add next_pc (BitVectors.sign_extension addr) in
     24      (Goto addr, [addr])
     25    | `JMP idptr ->
     26      (Other, [next_pc]) (* Indirect jump; precondition: every possible
     27                            destination should start with its own label *)
     28    | `JC addr
     29    | `JNC addr
     30    | `JB (_,addr)
     31    | `JNB (_,addr)
     32    | `JBC (_,addr)
     33    | `JZ addr
     34    | `JNZ addr
     35    | `CJNE (_,addr)
     36    | `DJNZ (_,addr) ->
    3137      let `REL addr = addr in
    32       let _, addr = BitVectors.half_add pc (BitVectors.sign_extension addr) in
    33        Branch addr
    34   | `RET | `RETI -> Return
    35   | _ -> Other
     38      let _, addr =
     39        BitVectors.half_add next_pc (BitVectors.sign_extension addr) in
     40      (Branch addr, [next_pc ; addr])
     41    | `RET | `RETI -> (Return, [])
     42    | _ -> (Other, [next_pc]) in
     43  (nature, next_pc, next_pcs, inst_cost)
    3644
    37 
    38 let treat mem costs pc =
    39   let (inst, next_pc, inst_cost) = ASMInterpret.fetch mem pc in
    40 (*
    41   (* <DEBUG> *)
    42   Printf.printf "%s%s: %s\n%!"
    43     (if BitVectors.WordMap.mem pc costs then
    44         BitVectors.WordMap.find pc costs ^ ": "
    45      else "")
    46     (BitVectors.string_of_vect pc)
    47     (Pretty.pp_instruction inst) ;
    48   (* </DEBUG> *)
    49 *)
    50   let next_pcs = match inst_nature pc inst with
    51     | Return -> []
    52     | Goto pc -> [pc]
    53     | Branch pc2 ->
    54       [next_pc ; pc2]
    55     | Direct_fun_call _ | Other -> [next_pc] in
    56   (inst_cost, next_pcs)
    5745
    5846let compare pc1 cost1 pc2 cost2 =
     
    6452  max cost1 cost2
    6553
    66 let block_cost mem costs pc =
    67   let treat = treat mem costs in
    68   let rec aux = function
    69     | [] -> 0
    70     | [pc] when BitVectors.WordMap.mem pc costs -> 0
    71     | [pc] -> full_cost pc
    72     | [pc1 ; pc2] when BitVectors.WordMap.mem pc1 costs &&
    73                        BitVectors.WordMap.mem pc2 costs -> 0
    74     | [pc1 ; pc2] when BitVectors.WordMap.mem pc1 costs ->
    75       let cost2 = full_cost pc2 in
    76       compare pc1 0 pc2 cost2
    77     | [pc1 ; pc2] when BitVectors.WordMap.mem pc2 costs ->
    78       let cost1 = full_cost pc1 in
    79       compare pc1 cost1 pc2 0
    80     | [pc1 ; pc2] ->
    81       let cost1 = full_cost pc1 in
    82       let cost2 = full_cost pc2 in
    83       compare pc1 cost1 pc2 cost2
    84     | _ -> assert false (* should be impossible: only 0, 1 or 2 following pcs *)
    85   and full_cost pc =
    86     let (cost, next_pcs) = treat pc in
    87     cost + (aux next_pcs) in
    88   full_cost pc
     54let rec block_costl mem costs = function
     55  | [] -> 0
     56  | [pc] when BitVectors.WordMap.mem pc costs -> 0
     57  | [pc] ->
     58    let (_, _, next_pcs, cost) = inst_infos mem pc in
     59    cost + (block_costl mem costs next_pcs)
     60  | pc1 :: pc2 :: _ ->
     61    let cost1 = block_costl mem costs [pc1] in
     62    let cost2 = block_costl mem costs [pc2] in
     63    compare pc1 cost1 pc2 cost2
     64
     65let block_cost mem costs pc = block_costl mem costs [pc]
    8966
    9067
    9168let traverse_code mem p =
    9269  let rec aux pc code =
    93     let inst,newpc,_ = ASMInterpret.fetch mem pc in
    94 (*
    95     (* <DEBUG> *)
    96     Printf.printf "Traversing %s: %s\n%!"
    97       (BitVectors.string_of_vect pc) (Pretty.pp_instruction inst) ;
    98     (* </DEBUG> *)
    99 *)
     70    let (_, newpc, _, _) = inst_infos mem pc in
    10071    match code with
    10172      | [] -> CostLabel.Map.empty
    10273      | _::tl when BitVectors.WordMap.mem pc p.ASM.cost_labels ->
    10374        let lbl = BitVectors.WordMap.find pc p.ASM.cost_labels in
    104         let cost = block_cost mem p.ASM.cost_labels pc in
     75        let cost = block_cost mem p.ASM.cost_labels newpc in
    10576        let costs_mapping = aux newpc tl in
    10677        CostLabel.Map.add lbl cost costs_mapping
     
    11586      (BitVectors.WordMap.find oldpc costs, 0)
    11687    else
    117       let (inst, pc, inst_cost) = ASMInterpret.fetch mem oldpc in
    118       match inst_nature oldpc inst with
     88      let (nature, pc, _, inst_cost) = inst_infos mem oldpc in
     89      match nature with
    11990        | Direct_fun_call pc ->
    12091          let (lbl, cost) = aux pc in
     
    142113
    143114let compute p =
    144 (*
    145   (* <DEBUG> *)
    146   Printf.printf "%s\n\n%!" (Pretty.print_program p) ;
    147   (* </DEBUG> *)
    148 *)
    149115  let mem = ASMInterpret.load_code_memory p.ASM.code in
    150116  let costs_mapping = traverse_code mem p in
Note: See TracChangeset for help on using the changeset viewer.