(***********************************************************************)
(*                                                                     *)
(*                         Caml Special Light                          *)
(*                                                                     *)
(*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   *)
(*                                                                     *)
(*  Copyright 1995 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(* User-level threads *)

type t

external thread_initialize : unit -> unit = "caml_thread_initialize"
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 detach : t -> unit = "caml_thread_detach"
external kill : t -> unit = "caml_thread_kill"

(* For new, make sure the function passed to thread_new never
   raises an exception. *)

let create fn arg =
  thread_new
    (fun () ->
      try
        Printexc.print fn arg; exit()
      with x ->
        flush stdout; flush stderr; exit())

(* Preemption *)

let preempt signal = yield()

(* Initialization of the scheduler *)

#ifdef WIN32
#define PREEMPT_SIGNAL 1
#else
#define PREEMPT_SIGNAL Sys.sigvtalrm
#endif

let _ =
  Sys.signal PREEMPT_SIGNAL (Sys.Signal_handle preempt);
  thread_initialize()

(* Wait functions *)

#ifdef WIN32
external delay: float -> unit = "caml_thread_delay"
#else
let delay time = Unix.select [] [] [] time; ()
#endif

let wait_read fd = ()
let wait_write fd = ()

#ifdef WIN32
let wait_timed_read fd delay = true
let wait_timed_write fd delay = true
let select rd wr ex delay = invalid_argument "Thread.select: not implemented"
#else
let wait_timed_read fd d =
  match Unix.select [fd] [] [] d with ([], _, _) -> false | (_, _, _) -> true
let wait_timed_write fd d =
  match Unix.select [] [fd] [] d with (_, [], _) -> false | (_, _, _) -> true
let select = Unix.select
#endif

let wait_pid p = Unix.waitpid [] p