Am Mittwoch, den 02.11.2005, 14:23 +0100 schrieb Gerd Stolpmann:
> There is a hack that works (Xavier forgive):
> 
> exception User_interrupt
> 
> 
> let do_something() =
>   ignore(7 * 6)
> ;;

Just an addition: This function is too primitive for ocamlopt (it won't
check for pending events). Use

let rec do_something() =
  ignore(7 * 6); flush stdout
;;

instead.

Gerd

> 
> 
> 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
------------------------------------------------------------