Re: [Caml-list] The best way to circumvent the lack of Thread.kill ?

[Gerd Stolpmann <info@gerd-stolpmann.de>]

Am Mittwoch, den 02.11.2005, 10:52 +0100 schrieb Julien Narboux:
> Hi,
> 
> I just encountered the Thread.kill "not implemented" exception.

This operation is insane, better it would be removed entirely.

What could be worth of discussion is a Thread.send_exception that will
cause that a certain thread raises a certain exception the next time it
executes O'Caml code. This won't work if the thread is blocked, however.
(There is machinery to handle such asynchronous events in the O'Caml
runtime.)

For Unix (including MacOS X) you can implement send_exception yourself
by sending a signal to the thread, and defining a signal handler that
just raises an exception.

In Windows there are no signals. An extension of the O'Caml runtime
would be needed to get this behaviour.

> What is the best solution ? start a new process and use the kill at the 
> operating system level ?

Which is unavailable in Windows.

> (to make things even worse I need something which works on linux, 
> windows and macosx)

There is a hack that works (Xavier forgive):

exception User_interrupt


let do_something() =
  ignore(7 * 6)
;;


let compute() =
  try
    while true do
      do_something()
    done;
    assert false
  with
    | User_interrupt ->
	prerr_endline "Thread interrupted!"
;;


let vt_signal =
  match Sys.os_type with
    | "Win32" -> Sys.sigterm
    | _ -> Sys.sigvtalrm
;;


let interrupt = ref None;;

let force_interrupt old_action_ref n =
  (* This function is called just before the thread's timeslice ends *)
  if Some(Thread.id(Thread.self())) = !interrupt then
    raise User_interrupt;
  match !old_action_ref with
    | Sys.Signal_handle f -> f n
    | _ -> failwith "Not in threaded mode"
;;


let main() =
  (* Install the signal handler: *)
  let old_action_ref = ref Sys.Signal_ignore in
  let old_action = 
    Sys.signal vt_signal (Sys.Signal_handle (force_interrupt old_action_ref)) in
  old_action_ref := old_action;
  (* Fire up the compute thread: *)
  let t = Thread.create compute () in
  (* Wait for user: *)
  print_string "Press Return: ";
  flush stdout;
  let _ = read_line() in
  interrupt := Some (Thread.id t);
  (* Wait until the thread terminates: *)
  Thread.join t
;;

main();;

Gerd
-- 
------------------------------------------------------------
Gerd Stolpmann * Viktoriastr. 45 * 64293 Darmstadt * Germany 
gerd@gerd-stolpmann.de          http://www.gerd-stolpmann.de
Telefon: 06151/153855                  Telefax: 06151/997714
------------------------------------------------------------