Skip to content

Commit 7e79ad8

Browse files
lindiglindig
authored
Merge pull request #24 from lindig/private/christianlin/CP-311786
Improve OCaml 5 compatibility
2 parents c7cbd15 + 892068d commit 7e79ad8

3 files changed

Lines changed: 124 additions & 47 deletions

File tree

‎Makefile‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,11 @@ DUNE = dune
22
JOBS = $(shell getconf _NPROCESSORS_ONLN)
33
PROFILE = release
44

5+
# K&R style indentation, could use in format target below
6+
INDENT += -nbad -bap -nbc -br -brs -c33 -cd33 -ncdb -ce -ci4 -cli0
7+
INDENT += -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs
8+
INDENT += -npsl -nsc -nsob
9+
510
.PHONY: build check test clean format install
611

712
build:

‎mmap/xenmmap_stubs.c‎

Lines changed: 18 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@
3030
#include <caml/fail.h>
3131
#include <caml/callback.h>
3232
#include <caml/unixsupport.h>
33+
#include <caml/threads.h>
3334

3435
#define Intf_val(a) ((struct mmap_interface *)Data_abstract_val(a))
3536
#define Wsize_bsize_round(n) (Wsize_bsize( (n) + sizeof(value) - 1 ))
@@ -89,10 +90,15 @@ stub_mmap_init (value fd, value pflag, value mflag, value len, value offset)
8990
caml_invalid_argument ("negative size");
9091
if (Int_val (offset) < 0)
9192
caml_invalid_argument ("negative offset");
92-
length = Int_val (len);
93+
length = Long_val (len);
94+
95+
int c_fd = Int_val (fd);
96+
size_t c_offset = Long_val (offset);
97+
98+
caml_release_runtime_system ();
99+
addr = mmap (NULL, length, c_pflag, c_mflag, c_fd, c_offset);
100+
caml_acquire_runtime_system ();
93101

94-
addr = mmap (NULL, length, c_pflag, c_mflag, Int_val (fd),
95-
Int_val (offset));
96102
if (MAP_FAILED == addr)
97103
uerror ("mmap", Nothing);
98104

@@ -104,9 +110,16 @@ CAMLprim value
104110
stub_mmap_final (value intf)
105111
{
106112
CAMLparam1 (intf);
113+
void *addr = Intf_val (intf)->addr;
114+
115+
if (addr != MAP_FAILED)
116+
{
117+
int len = Intf_val (intf)->len;
118+
caml_release_runtime_system ();
119+
munmap (addr, len);
120+
caml_acquire_runtime_system ();
121+
}
107122

108-
if (Intf_val (intf)->addr != MAP_FAILED)
109-
munmap (Intf_val (intf)->addr, Intf_val (intf)->len);
110123
Intf_val (intf)->addr = MAP_FAILED;
111124

112125
CAMLreturn (Val_unit);

‎ocaml-evtchn/lib/eventchn_stubs.c‎

Lines changed: 101 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -32,86 +32,128 @@
3232
#include <caml/custom.h>
3333
#include <caml/callback.h>
3434
#include <caml/fail.h>
35+
#include <caml/threads.h>
3536

36-
#define _H(__h) ((xenevtchn_handle *)(__h))
37-
#define XENEVTCHN_NO_CLOEXEC (1 << 0)
37+
static inline xenevtchn_handle *
38+
xce_of_val (value v)
39+
{
40+
return *(xenevtchn_handle **) Data_custom_val (v);
41+
}
42+
43+
static void
44+
stub_evtchn_finalize (value v)
45+
{
46+
xenevtchn_close (xce_of_val (v));
47+
}
3848

39-
xenevtchn_handle *global_xce = NULL;
49+
static struct custom_operations xenevtchn_ops = {
50+
.identifier = "xenevtchn",
51+
.finalize = stub_evtchn_finalize,
52+
.compare = custom_compare_default, /* Can't compare */
53+
.hash = custom_hash_default, /* Can't hash */
54+
.serialize = custom_serialize_default, /* Can't serialize */
55+
.deserialize = custom_deserialize_default, /* Can't deserialize */
56+
.compare_ext = custom_compare_ext_default, /* Can't compare */
57+
};
4058

4159
CAMLprim value
4260
stub_evtchn_init (value cloexec)
4361
{
4462
CAMLparam1 (cloexec);
63+
CAMLlocal1 (result);
64+
xenevtchn_handle *xce;
4565
unsigned int flags = 0;
66+
4667
if (!Bool_val (cloexec))
4768
flags |= XENEVTCHN_NO_CLOEXEC;
4869

49-
if (global_xce == NULL)
70+
result = caml_alloc_custom (&xenevtchn_ops, sizeof (xce), 0, 1);
71+
72+
caml_release_runtime_system ();
73+
xce = xenevtchn_open (NULL, flags);
74+
caml_acquire_runtime_system ();
75+
76+
if (xce == NULL)
5077
{
51-
global_xce = xenevtchn_open (NULL, flags);
78+
caml_failwith (strerror (errno));
5279
}
5380

54-
if (global_xce == NULL)
55-
caml_failwith (strerror (errno));
56-
57-
CAMLreturn ((value) global_xce);
81+
*(xenevtchn_handle **) Data_custom_val (result) = xce;
82+
CAMLreturn (result);
5883
}
5984

6085
CAMLprim value
61-
stub_evtchn_fd (value xce)
86+
stub_evtchn_fd (value xce_val)
6287
{
63-
CAMLparam1 (xce);
88+
CAMLparam1 (xce_val);
89+
xenevtchn_handle *xce = xce_of_val (xce_val);
6490
int fd;
6591

66-
fd = xenevtchn_fd (_H (xce));
92+
/* Don't drop the GC lock. This is a simple read out of memory */
93+
fd = xenevtchn_fd (xce);
6794
if (fd == -1)
6895
{
69-
perror ("xc_evtchn_fd");
7096
caml_failwith (strerror (errno));
7197
}
98+
7299
CAMLreturn (Val_int (fd));
73100
}
74101

75102
CAMLprim value
76-
stub_evtchn_notify (value xce, value port)
103+
stub_evtchn_notify (value xce_val, value port_val)
77104
{
78-
CAMLparam2 (xce, port);
79-
if (xenevtchn_notify (_H (xce), Int_val (port)) == -1)
105+
CAMLparam2 (xce_val, port_val);
106+
xenevtchn_handle *xce = xce_of_val (xce_val);
107+
int rc;
108+
int port = Int_val (port_val);
109+
110+
caml_release_runtime_system ();
111+
rc = xenevtchn_notify (xce, port);
112+
caml_acquire_runtime_system ();
113+
114+
if (rc == -1)
80115
{
81-
perror ("xc_evtchn_notify");
82116
caml_failwith (strerror (errno));
83117
}
84118

85119
CAMLreturn (Val_unit);
86120
}
87121

88122
CAMLprim value
89-
stub_evtchn_bind_interdomain (value xce, value domid, value remote_port)
123+
stub_evtchn_bind_interdomain (value xce_val, value domid_val,
124+
value remote_port_val)
90125
{
91-
CAMLparam3 (xce, domid, remote_port);
126+
CAMLparam3 (xce_val, domid_val, remote_port_val);
127+
xenevtchn_handle *xce = xce_of_val (xce_val);
92128
xenevtchn_port_or_error_t rc;
129+
int domid = Int_val (domid_val);
130+
int remote_port = Int_val (remote_port_val);
131+
132+
caml_release_runtime_system ();
133+
rc = xenevtchn_bind_interdomain (xce, domid, remote_port);
134+
caml_acquire_runtime_system ();
93135

94-
rc = xenevtchn_bind_interdomain (_H (xce), Int_val (domid),
95-
Int_val (remote_port));
96136
if (rc == -1)
97137
{
98-
perror ("xc_evtchn_bind_interdomain");
99138
caml_failwith (strerror (errno));
100139
}
101140

102141
CAMLreturn (Val_int (rc));
103142
}
104143

105144
CAMLprim value
106-
stub_evtchn_alloc_unbound (value xce, value remote_domid)
145+
stub_evtchn_alloc_unbound (value xce_val, value remote_domid_val)
107146
{
108-
CAMLparam2 (xce, remote_domid);
147+
CAMLparam2 (xce_val, remote_domid_val);
148+
xenevtchn_handle *xce = xce_of_val (xce_val);
109149
xenevtchn_port_or_error_t rc;
150+
int remote_domid = Int_val (remote_domid_val);
110151

111-
rc = xenevtchn_bind_unbound_port (_H (xce), Int_val (remote_domid));
152+
caml_release_runtime_system ();
153+
rc = xenevtchn_bind_unbound_port (xce, remote_domid);
154+
caml_acquire_runtime_system ();
112155
if (rc == -1)
113156
{
114-
perror ("xc_evtchn_bind_unbound_port");
115157
caml_failwith (strerror (errno));
116158
}
117159

@@ -127,47 +169,58 @@ stub_evtchn_virq_dom_exc (value unit)
127169
}
128170

129171
CAMLprim value
130-
stub_evtchn_bind_virq (value xce, value virq)
172+
stub_evtchn_bind_virq (value xce_val, value virq_val)
131173
{
132-
CAMLparam2 (xce, virq);
174+
CAMLparam2 (xce_val, virq_val);
133175
xenevtchn_port_or_error_t rc;
176+
xenevtchn_handle *xce = xce_of_val (xce_val);
177+
int virq = Int_val (virq_val);
134178

135-
rc = xenevtchn_bind_virq (_H (xce), Int_val (virq));
179+
caml_release_runtime_system ();
180+
rc = xenevtchn_bind_virq (xce, virq);
181+
caml_acquire_runtime_system ();
136182
if (rc == -1)
137183
{
138-
perror ("xc_evtchn_bind_virq");
139184
caml_failwith (strerror (errno));
140185
}
141186

142187
CAMLreturn (Val_int (rc));
143188
}
144189

145190
CAMLprim value
146-
stub_evtchn_unbind (value xce, value port)
191+
stub_evtchn_unbind (value xce_val, value port_val)
147192
{
148-
CAMLparam2 (xce, port);
149-
if (xenevtchn_unbind (_H (xce), Int_val (port)) == -1)
193+
CAMLparam2 (xce_val, port_val);
194+
xenevtchn_handle *xce = xce_of_val (xce_val);
195+
int port = Int_val (port_val);
196+
int rc;
197+
198+
caml_release_runtime_system ();
199+
rc = xenevtchn_unbind (xce, port);
200+
caml_acquire_runtime_system ();
201+
if (rc == -1)
150202
{
151-
perror ("xc_evtchn_unbind");
152203
caml_failwith (strerror (errno));
153204
}
154205

155206
CAMLreturn (Val_unit);
156207
}
157208

158209
CAMLprim value
159-
stub_evtchn_pending (value xce)
210+
stub_evtchn_pending (value xce_val)
160211
{
161-
CAMLparam1 (xce);
212+
CAMLparam1 (xce_val);
162213
CAMLlocal1 (generation);
163214
xenevtchn_port_or_error_t port;
215+
xenevtchn_handle *xce = xce_of_val (xce_val);
164216

165217
generation = caml_alloc_tuple (2);
166218

167-
port = xenevtchn_pending (_H (xce));
219+
caml_release_runtime_system ();
220+
port = xenevtchn_pending (xce);
221+
caml_acquire_runtime_system ();
168222
if (port == -1)
169223
{
170-
perror ("xc_evtchn_pending");
171224
caml_failwith (strerror (errno));
172225
}
173226

@@ -178,12 +231,18 @@ stub_evtchn_pending (value xce)
178231
}
179232

180233
CAMLprim value
181-
stub_evtchn_unmask (value xce, value port)
234+
stub_evtchn_unmask (value xce_val, value port_val)
182235
{
183-
CAMLparam2 (xce, port);
184-
if (xenevtchn_unmask (_H (xce), Int_val (port)) == -1)
236+
CAMLparam2 (xce_val, port_val);
237+
xenevtchn_handle *xce = xce_of_val (xce_val);
238+
int port = Int_val (port_val);
239+
int rc;
240+
241+
caml_release_runtime_system ();
242+
rc = xenevtchn_unmask (xce, port);
243+
caml_acquire_runtime_system ();
244+
if (rc == -1)
185245
{
186-
perror ("xc_evtchn_unmask");
187246
caml_failwith (strerror (errno));
188247
}
189248

0 commit comments

Comments
 (0)