1995-11-05 09:27:32 -08:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1995-11-05 09:27:32 -08:00
|
|
|
(* *)
|
1995-11-14 09:12:57 -08:00
|
|
|
(* Xavier Leroy and Damien Doligez, INRIA Rocquencourt *)
|
1995-11-05 09:27:32 -08:00
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1995-11-05 09:27:32 -08:00
|
|
|
(* Automatique. Distributed only by permission. *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1996-04-03 02:02:34 -08:00
|
|
|
type t = { mutable locked: bool; mutable waiting: Thread.t list }
|
|
|
|
|
1996-04-22 04:15:41 -07:00
|
|
|
let create () = { locked = false; waiting = [] }
|
1996-04-03 02:02:34 -08:00
|
|
|
|
|
|
|
let rec lock m =
|
|
|
|
if m.locked then begin (* test and set atomic *)
|
|
|
|
Thread.critical_section := true;
|
|
|
|
m.waiting <- Thread.self() :: m.waiting;
|
|
|
|
Thread.sleep();
|
|
|
|
lock m
|
|
|
|
end else begin
|
|
|
|
m.locked <- true (* test and set atomic *)
|
|
|
|
end
|
|
|
|
|
|
|
|
let try_lock m = (* test and set atomic *)
|
|
|
|
if m.locked then false else begin m.locked <- true; true end
|
|
|
|
|
|
|
|
let unlock m =
|
|
|
|
(* Don't play with Thread.critical_section here because of Condition.wait *)
|
|
|
|
let w = m.waiting in (* atomic *)
|
|
|
|
m.waiting <- []; (* atomic *)
|
|
|
|
m.locked <- false; (* atomic *)
|
|
|
|
List.iter Thread.wakeup w
|
|
|
|
|