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
|
/**************************************************************************/
/* */
/* 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
#include <stddef.h>
#include "caml/alloc.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/osdeps.h"
#include "unixsupport.h"
#define caml_uerror(func, arg) \
do { caml_win32_maperr(GetLastError()); caml_uerror(func, arg); } while(0)
/* Defined in [mmap_ba.c] */
extern value caml_unix_mapped_alloc(int, int, void *, intnat *);
#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER (-1)
#endif
static __int64 caml_set_file_pointer(HANDLE h, __int64 dist, DWORD mode)
{
LARGE_INTEGER i;
DWORD err;
i.QuadPart = dist;
i.LowPart = SetFilePointer(h, i.LowPart, &i.HighPart, mode);
if (i.LowPart == INVALID_SET_FILE_POINTER) return -1;
return i.QuadPart;
}
CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
value vshared, value vdim, value vstart)
{
HANDLE fd, fmap;
int flags, major_dim, mode, perm;
intnat num_dims, i;
intnat dim[CAML_BA_MAX_NUM_DIMS];
__int64 currpos, startpos, file_size, data_size;
uintnat array_size, page, delta;
char c;
void * addr;
LARGE_INTEGER li;
SYSTEM_INFO sysinfo;
fd = Handle_val(vfd);
flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout);
startpos = Int64_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 (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 */
currpos = caml_set_file_pointer(fd, 0, FILE_CURRENT);
if (currpos == -1) caml_uerror("map_file", Nothing);
file_size = caml_set_file_pointer(fd, 0, FILE_END);
if (file_size == -1) caml_uerror("map_file", Nothing);
/* 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 (i = 0; i < num_dims; i++)
if (dim[i] != -1) array_size *= dim[i];
/* Check if the first/last dimension is unknown */
if (dim[major_dim] == -1) {
/* Determine first/last dimension from file size */
if (file_size < startpos)
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_failwith("Unix.map_file: file size doesn't match array dimensions");
}
/* Restore original file position */
caml_set_file_pointer(fd, currpos, FILE_BEGIN);
/* Create the file mapping */
if (Bool_val(vshared)) {
perm = PAGE_READWRITE;
mode = FILE_MAP_WRITE;
} else {
perm = PAGE_READONLY; /* doesn't work under Win98 */
mode = FILE_MAP_COPY;
}
li.QuadPart = startpos + array_size;
fmap = CreateFileMapping(fd, NULL, perm, li.HighPart, li.LowPart, NULL);
if (fmap == NULL) caml_uerror("map_file", Nothing);
/* Determine offset so that the mapping starts at the given file pos */
GetSystemInfo(&sysinfo);
delta = (uintnat) (startpos % sysinfo.dwAllocationGranularity);
/* Map the mapping in memory */
li.QuadPart = startpos - delta;
addr =
MapViewOfFile(fmap, mode, li.HighPart, li.LowPart, array_size + delta);
if (addr == NULL) caml_uerror("map_file", Nothing);
addr = (void *) ((uintnat) addr + delta);
/* Close the file mapping */
CloseHandle(fmap);
/* Build and return the OCaml bigarray */
return caml_unix_mapped_alloc(flags, num_dims, addr, dim);
}
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)
{
SYSTEM_INFO sysinfo;
uintnat delta;
GetSystemInfo(&sysinfo);
delta = (uintnat) addr % sysinfo.dwAllocationGranularity;
UnmapViewOfFile((void *)((uintnat)addr - delta));
}
|
