-let kill_signal = Sys.sigusr2 ;; (* signal used to kill children *)
-let chan = Event.new_channel () ;; (* communication channel between threads *)
-
- (* functions mangling "must die" PID list *)
-let (add_to_dead_threads_walking, remove_from_dead_threads_walking, must_die) =
- let dead_threads_walking = ref [] in
- let mutex = Mutex.create () in
- let add pid = do_critical mutex (lazy (
- dead_threads_walking := pid :: !dead_threads_walking;
- )) in
- let remove pid = do_critical mutex (lazy (
- dead_threads_walking := List.filter ((<>) pid) !dead_threads_walking
- )) in
- let is_in pid = do_critical mutex (lazy (
- List.exists ((=) pid) !dead_threads_walking
- )) in
- (add, remove, is_in)
-;;
-
- (* "kill_signal" handler, check if current process must die, if this is the
- case exits with Thread.exit *)
-ignore (Sys.signal kill_signal (Sys.Signal_handle
- (fun signal ->
- let myself = Unix.getpid () in
- match signal with
- | sg when (sg = kill_signal) && (must_die myself) ->
- remove_from_dead_threads_walking myself;
- prerr_endline "AYEEEEH!";
- Thread.exit ()
- | _ -> ())))
-;;
+let kill_signal = Sys.sigusr2 (* signal used to kill children *)
+let chan = Event.new_channel () (* communication channel between threads *)
+let creation_mutex = Mutex.create ()
+let dead_threads_walking = ref PidSet.empty
+let pids: (Thread.t, int) Hashtbl.t = Hashtbl.create 17