The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #59 from bikallem/io_uring_wait_cqe_timeout
Add Uring.timeout
authored by
Thomas Leonard
and committed by
GitHub
d57bc334
af3811ca
+107
-5
+10
-2
lib/uring/include/discover.ml
+10
-2
lib/uring/include/discover.ml
···
2
2
3
3
let () =
4
4
C.main ~name:"discover" (fun c ->
5
-
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"] ~includes:["fcntl.h"; "poll.h"; "sys/uio.h"] C.C_define.Type.[
5
+
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"]
6
+
~includes:["fcntl.h"; "poll.h"; "sys/uio.h"; "linux/time_types.h"]
7
+
C.C_define.Type.[
6
8
"POLLIN", Int;
7
9
"POLLOUT", Int;
8
10
"POLLERR", Int;
···
31
33
"AT_FDCWD", Int;
32
34
33
35
"sizeof(struct iovec)", Int;
36
+
"sizeof(struct __kernel_timespec)", Int;
34
37
]
35
38
|> List.map (function
36
39
| name, C.C_define.Value.Int v ->
37
-
let name = if name = "sizeof(struct iovec)" then "sizeof_iovec" else name in
40
+
let name =
41
+
match name with
42
+
| "sizeof(struct iovec)" -> "sizeof_iovec"
43
+
| "sizeof(struct __kernel_timespec)" -> "sizeof_kernel_timespec"
44
+
| nm -> nm
45
+
in
38
46
Printf.sprintf "let %s = 0x%x" (String.lowercase_ascii name) v
39
47
| _ -> assert false
40
48
)
+10
lib/uring/uring.ml
+10
lib/uring/uring.ml
···
197
197
198
198
type 'a job = 'a Heap.entry
199
199
200
+
type clock = Boottime | Realtime
201
+
200
202
module Uring = struct
201
203
type t
202
204
···
212
214
213
215
type offset = Optint.Int63.t
214
216
external submit_nop : t -> id -> bool = "ocaml_uring_submit_nop" [@@noalloc]
217
+
external submit_timeout : t -> id -> Sketch.ptr -> clock -> bool -> bool = "ocaml_uring_submit_timeout" [@@noalloc]
215
218
external submit_poll_add : t -> Unix.file_descr -> id -> Poll_mask.t -> bool = "ocaml_uring_submit_poll_add" [@@noalloc]
216
219
external submit_read : t -> Unix.file_descr -> id -> Cstruct.t -> offset -> bool = "ocaml_uring_submit_read" [@@noalloc]
217
220
external submit_write : t -> Unix.file_descr -> id -> Cstruct.t -> offset -> bool = "ocaml_uring_submit_write" [@@noalloc]
···
336
339
337
340
let noop t user_data =
338
341
with_id t (fun id -> Uring.submit_nop t.uring id) user_data
342
+
343
+
external set_timespec: Sketch.ptr -> int64 -> unit = "ocaml_uring_set_timespec" [@@noalloc]
344
+
345
+
let timeout ?(absolute = false) t clock timeout_ns user_data =
346
+
let timespec_ptr = Sketch.alloc t.sketch Config.sizeof_kernel_timespec in
347
+
set_timespec timespec_ptr timeout_ns;
348
+
with_id t (fun id -> Uring.submit_timeout t.uring id timespec_ptr clock absolute) user_data
339
349
340
350
let at_fdcwd : Unix.file_descr = Obj.magic Config.at_fdcwd
341
351
+13
lib/uring/uring.mli
+13
lib/uring/uring.mli
···
67
67
(** [noop t d] submits a no-op operation to uring [t]. The user data [d] will be
68
68
returned by {!wait} or {!peek} upon completion. *)
69
69
70
+
(** {2 Timeout} *)
71
+
72
+
type clock = Boottime | Realtime
73
+
(** Represents Linux clocks. [Boottime] and [Realtime] represents OS clocks CLOCK_BOOTTIME
74
+
and CLOCK_REALTIME respectively. *)
75
+
76
+
val timeout: ?absolute:bool -> 'a t -> clock -> int64 -> 'a -> 'a job option
77
+
(** [timeout t clock ns d] submits a timeout request to uring [t].
78
+
79
+
[absolute] denotes how [clock] and [ns] relate to one another. Default value is [false]
80
+
81
+
[ns] is the timeout time in nanoseconds *)
82
+
70
83
module type FLAGS = sig
71
84
type t = private int
72
85
(** A set of flags. *)
+35
-3
lib/uring/uring_stubs.c
+35
-3
lib/uring/uring_stubs.c
···
49
49
#endif
50
50
51
51
#define Ring_val(v) *((struct io_uring**)Data_custom_val(v))
52
+
#define Sketch_ptr_val(vsp) (Caml_ba_data_val(Field(vsp, 0)) + Long_val(Field(vsp, 1)))
53
+
#define Sketch_ptr_len_val(vsp) Long_val(Field(vsp, 2))
52
54
53
55
// Note that this does not free the ring data. You must not allow this to be
54
56
// GC'd until the ring has been released by calling ocaml_uring_exit.
···
146
148
return (Val_int(io_uring_sq_ready(ring)));
147
149
}
148
150
151
+
void /* noalloc */
152
+
ocaml_uring_set_timespec(value v_sketch_ptr, value v_timeout)
153
+
{
154
+
struct __kernel_timespec *t = Sketch_ptr_val(v_sketch_ptr);
155
+
t->tv_sec = 0;
156
+
t->tv_nsec = Int64_val(v_timeout);
157
+
}
158
+
159
+
#define Val_boottime Val_int(0)
160
+
161
+
value /* noalloc */
162
+
ocaml_uring_submit_timeout(value v_uring, value v_id, value v_sketch_ptr, value v_clock, value v_absolute)
163
+
{
164
+
struct __kernel_timespec *t = Sketch_ptr_val(v_sketch_ptr);
165
+
struct io_uring* ring = Ring_val(v_uring);
166
+
struct io_uring_sqe* sqe;
167
+
int flags;
168
+
169
+
if (v_clock == Val_boottime)
170
+
flags = IORING_TIMEOUT_BOOTTIME;
171
+
else
172
+
flags = IORING_TIMEOUT_REALTIME;
173
+
174
+
if(Bool_val(v_absolute))
175
+
flags |= IORING_TIMEOUT_ABS;
176
+
177
+
sqe = io_uring_get_sqe(ring);
178
+
if (!sqe) return Val_false;
179
+
io_uring_prep_timeout(sqe, t, 0, flags);
180
+
io_uring_sqe_set_data(sqe, (void *)Long_val(v_id));
181
+
return Val_true;
182
+
}
183
+
149
184
struct open_how_data {
150
185
struct open_how how;
151
186
char path[];
···
223
258
io_uring_sqe_set_data(sqe, (void *)Long_val(v_id));
224
259
return (Val_true);
225
260
}
226
-
227
-
#define Sketch_ptr_val(vsp) (Caml_ba_data_val(Field(vsp, 0)) + Long_val(Field(vsp, 1)))
228
-
#define Sketch_ptr_len_val(vsp) Long_val(Field(vsp, 2))
229
261
230
262
void /* noalloc */
231
263
ocaml_uring_set_iovec(value v_sketch_ptr, value v_csl)
+39
tests/main.md
+39
tests/main.md
···
776
776
# Uring.exit t;;
777
777
- : unit = ()
778
778
```
779
+
780
+
## Timeout
781
+
782
+
Timeout should return (-ETIME). This is defined in https://github.com/torvalds/linux/blob/master/include/uapi/asm-generic/errno.h#L45
783
+
784
+
```ocaml
785
+
# let t = Uring.create ~queue_depth:1 ();;
786
+
val t : '_weak13 Uring.t = <abstr>
787
+
788
+
# let ns1 = Int64.(mul 10L 1_000_000L) in
789
+
Uring.(timeout t Boottime ns1 `Timeout);;
790
+
- : _[> `Timeout ] Uring.job option = Some <abstr>
791
+
792
+
# Uring.submit t;;
793
+
- : int = 1
794
+
795
+
# let `Timeout, timeout = consume t;;
796
+
val timeout : int = -62
797
+
798
+
# let ns =
799
+
((Unix.gettimeofday () +. 0.01) *. 1e9)
800
+
|> Int64.of_float
801
+
in
802
+
Uring.(timeout ~absolute:true t Realtime ns `Timeout);;
803
+
- : [ `Timeout ] Uring.job option = Some <abstr>
804
+
805
+
# let `Timeout, timeout = consume t;;
806
+
val timeout : int = -62
807
+
808
+
# let ns1 = Int64.(mul 10L 1_000_000L) in
809
+
Uring.(timeout ~absolute:true t Boottime ns1 `Timeout);;
810
+
- : [ `Timeout ] Uring.job option = Some <abstr>
811
+
812
+
# let `Timeout, timeout = consume t;;
813
+
val timeout : int = -62
814
+
815
+
# Uring.exit t;;
816
+
- : unit = ()
817
+
```