-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
+ * If you do not wish that, delete this exception notice. */
\f
#include <stdio.h>
scm_sizet fwrite ();
#endif
-
-#ifdef __IBMC__
-#include <io.h>
-#include <direct.h>
-#else
-#ifndef MSDOS
-#ifndef ultrix
-#ifndef vms
-#ifdef _DCC
-#include <ioctl.h>
-#define setbuf(stream, buf) setvbuf(stream, buf, _IONBF, 0)
-#else
-#ifdef MWC
-#include <sys/io.h>
-#else
-#ifndef THINK_C
-#ifndef ARM_ULIB
-#include <sys/ioctl.h>
-#endif
-#endif
-#endif
-#endif
-#endif
-#endif
-#endif
-#endif
\f
+/* 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);
+
+}
-/* {Ports - file ports}
- *
- */
+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);
+}
+
+\f
+/* Helpful operations on stdio FILE-based ports */
/* should be called with SCM_DEFER_INTS active */
-#ifdef __STDC__
-SCM
-scm_setbuf0 (SCM port)
-#else
+
SCM
scm_setbuf0 (port)
SCM port;
-#endif
{
+ /* 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
-#ifndef MSDOS
-#ifdef FIONREAD
-#ifndef ultrix
- SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0););
-#endif
-#endif
-#endif
+ /* SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0);); */
+ SCM_SYSCALL (setvbuf ((FILE *)SCM_STREAM (port), 0, _IONBF, 0););
#endif
return SCM_UNSPECIFIED;
}
-/* Return the flags that characterize a port based on the mode
- * string used to open a file for that port.
- *
- * See PORT FLAGS in scm.h
- */
-#ifdef __STDC__
-long
-scm_mode_bits (char *modes)
-#else
-long
-scm_mode_bits (modes)
- char *modes;
+SCM_PROC (s_setvbuf, "setvbuf", 2, 1, 0, scm_setvbuf);
+SCM
+scm_setvbuf (SCM port, SCM mode, SCM size)
+{
+ int rv;
+ int cmode, csize;
+
+ port = SCM_COERCE_OUTPORT (port);
+
+ SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG1, s_setvbuf);
+ SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_setvbuf);
+ if (SCM_UNBNDP (size))
+ csize = 0;
+ else
+ {
+ SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf);
+ csize = SCM_INUM (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;
+ 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;
{
- return (SCM_OPN
- | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
- | ( strchr (modes, 'w')
- || strchr (modes, 'a')
- || strchr (modes, '+') ? SCM_WRTNG : 0)
- | (strchr (modes, '0') ? SCM_BUF0 : 0));
+#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
+scm_evict_ports (fd)
+ int fd;
+{
+ int i;
+
+ 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_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd));
+ scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0));
+ }
+ }
+}
/* scm_open_file
* Return a new port open on a given file.
* Return the new port.
*/
SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file);
-#ifdef __STDC__
-SCM
-scm_open_file (SCM filename, SCM modes)
-#else
+
SCM
scm_open_file (filename, modes)
SCM filename;
SCM modes;
-#endif
{
SCM port;
FILE *f;
file = SCM_ROCHARS (filename);
mode = SCM_ROCHARS (modes);
- SCM_NEWCELL (port);
SCM_DEFER_INTS;
SCM_SYSCALL (f = fopen (file, mode));
if (!f)
{
- scm_syserror_msg (s_open_file, "%S: %S",
+ int en = errno;
+
+ scm_syserror_msg (s_open_file, "%s: %S",
scm_listify (scm_makfrom0str (strerror (errno)),
filename,
- SCM_UNDEFINED));
+ SCM_UNDEFINED),
+ en);
}
else
- {
- struct scm_port_table * pt;
+ port = scm_stdio_to_port (f, mode, filename);
+ SCM_ALLOW_INTS;
+ return port;
+}
- pt = scm_add_to_port_table (port);
- SCM_SETPTAB_ENTRY (port, pt);
- if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (mode)))
- scm_setbuf0 (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_PTAB_ENTRY (port)->file_name = filename;
+ 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;
}
-/* Return the mode flags from an open port.
- * Some modes such as "append" are only used when opening
- * a file and are not returned here.
- */
-SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
-#ifdef __STDC__
-SCM
-scm_port_mode (SCM port)
-#else
+\f
+/* Building Guile ports from stdio FILE pointers. */
+
+/* Build a Scheme port from an open stdio port, FILE.
+ 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_port_mode (port)
- SCM port;
-#endif
+scm_stdio_to_port (FILE *file, char *mode, SCM name)
{
- char modes[3];
- modes[0] = '\0';
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);
- if (SCM_CAR (port) & SCM_RDNG) {
- if (SCM_CAR (port) & SCM_WRTNG)
- strcpy (modes, "r+");
- else
- strcpy (modes, "r");
+ long mode_bits = scm_mode_bits (mode);
+ SCM port;
+ struct scm_port_table * pt;
+
+ 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
+ | 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;
}
- else if (SCM_CAR (port) & SCM_WRTNG)
- strcpy (modes, "w");
- if (SCM_CAR (port) & SCM_BUF0)
- strcat (modes, "0");
- return scm_makfromstr (modes, strlen (modes), 0);
+ SCM_ALLOW_INTS;
+ return port;
}
-#ifdef __STDC__
-static int
-prinfport (SCM exp, SCM port, int writing)
-#else
+/* 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)
+{
+ SCM port = scm_stdio_to_port (file, mode, scm_makfrom0str (name));
+ scm_set_port_revealed_x (port, SCM_MAKINUM (1));
+ return port;
+}
+
+
+\f
+/* 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
-prinfport (exp, port, writing)
+prinfport (exp, port, pstate)
SCM exp;
SCM port;
- int writing;
-#endif
+ scm_print_state *pstate;
{
SCM name;
char * c;
}
-#ifdef __STDC__
-static int
-scm_fgetc (FILE * s)
-#else
+
static int
-scm_fgetc (s)
- FILE * s;
-#endif
+local_fgetc (SCM port)
{
+ FILE *s = (FILE *) SCM_STREAM (port);
+ pre_read (port);
if (feof (s))
return EOF;
else
return fgetc (s);
}
+
+static char *
+local_fgets (SCM port, int *len)
+{
+ FILE *f;
+
+ char *buf = NULL;
+ char *p; /* pointer to current buffer position */
+ int limit = 80; /* current size of buffer */
+
+ pre_read (port);
+
+ /* 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);
+
+ 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))
+ {
+ buf[*len] = SCM_CGETUN (port);
+ SCM_TRY_CLRDY (port);
+ if (buf[(*len)++] == '\n' || *len == limit - 1)
+ {
+ buf[*len] = '\0';
+ return buf;
+ }
+ }
+
+ 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;
+ }
+}
+
#ifdef vms
-#ifdef __STDC__
-static scm_sizet
-pwrite (char *ptr, scm_sizet size, nitems, FILE *port)
-#else
+
+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;
-#endif
{
scm_sizet len = size * nitems;
scm_sizet i = 0;
#define ffwrite fwrite
#endif
-\f
-/* This otherwise pointless code helps some poor
- * crippled C compilers cope with life.
- */
static int
-local_fclose (fp)
- FILE * fp;
+local_fclose (SCM port)
{
+ FILE *fp = (FILE *) SCM_STREAM (port);
+
return fclose (fp);
}
static int
-local_fflush (fp)
- FILE * fp;
+local_fflush (SCM port)
{
+ FILE *fp = (FILE *) SCM_STREAM (port);
return fflush (fp);
+ FPORT_ALL_OKAY (port);
}
static int
-local_fputc (c, fp)
- int c;
- FILE * fp;
+local_fputc (int c, SCM port)
{
+ FILE *fp = (FILE *) SCM_STREAM (port);
+
+ pre_write (port);
return fputc (c, fp);
}
static int
-local_fputs (s, fp)
- char * s;
- FILE * fp;
+local_fputs (char *s, SCM port)
{
+ FILE *fp = (FILE *) SCM_STREAM (port);
+ pre_write (port);
return fputs (s, fp);
}
static scm_sizet
-local_ffwrite (ptr, size, nitems, fp)
- void * ptr;
- int size;
- int nitems;
- FILE * fp;
+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);
+}
+
\f
+/* The file and pipe port scm_ptobfuns structures themselves. */
+
scm_ptobfuns scm_fptob =
{
- scm_mark0,
+ 0,
local_fclose,
prinfport,
0,
local_fputs,
local_ffwrite,
local_fflush,
- scm_fgetc,
+ local_fgetc,
+ local_fgets,
local_fclose
};
-/* {Pipe ports}
- */
+/* {Pipe ports} */
scm_ptobfuns scm_pipob =
{
- scm_mark0,
- 0, /* replaced by pclose in scm_init_ioext() */
- 0, /* replaced by prinpipe in scm_init_ioext() */
+ 0,
+ local_pclose,
+ print_pipe_port,
0,
local_fputc,
local_fputs,
local_ffwrite,
local_fflush,
- scm_fgetc,
- 0
-}; /* replaced by pclose in scm_init_ioext() */
-
+ local_fgetc,
+ scm_generic_fgets,
+ local_pclose
+};
-#ifdef __STDC__
-void
-scm_init_fports (void)
-#else
void
scm_init_fports ()
-#endif
{
#include "fports.x"
+ scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF));
+ scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF));
+ scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF));
}
-
HCoop / bpt / guile.git / blobdiff