blob: 0dbb74d9a5a42925776fcd6d5d0a4106b681cc05 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
(* Liveness analysis.
Annotate mach code with the set of regs live at each point. *)
open Mach
let live_at_exit = ref Reg.Set.empty
let live_at_break = ref Reg.Set.empty
let live_at_raise = ref Reg.Set.empty
let rec live i finally =
(* finally is the set of registers live after execution of the
instruction sequence.
The result of the function is the set of registers live just
before the instruction sequence.
The instruction i is annotated by the set of registers live across
the instruction. *)
match i.desc with
Iend ->
i.live <- finally;
finally
| Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
(* i.live remains empty since no regs are live across *)
Reg.set_of_array i.arg
| Iifthenelse(test, ifso, ifnot) ->
let at_join = live i.next finally in
let at_fork = Reg.Set.union (live ifso at_join) (live ifnot at_join) in
i.live <- at_fork;
Reg.add_set_array at_fork i.arg
| Iswitch(index, cases) ->
let at_join = live i.next finally in
let at_fork = ref Reg.Set.empty in
for i = 0 to Array.length cases - 1 do
at_fork := Reg.Set.union !at_fork (live cases.(i) at_join)
done;
i.live <- !at_fork;
Reg.add_set_array !at_fork i.arg
| Iloop(body) ->
let at_top = ref Reg.Set.empty in
(* Yes, there are better algorithms, but we'll just iterate till
reaching a fixpoint. *)
begin try
while true do
let new_at_top = Reg.Set.union !at_top (live body !at_top) in
if Reg.Set.equal !at_top new_at_top then raise Exit;
at_top := new_at_top
done
with Exit -> ()
end;
i.live <- !at_top;
!at_top
| Icatch(body, handler) ->
let at_join = live i.next finally in
let before_handler = live handler at_join in
let saved_live_at_exit = !live_at_exit in
live_at_exit := before_handler;
let before_body = live body at_join in
live_at_exit := saved_live_at_exit;
i.live <- before_body;
before_body
| Iexit ->
(* i.live remains empty since no regs are live across *)
!live_at_exit
| Itrywith(body, handler) ->
let at_join = live i.next finally in
let before_handler = live handler at_join in
let saved_live_at_raise = !live_at_raise in
live_at_raise := Reg.Set.remove Proc.loc_exn_bucket before_handler;
let before_body = live body at_join in
live_at_raise := saved_live_at_raise;
i.live <- before_body;
before_body
| Iraise ->
(* i.live remains empty since no regs are live across *)
Reg.add_set_array !live_at_raise i.arg
| _ ->
let across_after = Reg.diff_set_array (live i.next finally) i.res in
let across =
match i.desc with
Iop(Icall_ind) | Iop(Icall_imm _) | Iop(Iextcall(_, _)) ->
(* The function call may raise an exception, branching to the
nearest enclosing try ... with. Hence, everything that must
be live at the beginning of the exception handler must also
be live across the call. *)
Reg.Set.union across_after !live_at_raise
| _ ->
across_after in
i.live <- across;
Reg.add_set_array across i.arg
let fundecl f =
live f.fun_body Reg.Set.empty; ()
|
