anil.recoil.org
My working unpac repository
1(**************************************************************************)
2(* *)
3(* OCaml *)
4(* *)
5(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
6(* *)
7(* Copyright 2014 Institut National de Recherche en Informatique et *)
8(* en Automatique. *)
9(* *)
10(* All rights reserved. This file is distributed under the terms of *)
11(* the GNU Lesser General Public License version 2.1, with the *)
12(* special exception on linking described in the file LICENSE. *)
13(* *)
14(**************************************************************************)
15
16(* Dead code elimination: remove pure instructions whose results are
17 not used. *)
18
19open Mach
20
21module Int = Numbers.Int
22
23type d = {
24 i : instruction; (* optimized instruction *)
25 regs : Reg.Set.t; (* a set of registers live "before" instruction [i] *)
26 exits : Int.Set.t; (* indexes of Iexit instructions "live before" [i] *)
27}
28
29let append a b =
30 let rec append a b =
31 match a.desc with
32 | Iend -> b
33 | _ -> { a with next = append a.next b }
34 in
35 match b.desc with
36 | Iend -> a
37 | _ -> append a b
38
39let rec deadcode i =
40 match i.desc with
41 | Iend | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) | Iraise _ ->
42 let regs = Reg.add_set_array i.live i.arg in
43 { i; regs; exits = Int.Set.empty; }
44 | Iop op ->
45 let s = deadcode i.next in
46 if operation_is_pure op (* no side effects *)
47 && Reg.disjoint_set_array s.regs i.res (* results are not used after *)
48 then begin
49 assert (Array.length i.res > 0); (* sanity check *)
50 s
51 end else begin
52 { i = {i with next = s.i};
53 regs = Reg.add_set_array i.live i.arg;
54 exits = s.exits;
55 }
56 end
57 | Iifthenelse(test, ifso, ifnot) ->
58 let ifso' = deadcode ifso in
59 let ifnot' = deadcode ifnot in
60 let s = deadcode i.next in
61 { i = {i with desc = Iifthenelse(test, ifso'.i, ifnot'.i); next = s.i};
62 regs = Reg.add_set_array i.live i.arg;
63 exits = Int.Set.union s.exits
64 (Int.Set.union ifso'.exits ifnot'.exits);
65 }
66 | Iswitch(index, cases) ->
67 let dc = Array.map deadcode cases in
68 let cases' = Array.map (fun c -> c.i) dc in
69 let s = deadcode i.next in
70 { i = {i with desc = Iswitch(index, cases'); next = s.i};
71 regs = Reg.add_set_array i.live i.arg;
72 exits = Array.fold_left
73 (fun acc c -> Int.Set.union acc c.exits) s.exits dc;
74 }
75 | Icatch(rec_flag, handlers, body) ->
76 let body' = deadcode body in
77 let s = deadcode i.next in
78 let handlers' = Int.Map.map deadcode (Int.Map.of_list handlers) in
79 (* Previous passes guarantee that indexes of handlers are unique
80 across the entire function and Iexit instructions refer
81 to the correctly scoped handlers.
82 We do not rely on it here, for safety. *)
83 let rec add_live nfail (live_exits, used_handlers) =
84 if Int.Set.mem nfail live_exits then
85 (live_exits, used_handlers)
86 else
87 let live_exits = Int.Set.add nfail live_exits in
88 match Int.Map.find_opt nfail handlers' with
89 | None -> (live_exits, used_handlers)
90 | Some handler ->
91 let used_handlers = (nfail, handler) :: used_handlers in
92 match rec_flag with
93 | Cmm.Nonrecursive -> (live_exits, used_handlers)
94 | Cmm.Recursive ->
95 Int.Set.fold add_live handler.exits (live_exits, used_handlers)
96 in
97 let live_exits, used_handlers =
98 Int.Set.fold add_live body'.exits (Int.Set.empty, [])
99 in
100 (* Remove exits that are going out of scope. *)
101 let used_handler_indexes = Int.Set.of_list (List.map fst used_handlers) in
102 let live_exits = Int.Set.diff live_exits used_handler_indexes in
103 (* For non-recursive catch, live exits referenced in handlers are free. *)
104 let live_exits =
105 match rec_flag with
106 | Cmm.Recursive -> live_exits
107 | Cmm.Nonrecursive ->
108 List.fold_left (fun exits (_,h) -> Int.Set.union h.exits exits)
109 live_exits
110 used_handlers
111 in
112 let exits = Int.Set.union s.exits live_exits in
113 begin match used_handlers with
114 | [] -> (* Simplify catch without handlers *)
115 { i = append body'.i s.i;
116 regs = body'.regs;
117 exits;
118 }
119 | _ ->
120 let handlers = List.map (fun (n,h) -> (n,h.i)) used_handlers in
121 { i = { i with desc = Icatch(rec_flag, handlers, body'.i); next = s.i };
122 regs = i.live;
123 exits;
124 }
125 end
126 | Iexit nfail ->
127 { i; regs = i.live; exits = Int.Set.singleton nfail; }
128 | Itrywith(body, handler) ->
129 let body' = deadcode body in
130 let handler' = deadcode handler in
131 let s = deadcode i.next in
132 { i = {i with desc = Itrywith(body'.i, handler'.i); next = s.i};
133 regs = i.live;
134 exits = Int.Set.union s.exits
135 (Int.Set.union body'.exits handler'.exits);
136 }
137
138let fundecl f =
139 let new_body = deadcode f.fun_body in
140 {f with fun_body = new_body.i}