-
Notifications
You must be signed in to change notification settings - Fork 106
/
rMutex.ml
109 lines (95 loc) · 3.32 KB
/
rMutex.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
(*
* RMutex - Reentrant mutexes
* Copyright (C) 2008 David Teller, LIFO, Universite d'Orleans
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
module BaseRMutex =
struct
type owner =
{
thread : int; (**Identity of the latest owner (possibly the current owner)*)
mutable depth : int (**Number of times the current owner owns the lock.*)
}
type t =
{
primitive : Mutex.t; (**A low-level mutex, used to protect access to [ownership]*)
wait : Mutex.t;
mutable ownership : owner option;
}
let create () =
{
primitive = Mutex.create ();
wait = Mutex.create ();
ownership = None
}
(**
Attempt to acquire the mutex.
@param hurry If true, in case the mutex cannot be acquired yet, just return [false],
without waiting. Otherwise, wait.
*)
let lock_either hurry m = (*Stuff shared by [lock] and [try_lock]*)
let id = Thread.id (Thread.self ()) in
let rec aux () =
let wait = ref false in
Mutex.lock m.primitive; (******Critical section begins*)
(match m.ownership with
| None -> (*Lock belongs to nobody, I can take it. *)
m.ownership <- Some {thread = id; depth = 1};
| Some s when s.thread = id -> (*Lock already belongs to me, I can keep it. *)
s.depth <- s.depth + 1
| _ -> (*Lock belongs to someone else. I should wait.*)
wait := true);
Mutex.unlock m.primitive; (******Critical section ends*)
if !wait then
if hurry then false
else
begin
Mutex.lock m.wait; (*Get in line and try again*)
aux ()
end
else true
in aux()
let lock m = ignore (lock_either false m)
let try_lock m = lock_either true m
let unlock m =
let id = Thread.id (Thread.self ()) in
Mutex.lock m.primitive; (******Critical section begins*)
(match m.ownership with
| Some s ->
assert (s.thread = id); (*If I'm not the owner, we have a consistency issue.*)
if s.depth > 1 then s.depth <- s.depth - 1 (*release one depth but we're still the owner*)
else
begin
m.ownership <- None; (*release once and for all*)
Mutex.unlock m.wait (*wake up waiting threads *)
end
| _ -> assert false);
Mutex.unlock m.primitive (******Critical section ends *)
end
module Lock = Concurrent.MakeLock(BaseRMutex)
include BaseRMutex
let make = Lock.make
let synchronize = Lock.synchronize
(*let synchronize ?lock:(l=create ()) f = fun x ->
lock l;
try
let result = f x
in lock l;
result
with e ->
lock l;
raise e*)