CAMLprim value caml_sys_getcwd(value unit)
{
char buff[4096];
#ifdef HAS_GETCWD
if (getcwd(buff, sizeof(buff)) == 0) caml_sys_error(NO_ARG);
#else
if (getwd(buff) == 0) caml_sys_error(NO_ARG);
#endif /* HAS_GETCWD */
return caml_copy_string(buff);
}
CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
{
caml_flush(channel);
caml_sys_error(NO_ARG);
caml_leave_blocking_section();
channel->offset = dest;
}
CAMLprim value caml_sys_remove(value name)
{
int ret;
ret = unlink(String_val(name));
if (ret != 0) caml_sys_error(name);
return Val_unit;
}
CAMLprim value caml_sys_is_directory(value name)
{
CAMLparam1(name);
#ifdef _WIN32
struct _stati64 st;
#else
struct stat st;
#endif
char * p;
int ret;
p = caml_strdup(String_val(name));
caml_enter_blocking_section();
#ifdef _WIN32
ret = _stati64(p, &st);
#else
ret = stat(p, &st);
#endif
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) caml_sys_error(name);
#ifdef S_ISDIR
CAMLreturn(Val_bool(S_ISDIR(st.st_mode)));
#else
CAMLreturn(Val_bool(st.st_mode & S_IFDIR));
#endif
}
CAMLprim value caml_ml_close_channel(value vchannel)
{
int result;
int do_syscall;
int fd;
/* For output channels, must have flushed before */
struct channel * channel = Channel(vchannel);
if (channel->fd != -1){
fd = channel->fd;
channel->fd = -1;
do_syscall = 1;
}else{
do_syscall = 0;
result = 0;
}
/* Ensure that every read or write on the channel will cause an
immediate caml_flush_partial or caml_refill, thus raising a Sys_error
exception */
channel->curr = channel->max = channel->end;
if (do_syscall) {
caml_enter_blocking_section();
result = close(fd);
caml_leave_blocking_section();
}
if (result == -1) caml_sys_error (NO_ARG);
return Val_unit;
}
CAMLexport void caml_sys_io_error(value arg)
{
if (errno == EAGAIN || errno == EWOULDBLOCK) {
caml_raise_sys_blocked_io();
} else {
caml_sys_error(arg);
}
}
CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
{
#if defined(_WIN32) || defined(__CYGWIN__)
struct channel * channel = Channel(vchannel);
if (setmode(channel->fd, Bool_val(mode) ? O_BINARY : O_TEXT) == -1)
caml_sys_error(NO_ARG);
#endif
return Val_unit;
}
CAMLprim value caml_sys_is_directory(value name)
{
struct stat st;
if (stat(String_val(name), &st) == -1) caml_sys_error(name);
#ifdef S_ISDIR
return Val_bool(S_ISDIR(st.st_mode));
#else
return Val_bool(st.st_mode & S_IFDIR);
#endif
}
CAMLexport file_offset caml_channel_size(struct channel *channel)
{
file_offset end;
end = lseek(channel->fd, 0, SEEK_END);
if (end == -1 ||
lseek(channel->fd, channel->offset, SEEK_SET) != channel->offset) {
caml_sys_error(NO_ARG);
}
return end;
}
CAMLexport void caml_seek_in(struct channel *channel, file_offset dest)
{
if (dest >= channel->offset - (channel->max - channel->buff) &&
dest <= channel->offset) {
channel->curr = channel->max - (channel->offset - dest);
} else {
if (lseek(channel->fd, dest, SEEK_SET) != dest) caml_sys_error(NO_ARG);
channel->offset = dest;
channel->curr = channel->max = channel->buff;
}
}
CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
{
caml_flush(channel);
caml_enter_blocking_section();
if (lseek(channel->fd, dest, SEEK_SET) != dest) {
caml_leave_blocking_section();
caml_sys_error(NO_ARG);
}
caml_leave_blocking_section();
channel->offset = dest;
}
CAMLexport void caml_seek_in(struct channel *channel, file_offset dest)
{
if (dest >= channel->offset - (channel->max - channel->buff) &&
dest <= channel->offset) {
channel->curr = channel->max - (channel->offset - dest);
} else {
caml_sys_error(NO_ARG);
caml_leave_blocking_section();
channel->offset = dest;
channel->curr = channel->max = channel->buff;
}
}
CAMLprim value caml_sys_chdir(value dirname)
{
CAMLparam1(dirname);
char * p;
int ret;
p = caml_strdup(String_val(dirname));
caml_enter_blocking_section();
ret = chdir(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret != 0) caml_sys_error(dirname);
CAMLreturn(Val_unit);
}
CAMLprim value caml_sys_remove(value name)
{
CAMLparam1(name);
char * p;
int ret;
p = caml_strdup(String_val(name));
caml_enter_blocking_section();
ret = unlink(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret != 0) caml_sys_error(name);
CAMLreturn(Val_unit);
}
CAMLprim value caml_sys_rename(value oldname, value newname)
{
char * p_old;
char * p_new;
int ret;
p_old = caml_strdup(String_val(oldname));
p_new = caml_strdup(String_val(newname));
caml_enter_blocking_section();
ret = rename(p_old, p_new);
caml_leave_blocking_section();
caml_stat_free(p_new);
caml_stat_free(p_old);
if (ret != 0)
caml_sys_error(NO_ARG);
return Val_unit;
}
CAMLprim value caml_sys_read_directory(value path)
{
CAMLparam1(path);
CAMLlocal1(result);
struct ext_table tbl;
caml_ext_table_init(&tbl, 50);
if (caml_read_directory(String_val(path), &tbl) == -1){
caml_ext_table_free(&tbl, 1);
caml_sys_error(path);
}
caml_ext_table_add(&tbl, NULL);
result = caml_copy_string_array((char const **) tbl.contents);
caml_ext_table_free(&tbl, 1);
CAMLreturn(result);
}
CAMLexport file_offset caml_channel_size(struct channel *channel)
{
file_offset offset;
file_offset end;
int fd;
/* We extract data from [channel] before dropping the OCaml lock, in case
someone else touches the block. */
fd = channel->fd;
offset = channel->offset;
caml_enter_blocking_section();
end = 0;
caml_sys_error(NO_ARG);
caml_leave_blocking_section();
return end;
}
CAMLprim value caml_install_signal_handler(value signal_number, value action)
{
CAMLparam2 (signal_number, action);
CAMLlocal1 (res);
int sig, act, oldact;
sig = caml_convert_signal_number(Int_val(signal_number));
if (sig < 0 || sig >= NSIG)
caml_invalid_argument("Sys.signal: unavailable signal");
switch(action) {
case Val_int(0): /* Signal_default */
act = 0;
break;
case Val_int(1): /* Signal_ignore */
act = 1;
break;
default: /* Signal_handle */
act = 2;
break;
}
oldact = caml_set_signal_action(sig, act);
switch (oldact) {
case 0: /* was Signal_default */
res = Val_int(0);
break;
case 1: /* was Signal_ignore */
res = Val_int(1);
break;
case 2: /* was Signal_handle */
res = caml_alloc_small (1, 0);
Field(res, 0) = Field(caml_signal_handlers, sig);
break;
default: /* error in caml_set_signal_action */
caml_sys_error(NO_ARG);
}
if (Is_block(action)) {
if (caml_signal_handlers == 0) {
caml_signal_handlers = caml_alloc(NSIG, 0);
caml_register_global_root(&caml_signal_handlers);
}
caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
}
caml_process_pending_signals();
CAMLreturn (res);
}
CAMLprim value caml_sys_system_command(value command)
{
CAMLparam1 (command);
int status, retcode;
char *buf;
buf = caml_strdup(String_val(command));
caml_enter_blocking_section ();
status = system(buf);
caml_leave_blocking_section ();
caml_stat_free(buf);
if (status == -1) caml_sys_error(command);
if (WIFEXITED(status))
retcode = WEXITSTATUS(status);
else
retcode = 255;
CAMLreturn (Val_int(retcode));
}
CAMLexport file_offset caml_channel_size(struct channel *channel)
{
file_offset offset;
file_offset end;
int fd;
/* We extract data from [channel] before dropping the Caml lock, in case
someone else touches the block. */
fd = channel->fd;
offset = channel->offset;
caml_enter_blocking_section();
end = lseek(fd, 0, SEEK_END);
if (end == -1 || lseek(fd, offset, SEEK_SET) != offset) {
caml_leave_blocking_section();
caml_sys_error(NO_ARG);
}
caml_leave_blocking_section();
return end;
}
CAMLprim value caml_sys_open(value path, value vflags, value vperm)
{
CAMLparam3(path, vflags, vperm);
int fd, flags, perm;
char * p;
p = caml_stat_alloc(caml_string_length(path) + 1);
strcpy(p, String_val(path));
flags = caml_convert_flag_list(vflags, sys_open_flags);
perm = Int_val(vperm);
/* open on a named FIFO can block (PR#1533) */
caml_enter_blocking_section();
fd = open(p, flags, perm);
caml_leave_blocking_section();
caml_stat_free(p);
if (fd == -1) caml_sys_error(path);
#if defined(F_SETFD) && defined(FD_CLOEXEC)
fcntl(fd, F_SETFD, FD_CLOEXEC);
#endif
CAMLreturn(Val_long(fd));
}
CAMLprim value caml_sys_read_directory(value path)
{
CAMLparam1(path);
CAMLlocal1(result);
struct ext_table tbl;
char * p;
int ret;
caml_ext_table_init(&tbl, 50);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = caml_read_directory(p, &tbl);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1){
caml_ext_table_free(&tbl, 1);
caml_sys_error(path);
}
caml_ext_table_add(&tbl, NULL);
result = caml_copy_string_array((char const **) tbl.contents);
caml_ext_table_free(&tbl, 1);
CAMLreturn(result);
}
CAMLexport void caml_sys_io_error(value arg)
{
caml_sys_error(arg);
}
CAMLprim value caml_ml_pos_in(value vchannel)
{
file_offset pos = caml_pos_in(Channel(vchannel));
if (pos > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
return Val_long(pos);
}
CAMLprim value caml_ml_channel_size(value vchannel)
{
file_offset size = caml_channel_size(Channel(vchannel));
if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
return Val_long(size);
}
CAMLprim value caml_channel_descriptor(value vchannel)
{
int fd = Channel(vchannel)->fd;
if (fd == -1) { errno = EBADF; caml_sys_error(NO_ARG); }
return Val_int(fd);
}
CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
{
caml_flush(channel);
if (lseek(channel->fd, dest, SEEK_SET) != dest) caml_sys_error(NO_ARG);
channel->offset = dest;
}
CAMLprim value caml_sys_rename(value oldname, value newname)
{
if (rename(String_val(oldname), String_val(newname)) != 0)
caml_sys_error(NO_ARG);
return Val_unit;
}
CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
value vshared, value vdim, value vstart)
{
int fd, flags, major_dim, shared;
intnat num_dims, i;
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 = Int_val(vkind) | Int_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("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. 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_sys_error(NO_ARG);
}
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 (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("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_leave_blocking_section();
caml_failwith("Bigarray.mmap: 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_sys_error(NO_ARG);
}
}
}
/* Determine offset so that the mapping starts at the given file pos */
page = getpagesize();
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_sys_error(NO_ARG);
addr = (void *) ((uintnat) addr + delta);
/* Build and return the OCaml bigarray */
return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
}
CAMLprim value caml_sys_chdir(value dirname)
{
if (chdir(String_val(dirname)) != 0) caml_sys_error(dirname);
return Val_unit;
}
