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
110
111
112
113
114
115
116
117
118
119
120
121
122
open Core
open Import
type 'a t = 'a Option_array.t
let capacity t = Option_array.length t
let create ~num_file_descrs =
if num_file_descrs < 0
then
raise_s
[%message
"[By_descr.create] got negative [num_file_descrs]" (num_file_descrs : int)];
Option_array.create ~len:num_file_descrs
;;
let bounds_check t file_descr =
let i = file_descr |> File_descr.to_int in
0 <= i && i < capacity t
;;
let bounds_check_error t file_descr =
[%message
"The file descriptor is not in the range that Async allows, which probably means \
that the program has created too many file descriptors without closing them. You \
can cause Async to allow more file descriptors via the [ASYNC_CONFIG] environment \
variable, like this: ASYNC_CONFIG='((max_num_open_file_descrs <NUMBER>))' foo.exe \
arg1 arg2 ..."
(file_descr : File_descr.t)
~min_file_descr:0
~max_file_descr:(capacity t - 1 : int)]
;;
let bounds_check_exn t file_descr =
if not (bounds_check t file_descr) then raise_s (bounds_check_error t file_descr)
;;
let mem t file_descr =
bounds_check t file_descr && Option_array.is_some t (file_descr |> File_descr.to_int)
;;
let find t file_descr =
if not (bounds_check t file_descr)
then None
else Option_array.get t (file_descr |> File_descr.to_int)
;;
let find_exn t file_descr =
bounds_check_exn t file_descr;
if Option_array.is_none t (file_descr |> File_descr.to_int)
then
raise_s
[%message "[By_descr.find_exn] got unknown file_descr" (file_descr : File_descr.t)];
Option_array.get_some_exn t (file_descr |> File_descr.to_int)
;;
let remove t (fd : File_descr.t) =
bounds_check_exn t fd;
Option_array.set_none t (fd |> File_descr.to_int)
;;
let add t file_descr v =
if not (bounds_check t file_descr)
then error_s (bounds_check_error t file_descr)
else if Option_array.is_some t (file_descr |> File_descr.to_int)
then
error_s
[%message
"Attempt to register a file descriptor with Async that Async believes it is \
already managing."]
else (
Option_array.set_some t (file_descr |> File_descr.to_int) v;
Ok ())
;;
let fold t ~init ~f =
let r = ref init in
for i = 0 to capacity t - 1 do
if Option_array.is_some t i then r := f !r (Option_array.get_some_exn t i)
done;
!r
;;
let foldi t ~init ~f =
let r = ref init in
for i = 0 to capacity t - 1 do
if Option_array.is_some t i then r := f i !r (Option_array.get_some_exn t i)
done;
!r
;;
let iter t ~f =
for i = 0 to capacity t - 1 do
if Option_array.is_some t i then f (Option_array.get_some_exn t i)
done
;;
let exists t ~f =
Option_array.exists t ~f:(function
| None -> false
| Some x -> f x)
;;
let sexp_of_t sexp_of t =
let fd_alist = foldi ~init:[] t ~f:(fun i acc x -> (i, sexp_of x) :: acc) in
[%sexp_of: (int * Sexp.t) list] (List.rev fd_alist)
;;
let invariant t =
try
for i = 0 to capacity t - 1 do
match Option_array.get t i with
| None -> ()
| Some fd ->
Raw_fd.invariant fd;
assert (File_descr.equal (i |> File_descr.of_int) (Raw_fd.file_descr fd))
done
with
| exn ->
raise_s [%message "By_descr.invariant failure" (exn : exn) ~fd:(t : Raw_fd.t t)]
;;