source: Deliverables/D2.3/8051/src/ASM/ASMCosts.ml @ 453

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

Import of the Paris's sources.

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