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
|
/***********************************************************************/
/* */
/* 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 Library General Public License, with */
/* the special exception on linking described in file ../../LICENSE. */
/* */
/***********************************************************************/
/* $Id$ */
#include <stddef.h>
#include <stdio.h>
#include <string.h>
#include "bigarray.h"
#include "alloc.h"
#include "custom.h"
#include "fail.h"
#include "mlvalues.h"
#include "sys.h"
#include "unixsupport.h"
extern int caml_ba_element_size[]; /* from bigarray_stubs.c */
static void caml_ba_sys_error(void);
#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER (-1)
#endif
static __int64 caml_ba_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_ba_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 = Int_val(vkind) | Int_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 Caml array */
num_dims = Wosize_val(vdim);
if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_invalid_argument("Bigarray.mmap: 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("Bigarray.create: negative dimension");
}
/* Determine file size */
currpos = caml_ba_set_file_pointer(fd, 0, FILE_CURRENT);
if (currpos == -1) caml_ba_sys_error();
file_size = caml_ba_set_file_pointer(fd, 0, FILE_END);
if (file_size == -1) caml_ba_sys_error();
/* 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("Bigarray.mmap: 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("Bigarray.mmap: file size doesn't match array dimensions");
}
/* Restore original file position */
caml_ba_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_ba_sys_error();
/* 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_ba_sys_error();
addr = (void *) ((uintnat) addr + delta);
/* Close the file mapping */
CloseHandle(fmap);
/* Build and return the Caml bigarray */
return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
}
CAMLprim value caml_ba_map_file_bytecode(value * argv, int argn)
{
return caml_ba_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));
}
static void caml_ba_sys_error(void)
{
char buffer[512];
DWORD errnum;
errnum = GetLastError();
if (!FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,
errnum,
0,
buffer,
sizeof(buffer),
NULL))
sprintf(buffer, "Unknown error %ld\n", errnum);
caml_raise_sys_error(caml_copy_string(buffer));
}
|
