Source file fd_by_descr.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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
open Core
open Import
module Fd = Raw_fd

type t = Fd.t Option_array.t

let capacity t = Option_array.length t

let create ~num_file_descrs =
  if num_file_descrs < 0
  then
    raise_s
      [%message
        "[Fd_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
        "[Fd_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 : Fd.t) =
  bounds_check_exn t fd.file_descr;
  Option_array.set_none t (fd.file_descr |> File_descr.to_int)
;;

let add t (fd : Fd.t) =
  let file_descr = fd.file_descr in
  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) fd;
    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)
;;

(* The default sexp representation of this is huge and pollutes debug output *)
let sexp_of_t t =
  let fd_alist = foldi ~init:[] t ~f:(fun i acc fd -> (i, fd) :: acc) in
  [%sexp_of: (int * Fd.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 ->
        Fd.invariant fd;
        assert (File_descr.equal (i |> File_descr.of_int) (Fd.file_descr fd))
    done
  with
  | exn -> raise_s [%message "Fd_by_descr.invariant failure" (exn : exn) ~fd:(t : t)]
;;