64 lines
2.0 KiB
OCaml
64 lines
2.0 KiB
OCaml
|
(***********************************************************************)
|
||
|
|
(* *)
|
||
|
|
(* 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 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 *)
|
||
|
|
|
||
|
|
let _ =
|
||
|
|
Sys.signal Sys.sigvtalrm (Sys.Signal_handle preempt);
|
||
|
|
thread_initialize()
|
||
|
|
|
||
|
|
(* Wait functions *)
|
||
|
|
|
||
|
|
let delay time = Unix.select [] [] [] time; ()
|
||
|
|
|
||
|
|
let wait_read fd = ()
|
||
|
|
let wait_write fd = ()
|
||
|
|
|
||
|
|
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
|
||
|
|
|
||
|
|
let wait_pid p = Unix.waitpid [] p
|
||
|
|
|