ocaml/byterun/io.c

394 lines
8.7 KiB
C

/* Buffered input/output. */
#include <errno.h>
#include <fcntl.h>
#include <string.h>
#include <unistd.h>
#include "alloc.h"
#include "fail.h"
#include "io.h"
#include "memory.h"
#include "misc.h"
#include "mlvalues.h"
#include "signals.h"
#include "sys.h"
#ifdef HAS_UI
#include "ui.h"
#endif
/* Common functions. */
struct channel * open_descr(fd)
int fd;
{
struct channel * channel;
channel = (struct channel *) stat_alloc(sizeof(struct channel));
channel->fd = fd;
channel->offset = 0;
channel->curr = channel->max = channel->buff;
channel->end = channel->buff + IO_BUFFER_SIZE;
return channel;
}
value open_descriptor(fd) /* ML */
value fd;
{
return (value) open_descr(Int_val(fd));
}
value channel_descriptor(channel) /* ML */
struct channel * channel;
{
return Val_long(channel->fd);
}
value channel_size(channel) /* ML */
struct channel * channel;
{
long end;
end = lseek(channel->fd, 0, 2);
if (end == -1) sys_error(NULL);
if (lseek(channel->fd, channel->offset, 0) != channel->offset)
sys_error(NULL);
return Val_long(end);
}
/* Output */
static void really_write(fd, p, n)
int fd;
char * p;
int n;
{
int retcode;
while (n > 0) {
#ifdef HAS_UI
retcode = ui_write(fd, p, n);
#else
#ifdef EINTR
do { retcode = write(fd, p, n); } while (retcode == -1 && errno == EINTR);
#else
retcode = write(fd, p, n);
#endif
#endif
if (retcode == -1) sys_error(NULL);
p += retcode;
n -= retcode;
}
}
value flush(channel) /* ML */
struct channel * channel;
{
int n;
n = channel->max - channel->buff;
if (n > 0) {
really_write(channel->fd, channel->buff, n);
channel->offset += n;
channel->curr = channel->buff;
channel->max = channel->buff;
}
return Val_unit;
}
value output_char(channel, ch) /* ML */
struct channel * channel;
value ch;
{
putch(channel, Long_val(ch));
return Val_unit;
}
void putword(channel, w)
struct channel * channel;
uint32 w;
{
putch(channel, w >> 24);
putch(channel, w >> 16);
putch(channel, w >> 8);
putch(channel, w);
}
value output_int(channel, w) /* ML */
struct channel * channel;
value w;
{
putword(channel, Long_val(w));
return Val_unit;
}
void putblock(channel, p, n)
struct channel * channel;
char * p;
unsigned n;
{
unsigned m;
m = channel->end - channel->curr;
if (channel->curr == channel->buff && n >= m) {
really_write(channel->fd, p, n);
channel->offset += n;
} else if (n <= m) {
bcopy(p, channel->curr, n);
channel->curr += n;
if (channel->curr > channel->max) channel->max = channel->curr;
} else {
bcopy(p, channel->curr, m);
p += m;
n -= m;
m = channel->end - channel->buff;
really_write(channel->fd, channel->buff, m);
channel->offset += m;
if (n <= m) {
bcopy(p, channel->buff, n);
channel->curr = channel->max = channel->buff + n;
} else {
really_write(channel->fd, p, n);
channel->offset += n;
channel->curr = channel->max = channel->buff;
}
}
}
value output(channel, buff, start, length) /* ML */
value channel, buff, start, length;
{
putblock((struct channel *) channel,
&Byte(buff, Long_val(start)),
(unsigned) Long_val(length));
return Val_unit;
}
value seek_out(channel, pos) /* ML */
struct channel * channel;
value pos;
{
long dest;
dest = Long_val(pos);
if (dest >= channel->offset &&
dest <= channel->offset + channel->max - channel->buff) {
channel->curr = channel->buff + dest - channel->offset;
} else {
flush(channel);
if (lseek(channel->fd, dest, 0) != dest) sys_error(NULL);
channel->offset = dest;
}
return Val_unit;
}
value pos_out(channel) /* ML */
struct channel * channel;
{
return Val_long(channel->offset + channel->curr - channel->buff);
}
value close_out(channel) /* ML */
struct channel * channel;
{
flush(channel);
close(channel->fd);
stat_free((char *) channel);
return Val_unit;
}
/* Input */
static int really_read(fd, p, n)
int fd;
char * p;
unsigned n;
{
int retcode;
enter_blocking_section();
#ifdef HAS_UI
retcode = ui_read(fd, p, n);
#else
#ifdef EINTR
do { retcode = read(fd, p, n); } while (retcode == -1 && errno == EINTR);
#else
retcode = read(fd, p, n);
#endif
#endif
leave_blocking_section();
if (retcode == -1) sys_error(NULL);
return retcode;
}
unsigned char refill(channel)
struct channel * channel;
{
int n;
n = really_read(channel->fd, channel->buff, IO_BUFFER_SIZE);
if (n == 0) raise_end_of_file();
channel->offset += n;
channel->max = channel->buff + n;
channel->curr = channel->buff + 1;
return (unsigned char)(channel->buff[0]);
}
value input_char(channel) /* ML */
struct channel * channel;
{
unsigned char c;
c = getch(channel);
return Val_long(c);
}
uint32 getword(channel)
struct channel * channel;
{
int i;
uint32 res;
res = 0;
for(i = 0; i < 4; i++) {
res = (res << 8) + getch(channel);
}
return res;
}
value input_int(channel) /* ML */
struct channel * channel;
{
long i;
i = getword(channel);
#ifdef SIXTYFOUR
i = (i << 32) >> 32; /* Force sign extension */
#endif
return Val_long(i);
}
unsigned getblock(channel, p, n)
struct channel * channel;
char * p;
unsigned n;
{
unsigned m, l;
m = channel->max - channel->curr;
if (n <= m) {
bcopy(channel->curr, p, n);
channel->curr += n;
return n;
} else if (m > 0) {
bcopy(channel->curr, p, m);
channel->curr += m;
return m;
} else if (n < IO_BUFFER_SIZE) {
l = really_read(channel->fd, channel->buff, IO_BUFFER_SIZE);
channel->offset += l;
channel->max = channel->buff + l;
if (n > l) n = l;
bcopy(channel->buff, p, n);
channel->curr = channel->buff + n;
return n;
} else {
channel->curr = channel->buff;
channel->max = channel->buff;
l = really_read(channel->fd, p, n);
channel->offset += l;
return l;
}
}
int really_getblock(chan, p, n)
struct channel * chan;
char * p;
unsigned long n;
{
unsigned r;
while (n > 0) {
r = getblock(chan, p, (unsigned) n);
if (r == 0) return 0;
p += r;
n -= r;
}
return 1;
}
value input(channel, buff, start, length) /* ML */
value channel, buff, start, length;
{
return Val_long(getblock((struct channel *) channel,
&Byte(buff, Long_val(start)),
(unsigned) Long_val(length)));
}
value seek_in(channel, pos) /* ML */
struct channel * channel;
value pos;
{
long dest;
dest = Long_val(pos);
if (dest >= channel->offset - (channel->max - channel->buff) &&
dest <= channel->offset) {
channel->curr = channel->max - (channel->offset - dest);
} else {
if (lseek(channel->fd, dest, 0) != dest) sys_error(NULL);
channel->offset = dest;
channel->curr = channel->max = channel->buff;
}
return Val_unit;
}
value pos_in(channel) /* ML */
struct channel * channel;
{
return Val_long(channel->offset - (channel->max - channel->curr));
}
value close_in(channel) /* ML */
struct channel * channel;
{
close(channel->fd);
stat_free((char *) channel);
return Val_unit;
}
value input_scan_line(channel) /* ML */
struct channel * channel;
{
char * p;
int n;
p = channel->curr;
do {
if (p >= channel->max) {
/* No more characters available in the buffer */
if (channel->curr > channel->buff) {
/* Try to make some room in the buffer by shifting the unread
portion at the beginning */
bcopy(channel->curr, channel->buff, channel->max - channel->curr);
n = channel->curr - channel->buff;
channel->curr -= n;
channel->max -= n;
p -= n;
}
if (channel->max >= channel->end) {
/* Buffer is full, no room to read more characters from the input.
Return the number of characters in the buffer, with negative
sign to indicate that no newline was encountered. */
return Val_long(-(channel->max - channel->curr));
}
/* Fill the buffer as much as possible */
n = really_read(channel->fd, channel->max, channel->end - channel->max);
if (n == 0) {
/* End-of-file encountered. Return the number of characters in the
buffer, with negative sign since we haven't encountered
a newline. */
return Val_long(-(channel->max - channel->curr));
}
channel->offset += n;
channel->max += n;
}
} while (*p++ != '\n');
/* Found a newline. Return the length of the line, newline included. */
return Val_long(p - channel->curr);
}