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
|
(******************************************************************************
* Core *
* *
* Copyright (C) 2008- Jane Street Holding, LLC *
* Contact: opensource@janestreet.com *
* WWW: http://www.janestreet.com/ocaml *
* *
* *
* 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 of the License, or (at your option) any later version. *
* *
* 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 *
* *
******************************************************************************)
(* This module exploits the fact that OCaml does not perform context-switches
under certain conditions. It can therefore avoid using mutexes.
Given the semantics of the current OCaml runtime (and for the foreseeable
future), code sections documented as atomic below will never contain a
context-switch. The deciding criterion is whether they contain allocations
or calls to external/builtin functions. If there is none, a context-switch
cannot happen. Assignments without allocations, field access,
pattern-matching, etc., do not trigger context-switches.
Code reviewers should therefore make sure that the sections documented
as atomic below do not violate the above assumptions. It is prudent to
disassemble the .o file (using objdump -dr) and examine it.
*)
type 'a queue_end = 'a z option ref
and 'a z = {
value : 'a;
next : 'a queue_end;
}
type 'a t = {
mutable front : 'a queue_end;
mutable back : 'a queue_end;
}
let create () =
let queue_end = ref None in
{ front = queue_end; back = queue_end }
let enqueue t a =
let next = ref None in
let el = Some { value = a; next = next } in
(* BEGIN ATOMIC SECTION *)
t.back := el;
t.back <- next;
(* END ATOMIC SECTION *)
;;
let dequeue t =
(* BEGIN ATOMIC SECTION *)
match !(t.front) with
| None -> None
| Some el ->
t.front <- el.next;
(* END ATOMIC SECTION *)
Some el.value
;;
let create' () =
let t = create () in
((fun () -> dequeue t), fun a -> enqueue t a)
;;
|
