source: Deliverables/D2.2/8051/src/RTLabs/copyPropagation.ml @ 1589

Last change on this file since 1589 was 1589, checked in by tranquil, 9 years ago
  • turned to argument-less return statements for RTLabs and RTL (there was a hidden invariant, for which the arguments of return statements where equal to the f_result field of the function definition: they were useless and an optimization was breaking the compilation)
  • corrected a bug in liveness analysis I had introduced
File size: 3.7 KB
Line 
1open RTLabs
2open AST
3
4let error_prefix = "RTLabs to RTL"
5let error = Error.global_error error_prefix
6
7let error_int () = error "int16 and int32 not supported."
8let error_float () = error "float not supported."
9let error_shift () = error "Shift operations not supported."
10
11
12(* The analysis uses the lattice of maps from registers to values with a top *)
13(* element which indicates the register is known not to be constant. *)
14(* The lattice's join operation is pointwise join, where pointwise bottom is *)
15(* represented by the absence of a binding in the map. *)
16
17module Mem = Driver.RTLabsMemory
18
19module L  = struct
20
21  type property =
22      Register.t Register.FlexMap.t
23
24  let bottom : property =
25    Register.FlexMap.empty
26
27  let meet =
28    let choose r ro1 ro2 = match ro1, ro2 with
29      | Some r1, Some r2 when r1 = r2 -> Some r1
30      | _ -> None in
31    Register.FlexMap.merge choose
32
33  let big_meet f = function
34    | [] -> bottom
35    | x :: xs ->
36      let f' s y = meet s (f y) in
37      List.fold_left f' (f x) xs
38
39  let equal : property -> property -> bool =
40    Register.FlexMap.equal Register.equal
41
42  let is_maximal _ = false
43
44end
45
46let ( --* ) m = function
47  | None -> m
48  | Some r ->
49    let filter s t = not (Register.equal s r || Register.equal t r) in
50    Register.FlexMap.filter filter m
51
52module F = Fix.Make (Label.ImpMap) (L)
53
54let semantics
55    (graph : statement Label.Map.t)
56    (pred_table : Label.t list Label.Map.t)
57    (lbl : Label.t)
58    (valu : F.valuation)
59    : F.property =
60  let copies_out l =
61    let copies_out = valu l in
62    match Label.Map.find l graph with
63      | St_op1 (Op_id, r, s, _) ->
64        let copy_of x =
65          (try
66             Register.FlexMap.find x copies_out
67           with
68             | Not_found -> x) in
69        if Register.equal (copy_of r) (copy_of s) then copies_out else
70          Register.FlexMap.add r s (copies_out --* (Some r))
71      | stmt -> copies_out --* RTLabsGraph.modified_at_stmt stmt in
72  L.big_meet copies_out (Label.Map.find lbl pred_table)
73
74let analyze
75    (f_def : internal_function)
76    : F.valuation =
77
78  let graph = f_def.f_graph in
79
80  let pred_table =
81    let module U = GraphUtilities.Util(RTLabsGraph) in
82    U.compute_predecessor_lists graph in
83
84  F.lfp (semantics graph pred_table)
85
86(* we transform statements according to the valuation found out by analyze *)
87let transform_statement
88    (valu : F.valuation)
89    (p    : Label.t)
90    : statement -> statement =
91  let copy_of x =
92    try
93      Register.FlexMap.find x (valu p)
94    with
95      | Not_found -> x in
96  let copy_of_arg = function
97    | Reg x -> Reg (copy_of x)
98    | Imm _ as a -> a in
99  function
100    | St_op1 (o,i,j,next) -> St_op1(o,i,copy_of j,next)
101    | St_op2 (o,i,j,k,next) -> St_op2(o,i,copy_of_arg j, copy_of_arg k,next)
102    | St_load (q, a, j, l) -> St_load (q, copy_of_arg a, j, l)
103    | St_store (q, a1, a2, l) -> St_store(q, copy_of_arg a1, copy_of_arg a2, l)
104    | St_cond (i, if_true, if_false) -> St_cond (copy_of i, if_true, if_false)
105    | St_call_id (f, args, ret, sign, l) ->
106      St_call_id (f, List.map copy_of_arg args, ret, sign, l)
107    | St_call_ptr (f, args, ret, sign, l) ->
108      St_call_ptr (f, List.map copy_of_arg args, ret, sign, l)
109    | stmt -> stmt
110
111let transform_int_function
112    (f_def  : internal_function)
113    : internal_function =
114  let valu = analyze f_def in
115        (* we transform the graph according to the analysis *)
116  let graph = Label.Map.mapi (transform_statement valu) f_def.f_graph in
117  {f_def with f_graph = graph}
118
119let transform_function = function
120  | (id, F_int f_def) -> (id, F_int (transform_int_function f_def))
121  | f -> f
122
123let trans = Languages.RTLabs, function
124  | Languages.AstRTLabs p ->
125    Languages.AstRTLabs {p with functs = List.map transform_function p.functs}
126  | _ -> assert false
Note: See TracBrowser for help on using the repository browser.