Suppression totale des cleanup handlers

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1809 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

otherlibs/systhreads/posix.c

@@ -241,27 +241,6 @@ static void * caml_thread_tick(void * arg)
   return NULL;                  /* prevents compiler warning */
 }
 
-/* Thread termination: remove the descriptor from the list and free
-   the stack space.  */
-
-static void caml_thread_terminate(void)
-{
-  /* Signal that the thread has terminated */
-  caml_mutex_unlock(Terminated(curr_thread->descr));
-  /* Remove curr_thread from the doubly-linked list of threads */
-  curr_thread->next->prev = curr_thread->prev;
-  curr_thread->prev->next = curr_thread->next;
-#ifndef NATIVE_CODE
-  /* Free the memory resources */
-  stat_free(curr_thread->stack_low);
-#endif
-  /* Free the thread descriptor */
-  stat_free(curr_thread);
-  /* Release the main mutex (forever) */
-  enter_blocking_section();
-  /* The thread now stops running */
-}
-
 /* Initialize the thread machinery */
 
 value caml_thread_initialize(value unit)   /* ML */
@@ -336,8 +315,20 @@ static void * caml_thread_start(void * arg)
   clos = Start_closure(th->descr);
   Modify(&(Start_closure(th->descr)), Val_unit);
   callback(clos, Val_unit);
-  /* Cleanup: free the thread resources and release the mutex */
-  caml_thread_terminate();
+  /* Signal that the thread has terminated */
+  caml_mutex_unlock(Terminated(th->descr));
+  /* Remove th from the doubly-linked list of threads */
+  th->next->prev = th->prev;
+  th->prev->next = th->next;
+#ifndef NATIVE_CODE
+  /* Free the memory resources */
+  stat_free(th->stack_low);
+#endif
+  /* Free the thread descriptor */
+  stat_free(th);
+  /* Release the main mutex (forever) */
+  enter_blocking_section();
+  /* The thread now stops running */
   return NULL;
 }  
 
@@ -433,25 +424,6 @@ value caml_thread_join(value th)          /* ML */
   return Val_unit;
 }
 
-/* Terminate the current thread */
-
-value caml_thread_exit(value unit)       /* ML */
-{
-  caml_thread_terminate();
-  pthread_exit(0);
-  return Val_unit;              /* never reached */
-}
-
-/* Kill another thread */
-/* Currently not implemented due to problems with cleanup handlers on
-   several platforms */
-value caml_thread_kill(caml_thread_t th)       /* ML */
-{
-  invalid_argument("Thread.kill: not implemented");
-  /* pthread_cancel(th->pthread); */
-  return Val_unit;
-}
-
 /* Mutex operations */
 
 #define Mutex_val(v) (*((pthread_mutex_t *)(&Field(v, 1))))

otherlibs/systhreads/thread.mli

@@ -35,9 +35,9 @@ external id : t -> int = "caml_thread_id"
         (* Return the identifier of the given thread. A thread identifier
            is an integer that identifies uniquely the thread.
            It can be used to build data structures indexed by threads. *)
-external exit : unit -> unit = "caml_thread_exit"
+val exit : unit -> unit
         (* Terminate prematurely the currently executing thread. *)
-external kill : t -> unit = "caml_thread_kill"
+val kill : t -> unit
         (* Terminate prematurely the thread whose handle is given. *)
 
 (** Suspending threads *)

otherlibs/systhreads/thread_posix.ml

@@ -1,10 +1,10 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                         Caml Special Light                          *)
+(*                         Objective Caml                              *)
 (*                                                                     *)
 (*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
-(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  Automatique.  Distributed only by permission.                      *)
 (*                                                                     *)
 (***********************************************************************)
@@ -21,20 +21,30 @@ external thread_new : (unit -> unit) -> t = "caml_thread_new"
 external yield : unit -> unit = "caml_thread_yield"
 external self : unit -> t = "caml_thread_self"
 external id : t -> int = "caml_thread_id"
-external exit : unit -> unit = "caml_thread_exit"
 external join : t -> unit = "caml_thread_join"
-external kill : t -> unit = "caml_thread_kill"
 
 (* For new, make sure the function passed to thread_new never
    raises an exception. *)
 
+exception Thread_exit
+
 let create fn arg =
   thread_new
     (fun () ->
       try
-        Printexc.print fn arg; exit()
-      with x ->
-        flush stdout; flush stderr; exit())
+        fn arg; ()
+      with Thread_exit -> ()
+         | exn ->
+             Printf.eprintf "Uncaught exception in thread %d: %s\n"
+                            (id(self())) (Printexc.to_string exn);
+             flush stderr)
+
+let exit () = raise Thread_exit
+
+(* Thread.kill is currently not implemented due to problems with
+   cleanup handlers on several platforms *)
+
+let kill th = invalid_arg "Thread.kill: not implemented"
 
 (* Preemption *)