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

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

Deliverable D2.2

File size: 3.1 KB
Line 
1
2let error_prefix = "ASMCosts"
3let error s = Error.global_error error_prefix s
4let warning s = Error.warning error_prefix s
5
6
7type instruction_nature =
8  | Cost of CostLabel.t
9  | Goto of Label.t | Branch of Label.t
10  | Direct_fun_call of Label.t | Return
11  | Other
12
13let inst_nature = function
14  | `Cost lbl -> Cost lbl
15  | `Call lbl -> Direct_fun_call lbl
16  | `Jmp lbl -> Goto lbl
17  | `WithLabel (`JC (`Label lbl))
18  | `WithLabel (`JNC (`Label lbl))
19  | `WithLabel (`JB (_, `Label lbl))
20  | `WithLabel (`JNB (_, `Label lbl))
21  | `WithLabel (`JBC (_, `Label lbl))
22  | `WithLabel (`JZ (`Label lbl))
23  | `WithLabel (`JNZ (`Label lbl))
24  | `WithLabel (`CJNE (_, `Label lbl))
25  | `WithLabel (`DJNZ (_, `Label lbl)) -> Branch lbl
26  | `RET -> Return
27  | _ -> Other
28
29
30let pc_of_label p =
31  let f pc map = function
32    | `Label lab -> StringTools.Map.add lab pc map
33    | _ -> map
34  in
35  MiscPottier.foldi f StringTools.Map.empty p.ASM.code
36
37
38let inst_cost = function
39  | `Cost _ | `Label _ -> 0
40  | _ -> 1
41
42
43let block_cost pc_of_label p =
44  let rec aux pc =
45    if pc >= List.length p.ASM.code then 0
46    else
47      let inst = List.nth p.ASM.code pc in
48      let cost = match inst_nature inst with
49        | Cost _ | Return -> 0
50        | Goto lbl ->
51          let pc = StringTools.Map.find lbl pc_of_label in
52          aux pc
53        | Branch lbl ->
54          let pc1 = pc + 1 in
55          let pc2 = StringTools.Map.find lbl pc_of_label in
56          let cost1 = aux pc1 in
57          let cost2 = aux pc2 in
58          let cost = max cost1 cost2 in
59          if cost1 <> cost2 then
60            warning
61              (Printf.sprintf
62                 "Warning: branching to %s has cost %d; continuing has cost %d.\n"
63              lbl cost2 cost1) ;
64          cost
65        | _ -> aux (pc+1)
66    in
67    cost + inst_cost inst
68  in
69  aux
70
71
72let rec init_function p pc =
73  let inst = List.nth p.ASM.code pc in
74  match inst_nature inst with
75    | Cost lbl -> (lbl, 0, pc+1)
76    | _ ->
77      let (lbl, cost, pc) = init_function p (pc+1) in
78      (lbl, cost + (inst_cost inst), pc)
79
80
81let traverse_code pc_of_label p =
82  let rec aux pc =
83    if pc >= List.length p.ASM.code then CostLabel.Map.empty
84    else
85      match inst_nature (List.nth p.ASM.code pc) with
86        | Cost lbl ->
87          let cost = block_cost pc_of_label p (pc+1) in
88          let costs_mapping = aux (pc+1) in
89          CostLabel.Map.add lbl cost costs_mapping
90        | _ -> aux (pc+1)
91  in
92  aux 0
93
94
95let first_cost_label pc_of_label p =
96  let rec aux pc =
97    if pc >= List.length p.ASM.code then assert false (* should not happen *)
98    else
99      match inst_nature (List.nth p.ASM.code pc) with
100        | Cost lbl -> lbl
101        | Direct_fun_call lbl -> aux (StringTools.Map.find lbl pc_of_label)
102        | _ -> aux (pc+1)
103  in
104  aux 0
105
106let initialize_cost pc_of_label p costs_mapping =
107  let lbl = first_cost_label pc_of_label p in
108  let old_cost =
109    if CostLabel.Map.mem lbl costs_mapping then
110      CostLabel.Map.find lbl costs_mapping
111    else 0 in
112  let init = 1 (* cost of the preamble *) in
113  let new_cost = old_cost + init in
114  CostLabel.Map.add lbl new_cost costs_mapping
115
116
117let compute p =
118  let pc_of_label = pc_of_label p in
119  let costs_mapping = traverse_code pc_of_label p in
120  if p.ASM.has_main then initialize_cost pc_of_label p costs_mapping
121  else costs_mapping
Note: See TracBrowser for help on using the repository browser.