1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
/**************************************************************************/
/* */
/* OCaml */
/* */
/* Manuel Serrano and Xavier Leroy, INRIA Rocquencourt */
/* */
/* Copyright 2000 Institut National de Recherche en Informatique et */
/* en Automatique. */
/* */
/* All rights reserved. This file is distributed under the terms of */
/* the GNU Lesser General Public License version 2.1, with the */
/* special exception on linking described in the file LICENSE. */
/* */
/**************************************************************************/
#define CAML_INTERNALS
/* Needed (under Linux at least) to get pwrite's prototype in unistd.h.
Must be defined before the first system .h is included. */
#define _XOPEN_SOURCE 600
#include <stddef.h>
#include "caml/bigarray.h"
#include "caml/fail.h"
#include "caml/io.h"
#include "caml/mlvalues.h"
#include "caml/signals.h"
#include "caml/sys.h"
#include "caml/unixsupport.h"
#include <errno.h>
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
#ifdef HAS_MMAP
#include <sys/types.h>
#include <sys/mman.h>
#include <sys/stat.h>
#endif
/* Defined in [mmap_ba.c] */
extern value caml_unix_mapped_alloc(int, int, void *, intnat *);
#if defined(HAS_MMAP)
#ifndef MAP_FAILED
#define MAP_FAILED ((void *) -1)
#endif
/* [caml_grow_file] function contributed by Gerd Stolpmann (PR#5543). */
static int caml_grow_file(int fd, file_offset size)
{
char c;
int p;
/* First use pwrite for growing - it is a conservative method, as it
can never happen that we shrink by accident
*/
#ifdef HAS_PWRITE
c = 0;
p = pwrite(fd, &c, 1, size - 1);
#else
/* Emulate pwrite with lseek. This should only be necessary on ancient
systems nowadays
*/
file_offset currpos;
currpos = lseek(fd, 0, SEEK_CUR);
if (currpos != -1) {
p = lseek(fd, size - 1, SEEK_SET);
if (p != -1) {
c = 0;
p = write(fd, &c, 1);
if (p != -1)
p = lseek(fd, currpos, SEEK_SET);
}
}
else p=-1;
#endif
#ifdef HAS_TRUNCATE
if (p == -1 && errno == ESPIPE) {
/* Plan B. Check if at least ftruncate is possible. There are
some non-seekable descriptor types that do not support pwrite
but ftruncate, like shared memory. We never get into this case
for real files, so there is no danger of truncating persistent
data by accident
*/
p = ftruncate(fd, size);
}
#endif
return p;
}
CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
value vshared, value vdim, value vstart)
{
int fd, flags, major_dim, shared;
intnat num_dims;
intnat dim[CAML_BA_MAX_NUM_DIMS];
file_offset startpos, file_size, data_size;
struct stat st;
uintnat array_size, page, delta;
void * addr;
fd = Int_val(vfd);
flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout);
startpos = File_offset_val(vstart);
num_dims = Wosize_val(vdim);
major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
/* Extract dimensions from OCaml array */
num_dims = Wosize_val(vdim);
if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_invalid_argument("Unix.map_file: bad number of dimensions");
for (intnat i = 0; i < num_dims; i++) {
dim[i] = Long_val(Field(vdim, i));
if (dim[i] == -1 && i == major_dim) continue;
if (dim[i] < 0)
caml_invalid_argument("Unix.map_file: negative dimension");
}
/* Determine file size. We avoid lseek here because it is fragile,
and because some mappable file types do not support it
*/
caml_enter_blocking_section();
if (fstat(fd, &st) == -1) {
caml_leave_blocking_section();
caml_uerror("map_file", Nothing);
}
file_size = st.st_size;
/* Determine array size in bytes (or size of array without the major
dimension if that dimension wasn't specified) */
array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
for (intnat i = 0; i < num_dims; i++)
if (dim[i] != -1) array_size *= dim[i];
/* Check if the major dimension is unknown */
if (dim[major_dim] == -1) {
/* Determine major dimension from file size */
if (file_size < startpos) {
caml_leave_blocking_section();
caml_failwith("Unix.map_file: file position exceeds file size");
}
data_size = file_size - startpos;
dim[major_dim] = (uintnat) (data_size / array_size);
array_size = dim[major_dim] * array_size;
if (array_size != data_size) {
caml_leave_blocking_section();
caml_failwith("Unix.map_file: file size doesn't match array dimensions");
}
} else {
/* Check that file is large enough, and grow it otherwise */
if (file_size < startpos + array_size) {
if (caml_grow_file(fd, startpos + array_size) == -1) { /* PR#5543 */
caml_leave_blocking_section();
caml_uerror("map_file", Nothing);
}
}
}
/* Determine offset so that the mapping starts at the given file pos */
page = sysconf(_SC_PAGESIZE);
delta = (uintnat) startpos % page;
/* Do the mmap */
shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE;
if (array_size > 0)
addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE,
shared, fd, startpos - delta);
else
addr = NULL; /* PR#5463 - mmap fails on empty region */
caml_leave_blocking_section();
if (addr == (void *) MAP_FAILED) caml_uerror("map_file", Nothing);
addr = (void *) ((uintnat) addr + delta);
/* Build and return the OCaml bigarray */
return caml_unix_mapped_alloc(flags, num_dims, addr, dim);
}
#else
CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
value vshared, value vdim, value vpos)
{
caml_invalid_argument("Unix.map_file: not supported");
return Val_unit;
}
#endif
CAMLprim value caml_unix_map_file_bytecode(value * argv, int argn)
{
return caml_unix_map_file(argv[0], argv[1], argv[2],
argv[3], argv[4], argv[5]);
}
void caml_ba_unmap_file(void * addr, uintnat len)
{
#if defined(HAS_MMAP)
uintnat page = sysconf(_SC_PAGESIZE);
uintnat delta = (uintnat) addr % page;
if (len == 0) return; /* PR#5463 */
addr = (void *)((uintnat)addr - delta);
len = len + delta;
#if defined(_POSIX_SYNCHRONIZED_IO)
msync(addr, len, MS_ASYNC); /* PR#3571 */
#endif
munmap(addr, len);
#endif
}
|
