The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #121 from talex5/cleanup
Clean up configurator code and update primitives.h
authored by
Thomas Leonard
and committed by
GitHub
0422ca44
698ad36f
+219
-203
+1
lib/uring/dune
+1
lib/uring/dune
+193
-202
lib/uring/include/discover.ml
+193
-202
lib/uring/include/discover.ml
···
1
1
module C = Configurator.V1
2
2
3
-
let () =
4
-
C.main ~name:"discover" (fun c ->
5
-
let defs =
6
-
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"; "-I"; Filename.concat (Sys.getcwd ()) "include"]
7
-
~includes:["fcntl.h"; "poll.h"; "sys/uio.h"; "limits.h"; "liburing.h"]
8
-
C.C_define.Type.[
9
-
"POLLIN", Int;
10
-
"POLLOUT", Int;
11
-
"POLLERR", Int;
12
-
"POLLHUP", Int;
3
+
let include_dir = Filename.concat (Sys.getcwd ()) "include"
13
4
14
-
"O_RDONLY", Int;
15
-
"O_WRONLY", Int;
16
-
"O_RDWR", Int;
17
-
"O_CREAT", Int;
18
-
"O_EXCL", Int;
19
-
"O_NOCTTY", Int;
20
-
"O_TRUNC", Int;
21
-
"O_APPEND", Int;
22
-
"O_NONBLOCK", Int;
23
-
"O_DSYNC", Int;
24
-
"O_DIRECT", Int;
25
-
"O_LARGEFILE", Int;
26
-
"O_DIRECTORY", Int;
27
-
"O_NOFOLLOW", Int;
28
-
"O_NOATIME", Int;
29
-
"O_CLOEXEC", Int;
30
-
"O_SYNC", Int;
31
-
"O_PATH", Int;
32
-
"O_TMPFILE", Int;
5
+
let toplevel_defs c =
6
+
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"; "-I"; include_dir]
7
+
~includes:["fcntl.h"; "poll.h"; "sys/uio.h"; "limits.h"; "liburing.h"]
8
+
C.C_define.Type.[
9
+
"POLLIN", Int;
10
+
"POLLOUT", Int;
11
+
"POLLERR", Int;
12
+
"POLLHUP", Int;
13
+
14
+
"O_RDONLY", Int;
15
+
"O_WRONLY", Int;
16
+
"O_RDWR", Int;
17
+
"O_CREAT", Int;
18
+
"O_EXCL", Int;
19
+
"O_NOCTTY", Int;
20
+
"O_TRUNC", Int;
21
+
"O_APPEND", Int;
22
+
"O_NONBLOCK", Int;
23
+
"O_DSYNC", Int;
24
+
"O_DIRECT", Int;
25
+
"O_LARGEFILE", Int;
26
+
"O_DIRECTORY", Int;
27
+
"O_NOFOLLOW", Int;
28
+
"O_NOATIME", Int;
29
+
"O_CLOEXEC", Int;
30
+
"O_SYNC", Int;
31
+
"O_PATH", Int;
32
+
"O_TMPFILE", Int;
33
+
34
+
"AT_FDCWD", Int;
35
+
"IOV_MAX", Int;
33
36
34
-
"AT_FDCWD", Int;
35
-
"IOV_MAX", Int;
37
+
"sizeof(struct iovec)", Int;
38
+
"sizeof(struct __kernel_timespec)", Int;
39
+
]
40
+
|> List.map (function
41
+
| name, C.C_define.Value.Int v ->
42
+
let name =
43
+
match name with
44
+
| "sizeof(struct iovec)" -> "sizeof_iovec"
45
+
| "sizeof(struct __kernel_timespec)" -> "sizeof_kernel_timespec"
46
+
| nm -> nm
47
+
in
48
+
Gen.hex_val (String.lowercase_ascii name, v)
49
+
| _ -> assert false
50
+
)
36
51
37
-
"sizeof(struct iovec)", Int;
38
-
"sizeof(struct __kernel_timespec)", Int;
39
-
]
40
-
|> List.map (function
41
-
| name, C.C_define.Value.Int v ->
42
-
let name =
43
-
match name with
44
-
| "sizeof(struct iovec)" -> "sizeof_iovec"
45
-
| "sizeof(struct __kernel_timespec)" -> "sizeof_kernel_timespec"
46
-
| nm -> nm
47
-
in
48
-
Printf.sprintf "let %s = 0x%x" (String.lowercase_ascii name) v
49
-
| _ -> assert false
50
-
)
52
+
let uring_ops = [
53
+
"IORING_OP_NOP";
54
+
"IORING_OP_READV";
55
+
"IORING_OP_WRITEV";
56
+
"IORING_OP_FSYNC";
57
+
"IORING_OP_READ_FIXED";
58
+
"IORING_OP_WRITE_FIXED";
59
+
"IORING_OP_POLL_ADD";
60
+
"IORING_OP_POLL_REMOVE";
61
+
"IORING_OP_SYNC_FILE_RANGE";
62
+
"IORING_OP_SENDMSG";
63
+
"IORING_OP_RECVMSG";
64
+
"IORING_OP_TIMEOUT";
65
+
"IORING_OP_TIMEOUT_REMOVE";
66
+
"IORING_OP_ACCEPT";
67
+
"IORING_OP_ASYNC_CANCEL";
68
+
"IORING_OP_LINK_TIMEOUT";
69
+
"IORING_OP_CONNECT";
70
+
"IORING_OP_FALLOCATE";
71
+
"IORING_OP_OPENAT";
72
+
"IORING_OP_CLOSE";
73
+
"IORING_OP_FILES_UPDATE";
74
+
"IORING_OP_STATX";
75
+
"IORING_OP_READ";
76
+
"IORING_OP_WRITE";
77
+
"IORING_OP_FADVISE";
78
+
"IORING_OP_MADVISE";
79
+
"IORING_OP_SEND";
80
+
"IORING_OP_RECV";
81
+
"IORING_OP_OPENAT2";
82
+
"IORING_OP_EPOLL_CTL";
83
+
"IORING_OP_SPLICE";
84
+
"IORING_OP_PROVIDE_BUFFERS";
85
+
"IORING_OP_REMOVE_BUFFERS";
86
+
"IORING_OP_TEE";
87
+
"IORING_OP_SHUTDOWN";
88
+
"IORING_OP_RENAMEAT";
89
+
"IORING_OP_UNLINKAT";
90
+
"IORING_OP_MKDIRAT";
91
+
"IORING_OP_SYMLINKAT";
92
+
"IORING_OP_LINKAT";
93
+
"IORING_OP_MSG_RING";
94
+
"IORING_OP_FSETXATTR";
95
+
"IORING_OP_SETXATTR";
96
+
"IORING_OP_FGETXATTR";
97
+
"IORING_OP_GETXATTR";
98
+
"IORING_OP_SOCKET";
99
+
"IORING_OP_URING_CMD";
100
+
]
101
+
102
+
let ops c =
103
+
Gen.abstract_module "Op" (
104
+
C.C_define.import c (List.map (fun name -> name, C.C_define.Type.Int) uring_ops)
105
+
~c_flags:["-D_GNU_SOURCE"; "-I"; include_dir]
106
+
~includes:["liburing.h"]
107
+
|> List.map (function
108
+
| name, C.C_define.Value.Int v ->
109
+
let prefix_len = String.length "IORING_OP_" in
110
+
let ocaml_name = String.sub name prefix_len (String.length name - prefix_len) |> String.lowercase_ascii in
111
+
(ocaml_name, v)
112
+
| _ -> assert false
113
+
)
114
+
)
115
+
116
+
let stat_flags c =
117
+
let at_flags, mask_flags, attr_flags =
118
+
let new_flags =
119
+
C.C_define.Type.[
120
+
(* Masks *)
121
+
"STATX_MNT_ID", Int, 0x00001000;
122
+
"STATX_DIOALIGN", Int, 0x00002000;
123
+
(* File Attributes *)
124
+
"STATX_ATTR_COMPRESSED", Int, 0x00000004;
125
+
"STATX_ATTR_IMMUTABLE", Int, 0x00000010;
126
+
"STATX_ATTR_APPEND", Int, 0x00000020;
127
+
"STATX_ATTR_NODUMP", Int, 0x00000040;
128
+
"STATX_ATTR_ENCRYPTED", Int, 0x00000800;
129
+
"STATX_ATTR_VERITY", Int, 0x00100000;
130
+
"STATX_ATTR_DAX", Int, 0x00200000;
131
+
]
132
+
in
133
+
let new_flag_prelude =
134
+
let def_flag = function
135
+
| name, C.C_define.Type.Int, v ->
136
+
Printf.sprintf "#ifndef %s\n#define %s %d\n#endif\n" name name v;
137
+
| _ -> assert false
51
138
in
52
-
let ops =
53
-
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"; "-I"; Filename.concat (Sys.getcwd ()) "include"]
54
-
~includes:["liburing.h"]
55
-
C.C_define.Type.[
56
-
"IORING_OP_NOP", Int;
57
-
"IORING_OP_READV", Int;
58
-
"IORING_OP_WRITEV", Int;
59
-
"IORING_OP_FSYNC", Int;
60
-
"IORING_OP_READ_FIXED", Int;
61
-
"IORING_OP_WRITE_FIXED", Int;
62
-
"IORING_OP_POLL_ADD", Int;
63
-
"IORING_OP_POLL_REMOVE", Int;
64
-
"IORING_OP_SYNC_FILE_RANGE", Int;
65
-
"IORING_OP_SENDMSG", Int;
66
-
"IORING_OP_RECVMSG", Int;
67
-
"IORING_OP_TIMEOUT", Int;
68
-
"IORING_OP_TIMEOUT_REMOVE", Int;
69
-
"IORING_OP_ACCEPT", Int;
70
-
"IORING_OP_ASYNC_CANCEL", Int;
71
-
"IORING_OP_LINK_TIMEOUT", Int;
72
-
"IORING_OP_CONNECT", Int;
73
-
"IORING_OP_FALLOCATE", Int;
74
-
"IORING_OP_OPENAT", Int;
75
-
"IORING_OP_CLOSE", Int;
76
-
"IORING_OP_FILES_UPDATE", Int;
77
-
"IORING_OP_STATX", Int;
78
-
"IORING_OP_READ", Int;
79
-
"IORING_OP_WRITE", Int;
80
-
"IORING_OP_FADVISE", Int;
81
-
"IORING_OP_MADVISE", Int;
82
-
"IORING_OP_SEND", Int;
83
-
"IORING_OP_RECV", Int;
84
-
"IORING_OP_OPENAT2", Int;
85
-
"IORING_OP_EPOLL_CTL", Int;
86
-
"IORING_OP_SPLICE", Int;
87
-
"IORING_OP_PROVIDE_BUFFERS", Int;
88
-
"IORING_OP_REMOVE_BUFFERS", Int;
89
-
"IORING_OP_TEE", Int;
90
-
"IORING_OP_SHUTDOWN", Int;
91
-
"IORING_OP_RENAMEAT", Int;
92
-
"IORING_OP_UNLINKAT", Int;
93
-
"IORING_OP_MKDIRAT", Int;
94
-
"IORING_OP_SYMLINKAT", Int;
95
-
"IORING_OP_LINKAT", Int;
96
-
"IORING_OP_MSG_RING", Int;
97
-
"IORING_OP_FSETXATTR", Int;
98
-
"IORING_OP_SETXATTR", Int;
99
-
"IORING_OP_FGETXATTR", Int;
100
-
"IORING_OP_GETXATTR", Int;
101
-
"IORING_OP_SOCKET", Int;
102
-
"IORING_OP_URING_CMD", Int;
103
-
]
104
-
|> List.map (function
105
-
| name, C.C_define.Value.Int v ->
106
-
let prefix_len = String.length "IORING_OP_" in
107
-
let ocaml_name = String.sub name prefix_len (String.length name - prefix_len) |> String.lowercase_ascii in
108
-
(ocaml_name, v)
109
-
| _ -> assert false
110
-
)
111
-
in
112
-
let at_flags, mask_flags, attr_flags =
113
-
let new_flags =
114
-
C.C_define.Type.[
115
-
(* Masks *)
116
-
"STATX_MNT_ID", Int, 0x00001000;
117
-
"STATX_DIOALIGN", Int, 0x00002000;
118
-
(* File Attributes *)
119
-
"STATX_ATTR_COMPRESSED", Int, 0x00000004;
120
-
"STATX_ATTR_IMMUTABLE", Int, 0x00000010;
121
-
"STATX_ATTR_APPEND", Int, 0x00000020;
122
-
"STATX_ATTR_NODUMP", Int, 0x00000040;
123
-
"STATX_ATTR_ENCRYPTED", Int, 0x00000800;
124
-
"STATX_ATTR_VERITY", Int, 0x00100000;
125
-
"STATX_ATTR_DAX", Int, 0x00200000;
126
-
]
127
-
in
128
-
let new_flag_prelude =
129
-
let def_flag = function
130
-
| name, C.C_define.Type.Int, v ->
131
-
Printf.sprintf "#ifndef %s\n#define %s %d\n#endif\n" name name v;
132
-
| _ -> assert false
133
-
in
134
-
String.concat "" (List.map def_flag new_flags)
135
-
in
136
-
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"; "-I"; Filename.concat (Sys.getcwd ()) "include"]
137
-
~prelude:({|#include <sys/stat.h>
139
+
String.concat "" (List.map def_flag new_flags)
140
+
in
141
+
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"; "-I"; include_dir]
142
+
~prelude:({|#include <sys/stat.h>
138
143
#ifndef STATX_TYPE
139
144
#include <linux/stat.h>
140
145
#endif
141
146
|} ^ new_flag_prelude)
142
-
~includes:["fcntl.h" ]
143
-
(C.C_define.Type.[
144
-
"AT_EMPTY_PATH", Int;
145
-
"AT_NO_AUTOMOUNT", Int;
146
-
"AT_SYMLINK_NOFOLLOW", Int;
147
-
"AT_SYMLINK_FOLLOW", Int;
148
-
"AT_STATX_SYNC_AS_STAT", Int;
149
-
"AT_STATX_FORCE_SYNC", Int;
150
-
"AT_STATX_DONT_SYNC", Int;
147
+
~includes:["fcntl.h" ]
148
+
(C.C_define.Type.[
149
+
"AT_EMPTY_PATH", Int;
150
+
"AT_NO_AUTOMOUNT", Int;
151
+
"AT_SYMLINK_NOFOLLOW", Int;
152
+
"AT_SYMLINK_FOLLOW", Int;
153
+
"AT_STATX_SYNC_AS_STAT", Int;
154
+
"AT_STATX_FORCE_SYNC", Int;
155
+
"AT_STATX_DONT_SYNC", Int;
156
+
157
+
"STATX_TYPE", Int;
158
+
"STATX_MODE", Int;
159
+
"STATX_NLINK", Int;
160
+
"STATX_UID", Int;
161
+
"STATX_GID", Int;
162
+
"STATX_ATIME", Int;
163
+
"STATX_MTIME", Int;
164
+
"STATX_CTIME", Int;
165
+
"STATX_INO", Int;
166
+
"STATX_SIZE", Int;
167
+
"STATX_BLOCKS", Int;
168
+
"STATX_BASIC_STATS", Int;
169
+
"STATX_BTIME", Int;
170
+
] @ List.map (fun (n, t, _) -> n, t) new_flags)
171
+
|> List.fold_left (fun (ats, stats, attrs) (v, k) -> match String.split_on_char '_' v, k with
172
+
| "AT" :: name, C.C_define.Value.Int v ->
173
+
let ocaml_name = String.lowercase_ascii (String.concat "_" name) in
174
+
((ocaml_name, v) :: ats, stats, attrs)
175
+
| "STATX" :: "ATTR" :: name, C.C_define.Value.Int v ->
176
+
let name = String.concat "_" name |> String.lowercase_ascii in
177
+
let ocaml_name = match name with
178
+
| "type" -> "type'"
179
+
| v -> v
180
+
in
181
+
(ats, stats, (ocaml_name, v) :: attrs)
182
+
| "STATX" :: name, C.C_define.Value.Int v ->
183
+
let name = String.concat "_" name |> String.lowercase_ascii in
184
+
let ocaml_name = match name with
185
+
| "type" -> "type'"
186
+
| v -> v
187
+
in
188
+
(ats, (ocaml_name, v) :: stats, attrs)
189
+
| _ -> assert false
190
+
) ([], [], [])
191
+
in
192
+
Gen.hex_module "At" at_flags @
193
+
["module Statx = struct"] @
194
+
Gen.indent_lines (Gen.hex_module "Mask" mask_flags) @
195
+
Gen.indent_lines (Gen.hex_module "Attr" attr_flags) @
196
+
["end"]
151
197
152
-
"STATX_TYPE", Int;
153
-
"STATX_MODE", Int;
154
-
"STATX_NLINK", Int;
155
-
"STATX_UID", Int;
156
-
"STATX_GID", Int;
157
-
"STATX_ATIME", Int;
158
-
"STATX_MTIME", Int;
159
-
"STATX_CTIME", Int;
160
-
"STATX_INO", Int;
161
-
"STATX_SIZE", Int;
162
-
"STATX_BLOCKS", Int;
163
-
"STATX_BASIC_STATS", Int;
164
-
"STATX_BTIME", Int;
165
-
] @ List.map (fun (n, t, _) -> n, t) new_flags)
166
-
|> List.fold_left (fun (ats, stats, attrs) (v, k) -> match String.split_on_char '_' v, k with
167
-
| "AT" :: name, C.C_define.Value.Int v ->
168
-
let ocaml_name = String.lowercase_ascii (String.concat "_" name) in
169
-
((ocaml_name, v) :: ats, stats, attrs)
170
-
| "STATX" :: "ATTR" :: name, C.C_define.Value.Int v ->
171
-
let name = String.concat "_" name |> String.lowercase_ascii in
172
-
let ocaml_name = match name with
173
-
| "type" -> "type'"
174
-
| v -> v
175
-
in
176
-
(ats, stats, (ocaml_name, v) :: attrs)
177
-
| "STATX" :: name, C.C_define.Value.Int v ->
178
-
let name = String.concat "_" name |> String.lowercase_ascii in
179
-
let ocaml_name = match name with
180
-
| "type" -> "type'"
181
-
| v -> v
182
-
in
183
-
(ats, (ocaml_name, v) :: stats, attrs)
184
-
| _ -> assert false
185
-
) ([], [], [])
186
-
in
187
-
let op_sig = List.map (fun (name, _) -> Printf.sprintf " val %s : t" name) ops in
188
-
let op_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) ops in
189
-
let at_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) at_flags in
190
-
let mask_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) mask_flags in
191
-
let attr_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) attr_flags in
192
-
C.Flags.write_lines "config.ml"
193
-
(defs @
194
-
["module Op : sig";
195
-
" type t";
196
-
] @ op_sig @ [
197
-
"end = struct";
198
-
" type t = int"
199
-
] @ op_struct @ [
200
-
"end"
201
-
] @ [
202
-
"module At = struct";
203
-
] @ at_struct @ [
204
-
"end";
205
-
"module Statx = struct";
206
-
" module Mask = struct";
207
-
] @ mask_struct @ [
208
-
" end";
209
-
" module Attr = struct";
210
-
] @ attr_struct @ [
211
-
" end";
212
-
"end"
213
-
])
198
+
let () =
199
+
C.main ~name:"discover" (fun c ->
200
+
C.Flags.write_lines "config.ml" @@ List.flatten @@ List.map (fun f -> f c) [
201
+
toplevel_defs;
202
+
ops;
203
+
stat_flags;
204
+
]
214
205
)
-1
lib/uring/include/dune
-1
lib/uring/include/dune
+22
lib/uring/include/gen.ml
+22
lib/uring/include/gen.ml
···
1
+
let ( % ) g f x = g (f x)
2
+
3
+
let hex_val (n, v) = Printf.sprintf "let %s = 0x%x" n v
4
+
let sig_val (n, _) = Printf.sprintf "val %s : t" n
5
+
6
+
let indent l = " " ^ l
7
+
let indent_lines = List.map indent
8
+
9
+
let abstract_module name values =
10
+
Printf.sprintf "module %s : sig" name ::
11
+
" type t" ::
12
+
(List.map (indent % sig_val) values) @
13
+
["end = struct";
14
+
" type t = int"
15
+
] @ List.map (indent % hex_val) values @ [
16
+
"end"
17
+
]
18
+
19
+
let hex_module name values =
20
+
Printf.sprintf "module %s = struct" name ::
21
+
List.map (indent % hex_val) values @
22
+
["end"]
+3
lib/uring/primitives.h
+3
lib/uring/primitives.h
···
87
87
CAMLprim value ocaml_uring_submit_linkat_native(value, value, value, value, value, value, value);
88
88
CAMLprim value ocaml_uring_submit_linkat_byte(value *, int);
89
89
CAMLprim value ocaml_uring_submit_unlinkat(value, value, value, value, value);
90
+
CAMLprim value ocaml_uring_submit_mkdirat(value, value, value, value, value);
90
91
CAMLprim value ocaml_uring_submit_send_msg(value, value, value, value, value);
91
92
CAMLprim value ocaml_uring_submit_recv_msg(value, value, value, value, value);
93
+
CAMLprim value ocaml_uring_submit_fsync(value, value, value, value, value);
94
+
CAMLprim value ocaml_uring_submit_fdatasync(value, value, value, value, value);
92
95
CAMLprim value ocaml_uring_wait_cqe(value);
93
96
CAMLprim value ocaml_uring_wait_cqe_timeout(value, value);
94
97
CAMLprim value ocaml_uring_peek_cqe(value);