From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <info@gerd-stolpmann.de>
X-Original-To: caml-list@yquem.inria.fr
Delivered-To: caml-list@yquem.inria.fr
Received: from nez-perce.inria.fr (nez-perce.inria.fr [192.93.2.78])
	by yquem.inria.fr (Postfix) with ESMTP id 74E81D45F
	for <caml-list@yquem.inria.fr>; Wed,  2 Nov 2005 14:23:35 +0100 (CET)
Received: from moutng.kundenserver.de (moutng.kundenserver.de [212.227.126.176])
	by nez-perce.inria.fr (8.13.0/8.13.0) with ESMTP id jA2DNZpn010932
	for <caml-list@yquem.inria.fr>; Wed, 2 Nov 2005 14:23:35 +0100
Received: from [212.227.126.160] (helo=mrelayng.kundenserver.de)
	by moutng.kundenserver.de with esmtp (Exim 3.35 #1)
	id 1EXIaU-00083R-00; Wed, 02 Nov 2005 14:23:34 +0100
Received: from [84.58.130.212] (helo=gate.lan.gerd-stolpmann.de)
	by mrelayng.kundenserver.de with asmtp (Exim 3.35 #1)
	id 1EXIaU-0006WC-00; Wed, 02 Nov 2005 14:23:34 +0100
Received: from flakew.lan.gerd-stolpmann.de (flakew.lan.gerd-stolpmann.de [192.168.0.32])
	by gate.lan.gerd-stolpmann.de (Postfix) with ESMTP id 5EBAEC05F;
	Wed,  2 Nov 2005 14:23:34 +0100 (CET)
Subject: Re: [Caml-list] The best way to circumvent the lack of Thread.kill
	?
From: Gerd Stolpmann <info@gerd-stolpmann.de>
To: Julien Narboux <Julien.Narboux@inria.fr>
Cc: caml-list@yquem.inria.fr
In-Reply-To: <43688C4C.2080606@inria.fr>
References: <43688C4C.2080606@inria.fr>
Content-Type: text/plain
Date: Wed, 02 Nov 2005 14:23:33 +0100
Message-Id: <1130937814.4327.36.camel@localhost.localdomain>
Mime-Version: 1.0
X-Mailer: Evolution 2.2.1.1 
Content-Transfer-Encoding: 7bit
X-Provags-ID: kundenserver.de abuse@kundenserver.de auth:a6865a839c0178d9aa0ce41878507ea2
X-Miltered: at nez-perce with ID 4368BDD7.000 by Joe's j-chkmail (http://j-chkmail.ensmp.fr)!
X-Spam: no; 0.00; caml-list:01 gerd:01 stolpmann:01 o'caml:01 o'caml:01 runtime:01 macos:01 handler:01 runtime:01 macosx:01 prerr:01 endline:01 sigterm:01 failwith:01 handler:01 
X-Spam-Checker-Version: SpamAssassin 3.0.3 (2005-04-27) on yquem.inria.fr
X-Spam-Level: 
X-Spam-Status: No, score=0.1 required=5.0 tests=FORGED_RCVD_HELO 
	autolearn=disabled version=3.0.3

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