diff --git a/libguile/fports.c b/libguile/fports.c index 9106e415f..53053aaa1 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -41,6 +41,7 @@ #include +#include #include "_scm.h" #include "fports.h" @@ -53,157 +54,115 @@ #else scm_sizet fwrite (); #endif - - -/* Port direction --- handling el cheapo stdio implementations. - - Guile says that when you've got a port that's both readable and - writable, like a socket, why then, by gum, you can read from it and - write to it! However, most standard I/O implementations make - cheezy caveats like this: - - When a file is opened for update, both input and output may - be done on the resulting stream. However, output may not be - directly followed by input without an intervening fflush(), - fseek(), fsetpos(), or rewind(), and input may not be - directly followed by output without an intervening fseek(), - fsetpos(), or rewind(), or an input operation that - encounters end-of-file. - -- the Solaris fdopen(3S) man page - - I think this behavior is permitted by the ANSI C standard. - - So we made the implementation more complex, so what the user sees - remains simple. When we have a Guile port based on a stdio stream - (this source file's specialty), we keep track of whether it was - last written to, read from, or whether it is in a safe state for - both operations. Each port operation function just checks the - state of the port before each operation, and does the required - magic if necessary. - - We use two bits in the CAR of the port, FPORT_READ_SAFE and - FPORT_WRITE_SAFE, to indicate what operations the underlying stdio - stream could correctly perform next. You're not allowed to clear - them both at the same time, but both can be set --- for example, if - the stream has just been opened, or flushed, or had its position - changed. - - It's possible for a port to have neither bit set, if we receive a - FILE * pointer in an unknown state; this code should handle that - gracefully. */ - -#define FPORT_READ_SAFE (1L << 24) -#define FPORT_WRITE_SAFE (2L << 24) - -#define FPORT_ALL_OKAY(port) \ - (SCM_SETOR_CAR (port, (FPORT_READ_SAFE | FPORT_WRITE_SAFE))) - -static inline void -pre_read (SCM port) -{ - if (! (SCM_CAR (port) & FPORT_READ_SAFE)) - fflush ((FILE *)SCM_STREAM (port)); - - /* We've done the flush, so reading is safe. - Assuming that we're going to do a read next, writing will not be - safe by the time we're done. */ - SCM_SETOR_CAR (port, FPORT_READ_SAFE); - SCM_SETAND_CAR (port, ~FPORT_WRITE_SAFE); - -} - -static inline void -pre_write (SCM port) -{ - if (! (SCM_CAR (port) & FPORT_WRITE_SAFE)) - /* This can fail, if we're talking to a line-buffered terminal. As - far as I can tell, there's no way to get mixed reads and writes - to work on a line-buffered terminal at all --- you get a full - line in the buffer when you read, and then you have to throw it - out to write. You have to do unbuffered input, and make the - system provide the second buffer. */ - fseek ((FILE *)SCM_STREAM (port), 0, SEEK_CUR); - - /* We've done the seek, so writing is safe. - Assuming that we're going to do a write next, reading will not be - safe by the time we're done. */ - SCM_SETOR_CAR (port, FPORT_WRITE_SAFE); - SCM_SETAND_CAR (port, ~FPORT_READ_SAFE); -} - - -/* Helpful operations on stdio FILE-based ports */ - -/* should be called with SCM_DEFER_INTS active */ - -SCM -scm_setbuf0 (port) - SCM port; -{ - /* NOSETBUF was provided by scm to allow unbuffered ports to be - avoided on systems where ungetc didn't work correctly. See - comment in unif.c, which seems to be the only place where it - could still be a problem. */ -#ifndef NOSETBUF - /* SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0);); */ - SCM_SYSCALL (setvbuf ((FILE *)SCM_STREAM (port), 0, _IONBF, 0);); +#ifdef HAVE_ST_BLKSIZE +#include #endif - return SCM_UNSPECIFIED; + +#include + +#include "iselect.h" + +/* create FPORT buffer with specified sizes (or -1 to use default size or + 0 for no buffer. */ +static void +scm_fport_buffer_add (SCM port, int read_size, int write_size) +{ + struct scm_fport *fp = SCM_FSTREAM (port); + struct scm_port_table *pt = SCM_PTAB_ENTRY (port); + char *s_scm_fport_buffer_add = "scm_fport_buffer_add"; + + if (read_size == -1 || write_size == -1) + { + int default_size; +#ifdef HAVE_ST_BLKSIZE + struct stat st; + + if (fstat (fp->fdes, &st) == -1) + scm_syserror (s_scm_fport_buffer_add); + default_size = st.st_blksize; +#else + default_size = 1024; +#endif + if (read_size == -1) + read_size = default_size; + if (write_size == -1) + write_size = default_size; + } + + if (SCM_INPORTP (port) && read_size > 0) + { + pt->read_buf = scm_must_malloc (read_size, s_scm_fport_buffer_add); + pt->read_pos = pt->read_end = pt->read_buf; + pt->read_buf_size = read_size; + } + else + { + pt->read_buf = pt->read_pos = pt->read_end = &pt->shortbuf; + pt->read_buf_size = 1; + } + + if (SCM_OUTPORTP (port) && write_size > 0) + { + pt->write_buf = scm_must_malloc (write_size, s_scm_fport_buffer_add); + pt->write_pos = pt->write_buf; + pt->write_buf_size = write_size; + } + else + { + pt->write_buf = pt->write_pos = &pt->shortbuf; + pt->write_buf_size = 1; + } + + pt->write_end = pt->write_buf + pt->write_buf_size; + if (read_size > 0 || write_size > 0) + SCM_SETCAR (port, SCM_CAR (port) & ~SCM_BUF0); + else + SCM_SETCAR (port, (SCM_CAR (port) | SCM_BUF0)); } SCM_PROC (s_setvbuf, "setvbuf", 2, 1, 0, scm_setvbuf); SCM scm_setvbuf (SCM port, SCM mode, SCM size) { - int rv; int cmode, csize; + struct scm_port_table *pt; port = SCM_COERCE_OUTPORT (port); - SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG1, s_setvbuf); + SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, + s_setvbuf); SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_setvbuf); + cmode = SCM_INUM (mode); + if (cmode != _IONBF && cmode != _IOFBF) + scm_out_of_range (s_setvbuf, mode); if (SCM_UNBNDP (size)) - csize = 0; + { + if (cmode == _IOFBF) + csize = -1; + else + csize = 0; + } else { SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf); csize = SCM_INUM (size); + if (csize < 0 || (cmode == _IONBF && csize > 0)) + scm_out_of_range (s_setvbuf, size); } - cmode = SCM_INUM (mode); - if (csize == 0 && cmode == _IOFBF) - cmode = _IONBF; - SCM_DEFER_INTS; - SCM_SYSCALL (rv = setvbuf ((FILE *)SCM_STREAM (port), 0, cmode, csize)); - if (rv < 0) - scm_syserror (s_setvbuf); - if (cmode == _IONBF) - SCM_SETCAR (port, SCM_CAR (port) | SCM_BUF0); - else - SCM_SETCAR (port, (SCM_CAR (port) & ~SCM_BUF0)); - SCM_ALLOW_INTS; + pt = SCM_PTAB_ENTRY (port); + + /* silently discards buffered chars. */ + if (pt->read_buf != &pt->shortbuf) + scm_must_free (pt->read_buf); + if (pt->write_buf != &pt->shortbuf) + scm_must_free (pt->write_buf); + + scm_fport_buffer_add (port, csize, csize); return SCM_UNSPECIFIED; } -#ifdef FD_SETTER -#define SET_FILE_FD_FIELD(F,D) ((F)->FD_SETTER = (D)) -#endif - -void -scm_setfileno (fs, fd) - FILE *fs; - int fd; -{ -#ifdef SET_FILE_FD_FIELD - SET_FILE_FD_FIELD(fs, fd); -#else - scm_misc_error ("scm_setfileno", "Not fully implemented on this platform", - SCM_EOL); -#endif -} - /* Move ports with the specified file descriptor to new descriptors, * reseting the revealed count to 0. - * Should be called with SCM_DEFER_INTS active. */ void @@ -214,11 +173,19 @@ scm_evict_ports (fd) for (i = 0; i < scm_port_table_size; i++) { - if (SCM_FPORTP (scm_port_table[i]->port) - && fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd) + SCM port = scm_port_table[i]->port; + + if (SCM_FPORTP (port)) { - scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd)); - scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0)); + struct scm_fport *fp = SCM_FSTREAM (port); + + if (fp->fdes == fd) + { + fp->fdes = dup (fd); + if (fp->fdes == -1) + scm_syserror ("scm_evict_ports"); + scm_set_port_revealed_x (port, SCM_MAKINUM (0)); + } } } } @@ -239,9 +206,11 @@ scm_open_file (filename, modes) SCM modes; { SCM port; - FILE *f; + int fdes; + int flags = 0; char *file; char *mode; + char *ptr; SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file); SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file); @@ -253,77 +222,60 @@ scm_open_file (filename, modes) file = SCM_ROCHARS (filename); mode = SCM_ROCHARS (modes); - SCM_DEFER_INTS; - SCM_SYSCALL (f = fopen (file, mode)); - if (!f) + switch (*mode) + { + case 'r': + flags |= O_RDONLY; + break; + case 'w': + flags |= O_WRONLY | O_CREAT | O_TRUNC; + break; + case 'a': + flags |= O_WRONLY | O_CREAT | O_APPEND; + break; + default: + scm_out_of_range (s_open_file, modes); + } + ptr = mode + 1; + while (*ptr != '\0') + { + switch (*ptr) + { + case '+': + flags = (flags & ~(O_RDONLY | O_WRONLY)) | O_RDWR; + break; + case '0': /* unbuffered: handled later. */ + case 'b': /* 'binary' mode: ignored. */ + break; + default: + scm_out_of_range (s_open_file, modes); + } + ptr++; + } + SCM_SYSCALL (fdes = open (file, flags, 0666)); + if (fdes == -1) { int en = errno; scm_syserror_msg (s_open_file, "%s: %S", - scm_listify (scm_makfrom0str (strerror (errno)), - filename, - SCM_UNDEFINED), + scm_cons (scm_makfrom0str (strerror (en)), + scm_cons (filename, SCM_EOL)), en); } - else - port = scm_stdio_to_port (f, mode, filename); - SCM_ALLOW_INTS; + port = scm_fdes_to_port (fdes, mode, filename); return port; } - -SCM_PROC (s_freopen, "freopen", 3, 0, 0, scm_freopen); - -SCM -scm_freopen (filename, modes, port) - SCM filename; - SCM modes; - SCM port; -{ - FILE *f; - SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, - SCM_ARG1, s_freopen); - SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, - s_freopen); - - SCM_COERCE_SUBSTR (filename); - SCM_COERCE_SUBSTR (modes); - port = SCM_COERCE_OUTPORT (port); - SCM_DEFER_INTS; - SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_freopen); - SCM_SYSCALL (f = freopen (SCM_ROCHARS (filename), SCM_ROCHARS (modes), - (FILE *)SCM_STREAM (port))); - if (!f) - { - SCM p; - p = port; - port = SCM_MAKINUM (errno); - SCM_SETAND_CAR (p, ~SCM_OPN); - scm_remove_from_port_table (p); - } - else - { - SCM_SETSTREAM (port, (SCM)f); - SCM_SETCAR (port, (scm_tc16_fport - | scm_mode_bits (SCM_ROCHARS (modes)) - | FPORT_READ_SAFE | FPORT_WRITE_SAFE)); - if (SCM_BUF0 & SCM_CAR (port)) - scm_setbuf0 (port); - } - SCM_ALLOW_INTS; - return port; -} - - -/* Building Guile ports from stdio FILE pointers. */ +/* Building Guile ports from a file descriptor. */ -/* Build a Scheme port from an open stdio port, FILE. +/* Build a Scheme port from an open file descriptor `fdes'. MODE indicates whether FILE is open for reading or writing; it uses the same notation as open-file's second argument. Use NAME as the port's filename. */ + SCM -scm_stdio_to_port (FILE *file, char *mode, SCM name) +scm_fdes_to_port (int fdes, char *mode, SCM name) { long mode_bits = scm_mode_bits (mode); SCM port; @@ -331,38 +283,79 @@ scm_stdio_to_port (FILE *file, char *mode, SCM name) SCM_NEWCELL (port); SCM_DEFER_INTS; + pt = scm_add_to_port_table (port); + SCM_SETPTAB_ENTRY (port, pt); + SCM_SETCAR (port, (scm_tc16_fport | mode_bits)); + { - pt = scm_add_to_port_table (port); - SCM_SETPTAB_ENTRY (port, pt); - SCM_SETCAR (port, (scm_tc16_fport - | mode_bits - | FPORT_READ_SAFE | FPORT_WRITE_SAFE)); - SCM_SETSTREAM (port, (SCM) file); - if (SCM_BUF0 & SCM_CAR (port)) - scm_setbuf0 (port); - SCM_PTAB_ENTRY (port)->file_name = name; + struct scm_fport *fp + = (struct scm_fport *) scm_must_malloc (sizeof (struct scm_fport), + "scm_fdes_to_port"); + fp->fdes = fdes; + fp->random = SCM_FDES_RANDOM_P (fdes); + + SCM_SETSTREAM (port, fp); + if (mode_bits & SCM_BUF0) + scm_fport_buffer_add (port, 0, 0); + else + scm_fport_buffer_add (port, -1, -1); } + SCM_PTAB_ENTRY (port)->file_name = name; SCM_ALLOW_INTS; return port; } -/* Like scm_stdio_to_port, except that: - - NAME is a standard C string, not a Guile string - - we set the revealed count for FILE's file descriptor to 1, so - that FILE won't be closed when the port object is GC'd. */ -SCM -scm_standard_stream_to_port (FILE *file, char *mode, char *name) +/* Check whether an fport's fdes can supply input. */ +static int +fport_input_waiting_p (SCM port) { - SCM port = scm_stdio_to_port (file, mode, scm_makfrom0str (name)); - scm_set_port_revealed_x (port, SCM_MAKINUM (1)); - return port; + int fdes = SCM_FSTREAM (port)->fdes; + +#ifdef HAVE_SELECT + struct timeval timeout; + SELECT_TYPE read_set; + SELECT_TYPE write_set; + SELECT_TYPE except_set; + + FD_ZERO (&read_set); + FD_ZERO (&write_set); + FD_ZERO (&except_set); + + FD_SET (fdes, &read_set); + + timeout.tv_sec = 0; + timeout.tv_usec = 0; + + if (select (SELECT_SET_SIZE, + &read_set, &write_set, &except_set, &timeout) + < 0) + scm_syserror ("fport_input_waiting_p"); + return FD_ISSET (fdes, &read_set); +#elif defined (FIONREAD) + int remir; + ioctl(fdes, FIONREAD, &remir); + return remir; +#else + scm_misc_error ("fport_input_waiting_p", + "Not fully implemented on this platform", + SCM_EOL); +#endif } +/* Clear an fport's read buffer and return buffered chars. */ +char * +scm_fport_drain_input (SCM port, int *count_return) +{ + struct scm_port_table *pt = SCM_PTAB_ENTRY (port); + char *result = pt->read_pos; + + *count_return = pt->read_end - pt->read_pos; + pt->read_pos = pt->read_end; + return result; +} -/* The fport and pipe port scm_ptobfuns functions --- reading and writing */ - static int prinfport SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); static int @@ -390,204 +383,160 @@ prinfport (exp, port, pstate) return !0; } - - -static int -local_fgetc (SCM port) +#ifdef GUILE_ISELECT +/* thread-local block for input on fport's fdes. */ +static void +fport_wait_for_input (SCM port) { - FILE *s = (FILE *) SCM_STREAM (port); - pre_read (port); - if (feof (s)) + int fdes = SCM_FSTREAM (port)->fdes; + + if (!fport_input_waiting_p (port)) + { + int n; + SELECT_TYPE readfds; + int flags = fcntl (fdes, F_GETFL); + + if (flags == -1) + scm_syserror ("scm_fdes_wait_for_input"); + if (!(flags & O_NONBLOCK)) + do + { + FD_ZERO (&readfds); + FD_SET (fdes, &readfds); + n = scm_internal_select (fdes + 1, &readfds, NULL, NULL, NULL); + } + while (n == -1 && errno == EINTR); + } +} +#endif + +static void local_fflush (SCM port); + +/* fill a port's read-buffer with a single read. + returns the first char and moves the read_pos pointer past it. + or returns EOF if end of file. */ +static int +fport_fill_buffer (SCM port) +{ + int count; + struct scm_port_table *pt = SCM_PTAB_ENTRY (port); + struct scm_fport *fp = SCM_FSTREAM (port); + + if (fp->random) + { + /* flush any write buffer first: fix file position and allow the + newly written chars to be read. */ + if (pt->write_pos > pt->write_buf) + local_fflush (port); + pt->write_needs_seek = 1; + } +#ifdef GUILE_ISELECT + fport_wait_for_input (port); +#endif + SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size)); + if (count == -1) + scm_syserror ("fport_fill_buffer"); + if (count == 0) return EOF; else - return fgetc (s); + { + pt->read_pos = pt->read_buf + 1; + pt->read_end = pt->read_buf + count; + return (*(pt->read_buf)); + } } - -static char * -local_fgets (SCM port, int *len) +static off_t +local_seek (SCM port, off_t offset, int whence) { - FILE *f; + struct scm_fport *fp = SCM_FSTREAM (port); - char *buf = NULL; - char *p; /* pointer to current buffer position */ - int limit = 80; /* current size of buffer */ + return lseek (fp->fdes, offset, whence); +} - pre_read (port); +/* becomes 1 when process is exiting: exception handling is disabled. */ +extern int terminating; - /* If this is a socket port or something where we can't rely on - ftell to determine how much we've read, then call the generic - function. We could use a separate scm_ptobfuns table with - scm_generic_fgets, but then we'd have to change SCM_FPORTP, etc. - Ideally, it should become something that means "this port has a - file descriptor"; sometimes we reject sockets when we shouldn't. - But I'm too stupid at the moment to do that right. */ - if (SCM_CAR (port) & SCM_NOFTELL) - return scm_generic_fgets (port, len); +static void +local_fflush (SCM port) +{ + struct scm_port_table *pt = SCM_PTAB_ENTRY (port); + struct scm_fport *fp = SCM_FSTREAM (port); + char *ptr = pt->write_buf; + int init_size = pt->write_pos - pt->write_buf; + int remaining = init_size; - f = (FILE *) SCM_STREAM (port); - if (feof (f)) - return NULL; - - buf = (char *) malloc (limit * sizeof(char)); - *len = 0; - - /* If a char has been pushed onto the port with scm_ungetc, - read that first. */ - while (SCM_CRDYP (port)) + while (remaining > 0) { - buf[*len] = SCM_CGETUN (port); - SCM_TRY_CLRDY (port); - if (buf[(*len)++] == '\n' || *len == limit - 1) + int count; + + SCM_SYSCALL (count = write (fp->fdes, ptr, remaining)); + if (count < 0) { - buf[*len] = '\0'; - return buf; + /* error. assume nothing was written this call, but + fix up the buffer for any previous successful writes. */ + int done = init_size - remaining; + + if (done > 0) + { + int i; + + for (i = 0; i < remaining; i++) + { + *(pt->write_buf + i) = *(pt->write_buf + done + i); + } + pt->write_pos = pt->write_buf + remaining; + } + if (!terminating) + scm_syserror ("local_fflush"); + else + { + const char *msg = "Error: could not flush file-descriptor "; + char buf[11]; + + write (2, msg, strlen (msg)); + sprintf (buf, "%d\n", fp->fdes); + write (2, buf, strlen (buf)); + + count = remaining; + } } + ptr += count; + remaining -= count; } - - while (1) - { - int chunk_size = limit - *len; - long int numread, pos; - - p = buf + *len; - - /* We must use ftell to figure out how many characters were read. - If there are null characters near the end of file, and no - terminating newline, there is no other way to tell the difference - between an embedded null and the string-terminating null. */ - - pos = ftell (f); - if (fgets (p, chunk_size, f) == NULL) { - if (*len) - return buf; - free (buf); - return NULL; - } - numread = ftell (f) - pos; - *len += numread; - - if (numread < chunk_size - 1 || buf[limit-2] == '\n') - return buf; - - buf = (char *) realloc (buf, sizeof(char) * limit * 2); - limit *= 2; - } + pt->write_pos = pt->write_buf; } -#ifdef vms - -static scm_sizet pwrite SCM_P ((char *ptr, scm_sizet size, nitems, FILE *port)); - -static scm_sizet -pwrite (ptr, size, nitems, port) - char *ptr; - scm_sizet size, nitems; - FILE *port; -{ - scm_sizet len = size * nitems; - scm_sizet i = 0; - for (; i < len; i++) - putc (ptr[i], port); - return len; -} - -#define ffwrite pwrite -#else -#define ffwrite fwrite -#endif - static int local_fclose (SCM port) { - FILE *fp = (FILE *) SCM_STREAM (port); - - return fclose (fp); + struct scm_fport *fp = SCM_FSTREAM (port); + struct scm_port_table *pt = SCM_PTAB_ENTRY (port); + int rv; + + local_fflush (port); + SCM_SYSCALL (rv = close (fp->fdes)); + if (rv == -1 && errno != EBADF) + scm_syserror ("local_fclose"); + if (pt->read_buf != &pt->shortbuf) + scm_must_free (pt->read_buf); + if (pt->write_buf != &pt->shortbuf) + scm_must_free (pt->write_buf); + scm_must_free ((char *) fp); + return rv; } -static int -local_fflush (SCM port) -{ - FILE *fp = (FILE *) SCM_STREAM (port); - return fflush (fp); - FPORT_ALL_OKAY (port); -} - -static int -local_fputc (int c, SCM port) -{ - FILE *fp = (FILE *) SCM_STREAM (port); - - pre_write (port); - return fputc (c, fp); -} - -static int -local_fputs (char *s, SCM port) -{ - FILE *fp = (FILE *) SCM_STREAM (port); - pre_write (port); - return fputs (s, fp); -} - -static scm_sizet -local_ffwrite (char *ptr, - scm_sizet size, - scm_sizet nitems, - SCM port) -{ - FILE *fp = (FILE *) SCM_STREAM (port); - pre_write (port); - return ffwrite (ptr, size, nitems, fp); -} - -static int -print_pipe_port (SCM exp, SCM port, scm_print_state *pstate) -{ - scm_prinport (exp, port, "pipe"); - return 1; -} - -static int -local_pclose (SCM port) -{ - FILE *fp = (FILE *) SCM_STREAM (port); - - return pclose (fp); -} - - -/* The file and pipe port scm_ptobfuns structures themselves. */ - scm_ptobfuns scm_fptob = -{ + { 0, local_fclose, prinfport, 0, - local_fputc, - local_fputs, - local_ffwrite, local_fflush, - local_fgetc, - local_fgets, - local_fclose -}; - -/* {Pipe ports} */ -scm_ptobfuns scm_pipob = -{ - 0, - local_pclose, - print_pipe_port, - 0, - local_fputc, - local_fputs, - local_ffwrite, - local_fflush, - local_fgetc, - scm_generic_fgets, - local_pclose + local_fclose, + fport_fill_buffer, + local_seek, + fport_input_waiting_p, }; void