source: Deliverables/D2.2/8051-indexed-labels-branch/src/RTLabs/RTLabsUtilities.ml @ 1468

Last change on this file since 1468 was 1468, checked in by tranquil, 9 years ago
  • implemented constant propagation
  • implementing partial redundancy elimination
File size: 2.0 KB
Line 
1(** this module provides some utilities relative to RTLabs graphs *)
2
3open RTLabs
4
5type node = Label.t
6
7(** Successors of a statement *)
8let statement_successors (stmt : statement) =
9  match stmt with
10  | St_return _ 
11    | St_tailcall_id _
12    | St_tailcall_ptr _ ->
13    []
14  | St_skip l
15  | St_cost (_, l)
16  | St_ind_0 (_, l)
17  | St_ind_inc (_, l)
18  | St_cst (_, _, l)
19  | St_op1 (_, _, _, l)
20  | St_op2 (_, _, _, _, l)
21  | St_load (_, _, _, l)
22  | St_store (_, _, _, l)
23  | St_call_ptr (_, _, _, _, l)
24  | St_call_id (_, _, _, _, l) ->
25    [l]
26  | St_cond (_, l1, l2) ->
27    [l1 ; l2]
28  | St_jumptable (_, ls) -> ls
29
30(** computes a map binding the set of predecessors to each node. The domain
31    is guaranteed to be equal to the domain of graph *)
32let compute_predecessors graph =
33    let add_to_preds pred map lbl =
34    let preds =
35        try
36          Label.Set.add pred (Label.Map.find lbl map)
37    with
38          | Not_found -> Label.Set.singleton pred in
39    Label.Map.add lbl preds map in
40  let add_predecessor lbl stmt map =
41                (* make sure the domain of the map will be equal to dom graph, adding *)
42                (* empty sets if need be *)
43    let map = if Label.Map.mem lbl map then map else
44                        Label.Map.add lbl Label.Set.empty map in
45                List.fold_left (add_to_preds lbl) map (statement_successors stmt) in 
46  Label.Map.fold add_predecessor graph Label.Map.empty
47
48let dead_code_elim
49    (g     : graph)
50                (entry : node)
51                : graph =
52        let marked = Label.Set.empty in
53        let rec process marked = function
54                | [] -> marked
55                | next :: worklist ->
56                        if Label.Set.mem next marked then process marked worklist else
57                        let marked = Label.Set.add next marked in
58                        let succs = statement_successors (Label.Map.find next g) in
59                        let worklist = succs @ worklist in
60                        process marked worklist in
61        let marked = process marked [entry] in
62        let is_marked x _ = Label.Set.mem x marked in
63        Label.Map.filter is_marked g
64       
65let insert_in_between
66    (u : Label.Gen.universe)
67                (g : graph)
68                (src : node)
69                (tgt : node)
70                (s : statement)
71                : graph = assert false (* to be implemented *) 
72               
Note: See TracBrowser for help on using the repository browser.