source: Deliverables/D2.2/8051-indexed-labels-branch/src/RTLabs/redundancyElimination.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.1 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
11type expr =
12        | UnOp of op1 * Register.t
13        | BinOp of op2 * Register.t * Register.t
14
15let count_predecessors
16    (g : graph)
17                : int Label.Map.t =
18        let f lbl s m =
19                let succs = RTLabsUtilities.statement_successors s in
20                let f' m succ =
21                        try
22                                Label.Map.add succ (1 + Label.Map.find succ m) m
23                        with
24                                | Not_found -> Label.Map.add succ 1 m in
25                let m = List.fold_left f' m succs in
26                if Label.Map.mem lbl m then m else Label.Map.add lbl 0 m in
27        Label.Map.fold f g Label.Map.empty
28                         
29(* the following functions are in fact useless!! Levaing it here as I will*)
30(* probably reuse some of this code elsewhere *)
31
32let erase_critical
33    (u : Label.Gen.universe)
34                (g : graph)
35                (pred_count : int Label.Map.t)
36                (src : Label.t)
37                (tgt : Label.t)
38                : bool * Label.t * graph =
39        if Label.Map.find tgt pred_count < 2 then
40                (false, tgt, g)
41        else
42                let lbl = Label.Gen.fresh u in
43                let g = Label.Map.add lbl (St_skip tgt) g in
44          (true, lbl, g)
45
46let critical_edge_elimination
47    (g : graph)
48                (u : Label.Gen.universe)
49                : graph =
50        (* a critical edge is one between a node with several successors and one *)
51        (* with several predecessors *)
52        let pred_count = count_predecessors g in
53        let f l stmt g =
54                match stmt with
55                        | St_cond(r, l1, l2) ->
56                                let (b1, l1, g) = erase_critical u g pred_count l l1 in
57              let (b2, l2, g) = erase_critical u g pred_count l l2 in
58                                if b1 || b2 then Label.Map.add l (St_cond(r,l1,l2)) g else g
59                        | St_jumptable(r, ls) when List.length ls > 1 ->
60                                let f' l' (b, ls', g) =
61          let (b', l', g) = erase_critical u g pred_count l l' in
62                                        (b || b', l' :: ls', g) in
63                                let starting = (false, [], g) in
64                                let (b, ls', g) = List.fold_right f' ls starting in
65                                if b then Label.Map.add l (St_jumptable(r, ls')) g else g
66                        | _ -> g in
67        Label.Map.fold f g g
68                                       
69                       
70       
71
72
73(* am implementing *)
74let trans = Languages.RTLabs, fun _ -> assert false
Note: See TracBrowser for help on using the repository browser.