mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

* fports.c (local_fclose): call local_fflush unconditionally.

Browse source 
(various): don't use the scm_must... memory procs.
	* ports.h (scm_port): make read_pos a pointer to const.
	strports.c: take care of rw_active and rw_randow.
	fports.c: scm_fport_drain_input: removed.  do it all in ports.c.
	strports.c (scm_mkstrport): check that pos is reasonable.
	ioext.c (scm_ftell, scm_fseek): use lseek.
	(SCM_CLEAR_BUFFERS): macro deleted.
	ioext.c (redirect_port: use ptob fflush, read_flush.
	ports.h (scm_ptobfuns): add ftruncate.
	ports.c (scm_newptob): set ftruncate.
	adjust ptob tables.
*	ports.c (scm_ftruncate): new procedure.
	fports.c (local_ftrunate), strports.c (str_ftruncate): new procs.
	strports.c (st_seek, st_grow_port): new procs.
	fports.h (scm_port): change size types from int to off_t.
	ports.c (scm_init_ports): initialise the seek symbols here
	instead of in ioext.c.
	strports.c (scm_call_with_output_string): start with an empty
	string, so seek and ftruncate can be used.
	* ports.h (scm_ptobfuns): add a read_flush procedure which is the
	equivalent to fflush for the read buffer.
	* ports.c (scm_newptob): set read_flush.
	ports.c (void_port_ptob): set read_flush.
	fports.c (local_read_flush): new proc.  add to ptob.
	strport.c (st_read_flush): likewise.
	vport.c (sf_read_flush): likewise.
	fports.h (struct scm_fport): remove random member.  there's nothing
	left but fdes.  leaving it as a struct to allow for future changes.
	fports.c: replace usage of scm_fport::random with scm_port::rw_random.
	ports.c: (scm_putc, scm_puts, scm_lfwrite): call the read_flush
	ptob proc if the read buffer is filled.
	* ports.h (struct scm_port_table): add writing and reading members
	to replace write_needs_seek: it isn't good enough for non-fports.
	ports.c, ioext.c, fports.c: corresponding changes.
	(struct scm_port_table): give it a typedef and rename to scm_port.
	ports.c, fports.c, strports.c, vports.c, ioext.c, ports.h:
	corresponding changes.
	* fports.c (scm_fdes_wait_for_input): forgot to check compilation
	with threads enabled.  rename this procedure to
	fport_wait_for_input and take a port instead of a fdes.
	use scm_fport_input_waiting_p instead of scm_fdes_waiting_p.
	* gc.c (scm_init_storage): install an atexit proc to flush the
	ports.
	(cleanup): the new proc.  it sets a global variable which can be
	checked by the ptob flush procs to avoid trying to throw
	exceptions during exit.  not very pleasant but it seems more reliable.
	* fports.c (local_fflush): check terminating variable and if set
	don't throw exception.
	* CHECKME: that the atexit proc is installed if unexec used.
	* fports.c (scm_fdes_waiting_p): merged into fport_input_waiting_p.
	* fports.c (scm_standard_stream_to_port): moved to init.c and
	made static.
	(scm_puts): rewritten
	* fports.c (local_ffwrite, local_fputs): removed.
	* strports.c (stputc, stputs, stwrite): dyked out (FIXME)
	* vports.c (sfputc, sfputs, sfwrite) likewise.
	* ports.c (write_void_port, puts_void_port): removed.
	(putc_void_port, getc_void_port, fgets_void_port): likewise.
	* fports.c (local_fputc): deleted.
	* ports.h (scm_ptobfuns): add seek function pointer.
	* fports.c: set it to local_seek, new procedure.
	* fports.c (local_fgetc, local_fgets): deleted.
	* strports.c (stgetc): likewise.
	* ports.c: scm_generic_fgets: likewise.
	* fports.c (scm_fport_buffer_add): new procedure.
	* fports.c (scm_fdes_to_port), ports.c (scm_void_port),
	filesys.c (scm_opendir):
	restore defer interrupts while the port is constructed.
*	(scm_setvbuf): if mode is _IOFBF and size is not supplied,
	derive buffer size from fdes or use a default.
	(scm_fdes_to_port): use setvbuf instead of creating the buffers
	directly.
	* fports.c (scm_input_waiting_p): use scm_return_first, since port
	may be removed from the stack by the tail call to scm_fdes_waiting_p.
	ports.c fports.c ioext.c posix.c socket.c net_db.c filesys.c:
	removed all uses of SCM_DEFER/ALLOW ints for now.  they were mainly
	just protecting errno.  some may need to be put back.
	*fports.c (print_pipe_port, local_pclose, scm_pipob): deleted.
*	open-pipe, close-pipe are emulated in (ice-9 popen)
	ports.c (scm_ports_prehistory): don't init scm_pipob.
	ports.h (scm_tc16_pipe): deleted.
	posix.c (scm_open_pipe, scm_close_pipe): deleted.
	* posix.c (scm_pipe): use fport buffer.
	* unif.c: include fports.h instead of genio.h.
	* fports.c (scm_fdes_wait_for_input, scm_fport_fill_buffer): new
	procedures.
	(local_fgetc): use them.
	(local_ffwrite): use buffer.
	(local_fgets): use buffer.
	(scm_setbuf0): deleted.
	(scm_setvbuf): set the buffer.
	(scm_setfileno): deleted.
	(scm_evict_ports): set fdes directly.
*	(scm_freopen): deleted.  doesn't seem useful in Guile.
	(scm_stdio_to_port): deleted.
	fports.h (struct scm_fport): add shortbuf member to avoid separate
	code for unbuffered ports.
	(SCM_FPORTP, SCM_OPFPORTP, SCM_OPINFPORTP, SCM_OPOUTFPORTP): moved
	from ports.h.
	* fports.c, fports.h (scm_fport_drain_input): new procedure.
	* ports.c (scm_drain_input): call scm_fport_drain_input.
	* scm_fdes_waiting_p: new procedure.
	* fports.c (scm_fdes_to_port): allocate read and/or write buffers.
	(scm_input_waiting_p): check the buffer.
	(local_fgetc, local_fflush, local_fputc): likewise.
*	* ports.c (scm_drain_input): new procedure.
	ports.h: prototype.
	* fports.c (FPORT_READ_SAFE, FPORT_WRITE_SAFE, FPORT_ALL_OKAY,
	pre_read, pre_write): removed.
	(local_fputc, local_fputs, local_ffwrite): use write, not stdio.
	(scm_standard_stream_to_port): change first arg from FILE * to
	int fdes.
	(local_fflush): flush fdes, not FILE *.
	* fports.h (SCM_NOFTELL): removed.
	* genio.c, ports.c: don't include filesys.h.
	* genio.c (scm_getc): don't use scm_internal_select if FPORT.
	do it in fports.c:local_fgetc.
	* genio.c: don't use SCM_SYSCALL when calling ptob procedures.
	do it where it's needed in the port smobs.
	* filesys.c (scm_input_waiting_p): moved to fports.c, stdio
	  buffer support removed.  take SCM arg, not FILE *.
	* filesys.h: prototype moved too.
	* fports.c (scm_fdes_to_port): new procedure.
	(local_fgetc): use read not fgetc.
	(local_fclose): use close, not fclose.
	(local_fgets): use read, not fgets
	* fports.h: prototype for scm_fdes_to_port.
	* fports.h (scm_fport): new struct.
	* fports.c (scm_open_file): use open, not fopen.
	#include fcntl.h
	* ports.h (struct scm_port_table): change stream from SCM to void *.
	* ports.c (scm_add_to_port_table): check for memory allocation error.
	(scm_prinport): remove MSDOS hair.
	(scm_void_port): set stream to 0 instead of SCM_BOOL_F.
	(scm_close_port): don't throw errors: do it in fports.c.
This commit is contained in:
Jim Blandy 1999-06-09 12:18:12 +00:00
parent 322bb835b0
commit cb63cf9e6b
1 changed files with 329 additions and 380 deletions
Download patch file Download diff file Expand all files Collapse all files

709
libguile/fports.c
View file

@ -41,6 +41,7 @@
#include <stdio.h>
#include <fcntl.h>
#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 <sys/stat.h>
#endif
return SCM_UNSPECIFIED;
#include <errno.h>
#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