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
|
open Unix
open Coordinator
let lock_fd =
let lock_name = fresh_name "_mutex" in
remove_exists lock_name;
let fd = openfile lock_name [O_WRONLY; O_CREAT] file_perm in
remove_exists lock_name;
fd
type t = int (* The offset *)
let create = fresh_number
let rec lock lk =
if lk <> lseek lock_fd lk SEEK_SET then assert false;
lockf lock_fd F_LOCK 1
let try_lock lk =
if lk <> lseek lock_fd lk SEEK_SET then assert false;
try lockf lock_fd F_TLOCK 1; true
with Unix_error (EACCES,_,_) | Unix_error (EAGAIN,_,_) -> false | e -> raise e
let unlock lk =
if lk <> lseek lock_fd lk SEEK_SET then assert false;
lockf lock_fd F_ULOCK 1
external reraise : exn -> 'a = "%reraise"
(* cannot inline, otherwise flambda might move code around. *)
let[@inline never] protect m f =
lock m;
match f() with
| x ->
unlock m; x
| exception e ->
(* NOTE: [unlock] does not poll for asynchronous exceptions *)
unlock m;
reraise e
|
