source: Deliverables/D2.2/8051/src/ASM/ASMCosts.ml @ 634

Last change on this file since 634 was 634, checked in by ayache, 9 years ago

Bug fix in ASMCosts in D2.2.

File size: 3.6 KB
Line 
1
2let error_prefix = "ASMCosts"
3let warning s = prerr_endline (error_prefix ^ s)
4
5
6type instruction_nature =
7  | Goto of BitVectors.word | Branch of BitVectors.word
8  | Direct_fun_call of BitVectors.word | Return
9  | Other
10
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) ->
37      let `REL addr = addr in
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)
44
45
46let compare pc1 cost1 pc2 cost2 =
47  if cost1 <> cost2 then
48    warning
49      (Printf.sprintf
50         "Warning: branching to %s has cost %d, branching to %s has cost %d"
51         "*fixme*" (* pc1 *) cost1 "*fixme*" (* pc2 *) cost2) ;
52  max cost1 cost2
53
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]
66
67
68let traverse_code mem p =
69  let rec aux pc code =
70    let (_, newpc, _, _) = inst_infos mem pc in
71    match code with
72      | [] -> CostLabel.Map.empty
73      | _::tl when BitVectors.WordMap.mem pc p.ASM.cost_labels ->
74        let lbl = BitVectors.WordMap.find pc p.ASM.cost_labels in
75        let cost = block_cost mem p.ASM.cost_labels newpc in
76        let costs_mapping = aux newpc tl in
77        CostLabel.Map.add lbl cost costs_mapping
78      | _::tl -> aux newpc tl
79  in
80  aux (BitVectors.zero `Sixteen) p.ASM.code
81
82
83let first_cost_label mem costs =
84  let rec aux oldpc =
85    if BitVectors.WordMap.mem oldpc costs then
86      (BitVectors.WordMap.find oldpc costs, 0)
87    else
88      let (nature, pc, _, inst_cost) = inst_infos mem oldpc in
89      match nature with
90        | Direct_fun_call pc ->
91          let (lbl, cost) = aux pc in
92          (lbl, inst_cost + cost)
93        | Return
94        | Goto _
95        | Branch _ ->
96          assert false (* no such instructions before calling main *)
97        | Other ->
98          let (lbl, cost) = aux pc in
99          (lbl, inst_cost + cost)
100  in
101  aux (BitVectors.zero `Sixteen)
102
103
104let initialize_cost mem costs costs_mapping =
105  let (lbl, cost) = first_cost_label mem costs in
106  let old_cost =
107    if CostLabel.Map.mem lbl costs_mapping then
108      CostLabel.Map.find lbl costs_mapping
109    else 0 in
110  let new_cost = old_cost + cost in
111  CostLabel.Map.add lbl new_cost costs_mapping
112
113
114let compute p =
115  let mem = ASMInterpret.load_code_memory p.ASM.code in
116  let costs_mapping = traverse_code mem p in
117  if p.ASM.has_main then initialize_cost mem p.ASM.cost_labels costs_mapping
118  else costs_mapping
Note: See TracBrowser for help on using the repository browser.