The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #122 from talex5/setup-flags
Add Uring.Setup_flags
authored by
Thomas Leonard
and committed by
GitHub
e427ba17
bf805563
+95
-24
+1
-1
vendor/opam/uring/lib/uring/heap.mli
+1
-1
vendor/opam/uring/lib/uring/heap.mli
···
28
28
29
29
val ptr : 'a entry -> ptr
30
30
(** [ptr e] is the index of [e].
31
-
@raise Invalid_arg if [e] has already been freed. *)
31
+
@raise Invalid_argument if [e] has already been freed. *)
32
32
33
33
val alloc : 'a t -> 'a -> extra_data:'b -> 'a entry
34
34
(** [alloc t a ~extra_data] adds the value [a] to [t] and returns a
+31
-2
vendor/opam/uring/lib/uring/include/discover.ml
+31
-2
vendor/opam/uring/lib/uring/include/discover.ml
···
99
99
"IORING_OP_URING_CMD";
100
100
]
101
101
102
-
let ops c =
102
+
let uring_setup_flags = [
103
+
"IORING_SETUP_IOPOLL";
104
+
(* "IORING_SETUP_SQPOLL" *) (* Enabled by passing a polling timeout instead *)
105
+
(* "IORING_SETUP_SQ_AFF"; *) (* todo: requires setting sq_thread_cpu too *)
106
+
(* "IORING_SETUP_CQSIZE"; *) (* todo: requires setting cq_entries *)
107
+
"IORING_SETUP_CLAMP";
108
+
(* "IORING_SETUP_ATTACH_WQ"; *) (* todo: requires setting wq_fd *)
109
+
"IORING_SETUP_R_DISABLED";
110
+
"IORING_SETUP_SUBMIT_ALL";
111
+
"IORING_SETUP_COOP_TASKRUN";
112
+
"IORING_SETUP_TASKRUN_FLAG";
113
+
"IORING_SETUP_SQE128";
114
+
"IORING_SETUP_CQE32";
115
+
"IORING_SETUP_SINGLE_ISSUER";
116
+
"IORING_SETUP_DEFER_TASKRUN";
117
+
]
118
+
119
+
let uring_defs c =
103
120
Gen.abstract_module "Op" (
104
121
C.C_define.import c (List.map (fun name -> name, C.C_define.Type.Int) uring_ops)
105
122
~c_flags:["-D_GNU_SOURCE"; "-I"; include_dir]
···
107
124
|> List.map (function
108
125
| name, C.C_define.Value.Int v ->
109
126
let prefix_len = String.length "IORING_OP_" in
127
+
let ocaml_name = String.sub name prefix_len (String.length name - prefix_len) |> String.lowercase_ascii in
128
+
(ocaml_name, v)
129
+
| _ -> assert false
130
+
)
131
+
) @
132
+
Gen.hex_module "Ioring_setup" (
133
+
C.C_define.import c (List.map (fun name -> name, C.C_define.Type.Int) uring_setup_flags)
134
+
~c_flags:["-D_GNU_SOURCE"; "-I"; include_dir]
135
+
~includes:["liburing.h"]
136
+
|> List.map (function
137
+
| name, C.C_define.Value.Int v ->
138
+
let prefix_len = String.length "IORING_SETUP_" in
110
139
let ocaml_name = String.sub name prefix_len (String.length name - prefix_len) |> String.lowercase_ascii in
111
140
(ocaml_name, v)
112
141
| _ -> assert false
···
199
228
C.main ~name:"discover" (fun c ->
200
229
C.Flags.write_lines "config.ml" @@ List.flatten @@ List.map (fun f -> f c) [
201
230
toplevel_defs;
202
-
ops;
231
+
uring_defs;
203
232
stat_flags;
204
233
]
205
234
)
+1
-1
vendor/opam/uring/lib/uring/primitives.h
+1
-1
vendor/opam/uring/lib/uring/primitives.h
···
57
57
CAMLprim value ocaml_uring_set_string(value, value);
58
58
CAMLprim value ocaml_uring_make_msghdr(value, value, value);
59
59
CAMLprim value ocaml_uring_get_msghdr_fds(value);
60
-
CAMLprim value ocaml_uring_setup(value, value);
60
+
CAMLprim value ocaml_uring_setup(value, value, value);
61
61
CAMLprim value ocaml_uring_exit(value);
62
62
CAMLprim value ocaml_uring_unregister_buffers(value);
63
63
CAMLprim value ocaml_uring_register_ba(value, value);
+8
-3
vendor/opam/uring/lib/uring/uring.ml
+8
-3
vendor/opam/uring/lib/uring/uring.ml
···
86
86
let pollhup = Config.pollhup
87
87
end
88
88
89
+
module Setup_flags = struct
90
+
include Flags
91
+
include Config.Ioring_setup
92
+
end
93
+
89
94
module Statx = struct
90
95
type t
91
96
···
299
304
module Uring = struct
300
305
type t
301
306
302
-
external create : int -> int option -> t = "ocaml_uring_setup"
307
+
external create : int -> int option -> Setup_flags.t -> t = "ocaml_uring_setup"
303
308
external exit : t -> unit = "ocaml_uring_exit"
304
309
305
310
external unregister_buffers : t -> unit = "ocaml_uring_unregister_buffers"
···
394
399
let unregister_gc_root t =
395
400
update_gc_roots (Ring_set.remove (Generic_ring.T t))
396
401
397
-
let create ?polling_timeout ~queue_depth () =
402
+
let create ?(flags=Setup_flags.empty) ?polling_timeout ~queue_depth () =
398
403
if queue_depth < 1 then Fmt.invalid_arg "Non-positive queue depth: %d" queue_depth;
399
-
let uring = Uring.create queue_depth polling_timeout in
404
+
let uring = Uring.create queue_depth polling_timeout flags in
400
405
let data = Heap.create queue_depth in
401
406
let id = object end in
402
407
let fixed_iobuf = Cstruct.empty.buffer in
+52
-16
vendor/opam/uring/lib/uring/uring.mli
+52
-16
vendor/opam/uring/lib/uring/uring.mli
···
23
23
24
24
module Region = Region
25
25
26
+
(** Type of flags that can be combined. *)
27
+
module type FLAGS = sig
28
+
type t = private int
29
+
(** A set of flags. *)
30
+
31
+
val empty : t
32
+
33
+
val of_int : int -> t
34
+
35
+
val ( + ) : t -> t -> t
36
+
(** [a + b] is the union of the sets. *)
37
+
38
+
val mem : t -> t -> bool
39
+
(** [mem x flags] is [true] iff [x] is a subset of [flags]. *)
40
+
end
41
+
42
+
(** Flags that can be passed to {!create}. *)
43
+
module Setup_flags : sig
44
+
include FLAGS
45
+
46
+
val iopoll : t
47
+
(** io_context is polled *)
48
+
49
+
val clamp : t
50
+
(** Clamp SQ/CQ ring sizes *)
51
+
52
+
val r_disabled : t
53
+
(** Start with ring disabled *)
54
+
55
+
val submit_all : t
56
+
(** Continue submit on error *)
57
+
58
+
val coop_taskrun : t
59
+
(** Cooperative task running *)
60
+
61
+
val taskrun_flag : t
62
+
(** Get notified if task work is available *)
63
+
64
+
val sqe128 : t
65
+
(** SQEs are 128 byte *)
66
+
67
+
val cqe32 : t
68
+
(** CQEs are 32 byte *)
69
+
70
+
val single_issuer : t
71
+
(** Only one task is allowed to submit requests *)
72
+
73
+
val defer_taskrun : t
74
+
(** Defer running task work to get events *)
75
+
end
76
+
26
77
type 'a t
27
78
(** ['a t] is a reference to an Io_uring structure. *)
28
79
···
30
81
(** A handle for a submitted job, which can be used to cancel it.
31
82
If an operation returns [None], this means that submission failed because the ring is full. *)
32
83
33
-
val create : ?polling_timeout:int -> queue_depth:int -> unit -> 'a t
84
+
val create : ?flags:Setup_flags.t -> ?polling_timeout:int -> queue_depth:int -> unit -> 'a t
34
85
(** [create ~queue_depth] will return a fresh Io_uring structure [t].
35
86
Initially, [t] has no fixed buffer. Use {!set_fixed_buffer} if you want one.
36
87
@param polling_timeout If given, use polling mode with the given idle timeout (in ms).
···
85
136
[absolute] denotes how [clock] and [ns] relate to one another. Default value is [false]
86
137
87
138
[ns] is the timeout time in nanoseconds *)
88
-
89
-
module type FLAGS = sig
90
-
type t = private int
91
-
(** A set of flags. *)
92
-
93
-
val empty : t
94
-
95
-
val of_int : int -> t
96
-
97
-
val ( + ) : t -> t -> t
98
-
(** [a + b] is the union of the sets. *)
99
-
100
-
val mem : t -> t -> bool
101
-
(** [mem x flags] is [true] iff [x] is a subset of [flags]. *)
102
-
end
103
139
104
140
(** Flags that can be passed to {!openat2}. *)
105
141
module Open_flags : sig
+2
-1
vendor/opam/uring/lib/uring/uring_stubs.c
+2
-1
vendor/opam/uring/lib/uring/uring_stubs.c
···
77
77
custom_fixed_length_default
78
78
};
79
79
80
-
value ocaml_uring_setup(value entries, value polling_timeout) {
80
+
value ocaml_uring_setup(value entries, value polling_timeout, value v_flags) {
81
81
CAMLparam1(entries);
82
82
CAMLlocal1(v_uring);
83
83
struct io_uring_params params;
···
90
90
Ring_val(v_uring) = ring;
91
91
92
92
memset(¶ms, 0, sizeof(params));
93
+
params.flags = Int_val(v_flags);
93
94
if (Is_some(polling_timeout)) {
94
95
params.flags |= IORING_SETUP_SQPOLL;
95
96
params.sq_thread_idle = Int_val(Some_val(polling_timeout));