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
|
(* TEST
frame_pointers;
readonly_files = "fp_backtrace.c";
all_modules = "${readonly_files} exception_handler.ml";
native;
*)
(* https://github.com/ocaml/ocaml/pull/11031 *)
external fp_backtrace : string -> unit = "fp_backtrace" [@@noalloc]
exception Exn1
exception Exn2
(* We want to be sure to use some stack space so that frame pointer is shifted,
* preventing inlining seems enough *)
let[@inline never] raiser i =
match i with
| 1 -> raise Exn1
| 2 -> raise Exn2
| _ -> 42 (* shouldn't happen *)
let[@inline never][@local never] f x = x
(* This give us a chance to overwrite the memory address pointed by frame
* pointer if it is still within 'raiser' stack frame.
* Technically we don't need to overwrite it but by doing so we avoid some
* infinite loop while walking the stack. *)
let[@inline never] handler () =
(* Force spilling of x0, x1, x2 *)
let x0 = Sys.opaque_identity 0x6f56df77 (* 0xdeadbeef *) in
let x1 = Sys.opaque_identity 0x6f56df77 (* 0xdeadbeef *) in
let x2 = Sys.opaque_identity 0x6f56df77 (* 0xdeadbeef *) in
let _ = f x0 in
let _ = f x1 in
let _ = f x2 in
let _ = Sys.opaque_identity x0 in
let _ = Sys.opaque_identity x1 in
let _ = Sys.opaque_identity x2 in
fp_backtrace Sys.argv.(0)
let[@inline never] nested i =
begin
try
try ignore (raiser i) with Exn1 -> handler ()
with
| Exn2 -> handler ()
end;
i
(* Check that we haven't broken anything by raising directly from this
* function, it doesn't require the frame pointer to be adjusted. *)
let[@inline never] bare i =
begin
try
try (if i == 1 then raise Exn1 else raise Exn2) with
| Exn1 -> handler ()
with
| Exn2 -> handler ()
end;
i
let () =
ignore (bare 1);
ignore (bare 2);
ignore (nested 1);
ignore (nested 2)
|
