/***********************************************************************/ /* */ /* Caml Special Light */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1995 Institut National de Recherche en Informatique et */ /* Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ /* $Id$ */ /* Buffered input/output. */ #include #include #include #include #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); }