1(**************************************************************************)
2
3external mycallback1 : ('a -> 'b) -> 'a -> 'b = "mycallback1"
4external mycallback2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c = "mycallback2"
5external mycallback3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd
6    = "mycallback3"
7external mycallback4 :
8    ('a -> 'b -> 'c -> 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e = "mycallback4"
9
10let rec tak (x, y, z as _tuple) =
11  if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
12           else z
13
14let tak2 x (y, z) = tak (x, y, z)
15
16let tak3 x y z = tak (x, y, z)
17
18let tak4 x y z u = tak (x, y, z + u)
19
20let raise_exit () = (raise Exit : unit)
21
22let trapexit () =
23  begin try
24    mycallback1 raise_exit ()
25  with Exit ->
26    ()
27  end;
28  tak (18, 12, 6)
29
30external mypushroot : 'a -> ('b -> 'c) -> 'b -> 'a = "mypushroot"
31external mycamlparam : 'a -> ('b -> 'c) -> 'b -> 'a = "mycamlparam"
32
33let tripwire f =
34  let s = String.make 5 'a' in
35  f s trapexit ()
36
37(* Test callbacks performed to handle signals *)
38
39let sighandler signo =
40(*
41  print_string "Got signal, triggering garbage collection...";
42  print_newline();
43*)
44  (* Thoroughly wipe the minor heap *)
45  ignore (tak (18, 12, 6))
46
47external unix_getpid : unit -> int = "unix_getpid" [@@noalloc]
48external unix_kill : int -> int -> unit = "unix_kill" [@@noalloc]
49
50let callbacksig () =
51  let pid = unix_getpid() in
52  (* Allocate a block in the minor heap *)
53  let s = String.make 5 'b' in
54  (* Send a signal to self.  We want s to remain in a register and
55     not be spilled on the stack, hence we declare unix_kill
56     [@@noalloc]. *)
57  unix_kill pid Sys.sigusr1;
58  (* Allocate some more so that the signal will be tested *)
59  let u = (s, s) in
60  fst u
61
62let _ =
63  print_int(mycallback1 tak (18, 12, 6)); print_newline();
64  print_int(mycallback2 tak2 18 (12, 6)); print_newline();
65  print_int(mycallback3 tak3 18 12 6); print_newline();
66  print_int(mycallback4 tak4 18 12 3 3); print_newline();
67  print_int(trapexit ()); print_newline();
68  print_string(tripwire mypushroot); print_newline();
69  print_string(tripwire mycamlparam); print_newline();
70  Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
71  print_string(callbacksig ()); print_newline()
72