Skip to content
This repository was archived by the owner on Oct 24, 2020. It is now read-only.

Commit 0bbde47

Browse files
author
Christopher Zimmermann
committed
Add file-descriptor I/O functions
1 parent 8aadb56 commit 0bbde47

File tree

5 files changed

+178
-1
lines changed

5 files changed

+178
-1
lines changed

‎bigstring-unix.opam‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ name: "bigstring-unix"
33
version: "0.2"
44
authors: "Simon Cruanes <simon.cruanes.2007@m4x.org>"
55
maintainer: "Simon Cruanes <simon.cruanes.2007@m4x.org>"
6-
synopsis: "A set of utils for dealing with `bigarrays` of `char` and memory-mapping"
6+
synopsis: "I/O functions for bigstrings using file descriptors and memory-maps"
77
tags: [ "bigstring" "bigarray" ]
88
homepage: "https://github.com/c-cube/ocaml-bigstring/"
99
bug-reports: "https://github.com/c-cube/ocaml-bigstring/issues"

‎src/bigstring_unix.ml‎

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,36 @@
33

44
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
55

6+
(** {2 I/O} *)
7+
8+
let[@inline never] invalid_bounds op buffer_len off len =
9+
let message =
10+
Printf.sprintf "Bigstring_unix.%s invalid range: { buffer_len: %d, off: %d, len: %d }"
11+
op buffer_len off len
12+
in
13+
raise (Invalid_argument message)
14+
15+
let get_bounds name ?(off=0) ?len t =
16+
let buffer_len = Bigarray.Array1.dim t in
17+
let len = match len with
18+
| Some len -> len
19+
| None -> buffer_len
20+
in
21+
if len < 0 || off < 0 || buffer_len - off < len
22+
then invalid_bounds name buffer_len off len
23+
else (off, len)
24+
25+
external read_fd : Unix.file_descr -> Bigstring.t -> int -> int -> int = "bigstring_read"
26+
external write_fd : Unix.file_descr -> Bigstring.t -> int -> int -> int = "bigstring_write"
27+
28+
let read fd ?off ?len t =
29+
let off, len = get_bounds "read" ?off ?len t in
30+
read_fd fd t off len
31+
and write fd ?off ?len t =
32+
let off, len = get_bounds "write" ?off ?len t in
33+
write_fd fd t off len
34+
35+
636
(** {2 Memory-map} *)
737

838
let map_file_descr ?pos ?(shared=false) fd len =

‎src/bigstring_unix.mli‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,15 @@ type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
66
on [Bigstring].
77
@since 0.3 *)
88

9+
(** {2 I/O} *)
10+
11+
(** These I/O functions are missing from the Bigarray library.
12+
They release the runtime during I/O. *)
13+
14+
val read : Unix.file_descr -> ?off:int -> ?len:int -> Bigstring.t -> int
15+
val write : Unix.file_descr -> ?off:int -> ?len:int -> Bigstring.t -> int
16+
17+
918
(** {2 Memory-map} *)
1019

1120
val with_map_file :

‎src/bigstring_unix_stubs.c‎

Lines changed: 136 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,136 @@
1+
/*
2+
* Copyright (c) 2019, Christopher Zimmermann
3+
*
4+
* Permission to use, copy, modify, and/or distribute this software for any
5+
* purpose with or without fee is hereby granted, provided that the above
6+
* copyright notice and this permission notice appear in all copies.
7+
*
8+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
11+
* SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
13+
* OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
14+
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15+
*/
16+
17+
18+
#include <unistd.h>
19+
#include <caml/mlvalues.h>
20+
#include <caml/bigarray.h>
21+
#include <caml/unixsupport.h>
22+
#include <caml/threads.h>
23+
24+
CAMLprim value
25+
bigstring_read(value vfd, value vba, value voff, value vlen)
26+
{
27+
void *iobuf = ((char *)Caml_ba_data_val(vba)) + Unsigned_long_val(voff);
28+
#ifdef Handle_val
29+
unsigned len;
30+
int err;
31+
32+
if (Descr_kind_val(fd) == KIND_SOCKET) {
33+
SOCKET s = Socket_val(fd);
34+
caml_release_runtime_system();
35+
if ((err = recv(s, iobuf, Unsigned_int_val(vlen), 0)) < 0)
36+
err = WSAGetLastError();
37+
else {
38+
len = err;
39+
err = 0;
40+
}
41+
caml_acquire_runtime_system();
42+
} else {
43+
HANDLE h = Handle_val(fd);
44+
caml_release_runtime_system();
45+
if (ReadFile(h, iobuf, Unsigned_int_val(vlen), &len, NULL))
46+
err = 0;
47+
else {
48+
check_error:
49+
switch (err = GetLastError()) {
50+
case ERROR_BROKEN_PIPE:
51+
/* This is no error, but just a closed pipe. */
52+
err = len = 0;
53+
break;
54+
case ERROR_MORE_DATA:
55+
#if 0
56+
do {
57+
char buf[1024];
58+
unsigned dummy_len;
59+
if (ReadFile(h, buf, sizeof(buf), &dummy_len, NULL))
60+
break;
61+
else
62+
goto check_error;
63+
} while (0);
64+
#else
65+
err = 0;
66+
#endif
67+
default:
68+
break;
69+
}
70+
caml_acquire_runtime_system();
71+
}
72+
/* GetLastError() and WSAGetLastError() error numbers _are_ compatible,
73+
* although not documented this behaviour will hopefully never change. */
74+
if (err) {
75+
win32_maperr(err);
76+
uerror("read", Nothing);
77+
}
78+
else
79+
return Val_int(len);
80+
81+
#else
82+
ssize_t ret;
83+
84+
caml_release_runtime_system();
85+
ret = read(Int_val(vfd), iobuf, Unsigned_long_val(vlen));
86+
caml_acquire_runtime_system();
87+
if (ret < 0) uerror("Bigstringaf.read", Nothing);
88+
return Val_long(ret);
89+
#endif
90+
}
91+
92+
CAMLprim value
93+
bigstring_write(value vfd, value vba, value voff, value vlen)
94+
{
95+
char *iobuf = ((char *)Caml_ba_data_val(vba)) + Unsigned_long_val(voff);
96+
#ifdef Handle_val
97+
unsigned len;
98+
int err;
99+
100+
if (Descr_kind_val(fd) == KIND_SOCKET) {
101+
SOCKET s = Socket_val(vfd);
102+
caml_release_runtime_system();
103+
if ((err = send(s, iobuf, Unsigned_int_val(vlen), 0)) < 0)
104+
err = WSAGetLastError();
105+
else {
106+
len = err;
107+
err = 0;
108+
}
109+
caml_acquire_runtime_system();
110+
} else {
111+
HANDLE h = Handle_val(vfd);
112+
caml_release_runtime_system();
113+
if (WriteFile(h, iobuf, Unsigned_int_val(vlen), &len, NULL))
114+
err = 0;
115+
else
116+
err = GetLastError();
117+
caml_acquire_runtime_system();
118+
}
119+
/* GetLastError() and WSAGetLastError() error numbers _are_ compatible,
120+
* although not documented this behaviour will hopefully never change. */
121+
if (err) {
122+
win32_maperr(err);
123+
uerror("Bigstringaf.write", Nothing);
124+
}
125+
return Val_long(numwritten);
126+
127+
#else
128+
ssize_t ret;
129+
130+
caml_release_runtime_system();
131+
ret = write(Int_val(vfd), iobuf, Unsigned_long_val(vlen));
132+
caml_acquire_runtime_system();
133+
if (ret < 0) uerror("Bigstringaf.write", Nothing);
134+
return Val_long(ret);
135+
#endif
136+
}

‎src/dune‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,5 +19,7 @@
1919
(public_name bigstring-unix)
2020
(modules Bigstring_compat Bigstring_unix)
2121
(flags :standard -warn-error -3) ; deprecation
22+
(c_names bigstring_unix_stubs)
23+
(c_flags (-Wall -Wextra -Wpedantic))
2224
(synopsis "Bigstrings from Unix memory mapping.")
2325
(libraries bigarray unix))

0 commit comments

Comments
 (0)