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
|
(* TEST
include unix
modules = "callbackprim.c"
* libunix
** bytecode
** native
*)
(**************************************************************************)
external mycallback1 : ('a -> 'b) -> 'a -> 'b = "mycallback1"
external mycallback2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c = "mycallback2"
external mycallback3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd
= "mycallback3"
external mycallback4 :
('a -> 'b -> 'c -> 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e = "mycallback4"
let rec tak (x, y, z as _tuple) =
if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
else z
let tak2 x (y, z) = tak (x, y, z)
let tak3 x y z = tak (x, y, z)
let tak4 x y z u = tak (x, y, z + u)
let raise_exit () = (raise Exit : unit)
let trapexit () =
begin try
mycallback1 raise_exit ()
with Exit ->
()
end;
tak (18, 12, 6)
external mypushroot : 'a -> ('b -> 'c) -> 'b -> 'a = "mypushroot"
external mycamlparam : 'a -> ('b -> 'c) -> 'b -> 'a = "mycamlparam"
let tripwire f =
let s = String.make 5 'a' in
f s trapexit ()
(* Test callbacks performed to handle signals *)
let sighandler signo =
(*
print_string "Got signal, triggering garbage collection...";
print_newline();
*)
(* Thoroughly wipe the minor heap *)
ignore (tak (18, 12, 6))
external unix_getpid : unit -> int = "unix_getpid" [@@noalloc]
external unix_kill : int -> int -> unit = "unix_kill" [@@noalloc]
let callbacksig () =
let pid = unix_getpid() in
(* Allocate a block in the minor heap *)
let s = String.make 5 'b' in
(* Send a signal to self. We want s to remain in a register and
not be spilled on the stack, hence we declare unix_kill
[@@noalloc]. *)
unix_kill pid Sys.sigusr1;
(* Allocate some more so that the signal will be tested *)
let u = (s, s) in
fst u
let _ =
print_int(mycallback1 tak (18, 12, 6)); print_newline();
print_int(mycallback2 tak2 18 (12, 6)); print_newline();
print_int(mycallback3 tak3 18 12 6); print_newline();
print_int(mycallback4 tak4 18 12 3 3); print_newline();
print_int(trapexit ()); print_newline();
print_string(tripwire mypushroot); print_newline();
print_string(tripwire mycamlparam); print_newline();
Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
print_string(callbacksig ()); print_newline()
|
