mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-28 16:00:22 +02:00
* fports.c (local_fclose): call local_fflush unconditionally.
(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:
parent
322bb835b0
commit
cb63cf9e6b
1 changed files with 329 additions and 380 deletions
|
@ -41,6 +41,7 @@
|
||||||
|
|
||||||
|
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
#include <fcntl.h>
|
||||||
#include "_scm.h"
|
#include "_scm.h"
|
||||||
|
|
||||||
#include "fports.h"
|
#include "fports.h"
|
||||||
|
@ -53,157 +54,115 @@
|
||||||
#else
|
#else
|
||||||
scm_sizet fwrite ();
|
scm_sizet fwrite ();
|
||||||
#endif
|
#endif
|
||||||
|
#ifdef HAVE_ST_BLKSIZE
|
||||||
|
#include <sys/stat.h>
|
||||||
/* 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););
|
|
||||||
#endif
|
#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_PROC (s_setvbuf, "setvbuf", 2, 1, 0, scm_setvbuf);
|
||||||
SCM
|
SCM
|
||||||
scm_setvbuf (SCM port, SCM mode, SCM size)
|
scm_setvbuf (SCM port, SCM mode, SCM size)
|
||||||
{
|
{
|
||||||
int rv;
|
|
||||||
int cmode, csize;
|
int cmode, csize;
|
||||||
|
struct scm_port_table *pt;
|
||||||
|
|
||||||
port = SCM_COERCE_OUTPORT (port);
|
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);
|
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))
|
if (SCM_UNBNDP (size))
|
||||||
csize = 0;
|
{
|
||||||
|
if (cmode == _IOFBF)
|
||||||
|
csize = -1;
|
||||||
|
else
|
||||||
|
csize = 0;
|
||||||
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf);
|
SCM_ASSERT (SCM_INUMP (size), size, SCM_ARG3, s_setvbuf);
|
||||||
csize = SCM_INUM (size);
|
csize = SCM_INUM (size);
|
||||||
|
if (csize < 0 || (cmode == _IONBF && csize > 0))
|
||||||
|
scm_out_of_range (s_setvbuf, size);
|
||||||
}
|
}
|
||||||
cmode = SCM_INUM (mode);
|
pt = SCM_PTAB_ENTRY (port);
|
||||||
if (csize == 0 && cmode == _IOFBF)
|
|
||||||
cmode = _IONBF;
|
/* silently discards buffered chars. */
|
||||||
SCM_DEFER_INTS;
|
if (pt->read_buf != &pt->shortbuf)
|
||||||
SCM_SYSCALL (rv = setvbuf ((FILE *)SCM_STREAM (port), 0, cmode, csize));
|
scm_must_free (pt->read_buf);
|
||||||
if (rv < 0)
|
if (pt->write_buf != &pt->shortbuf)
|
||||||
scm_syserror (s_setvbuf);
|
scm_must_free (pt->write_buf);
|
||||||
if (cmode == _IONBF)
|
|
||||||
SCM_SETCAR (port, SCM_CAR (port) | SCM_BUF0);
|
scm_fport_buffer_add (port, csize, csize);
|
||||||
else
|
|
||||||
SCM_SETCAR (port, (SCM_CAR (port) & ~SCM_BUF0));
|
|
||||||
SCM_ALLOW_INTS;
|
|
||||||
return SCM_UNSPECIFIED;
|
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,
|
/* Move ports with the specified file descriptor to new descriptors,
|
||||||
* reseting the revealed count to 0.
|
* reseting the revealed count to 0.
|
||||||
* Should be called with SCM_DEFER_INTS active.
|
|
||||||
*/
|
*/
|
||||||
|
|
||||||
void
|
void
|
||||||
|
@ -214,11 +173,19 @@ scm_evict_ports (fd)
|
||||||
|
|
||||||
for (i = 0; i < scm_port_table_size; i++)
|
for (i = 0; i < scm_port_table_size; i++)
|
||||||
{
|
{
|
||||||
if (SCM_FPORTP (scm_port_table[i]->port)
|
SCM port = scm_port_table[i]->port;
|
||||||
&& fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd)
|
|
||||||
|
if (SCM_FPORTP (port))
|
||||||
{
|
{
|
||||||
scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd));
|
struct scm_fport *fp = SCM_FSTREAM (port);
|
||||||
scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0));
|
|
||||||
|
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 modes;
|
||||||
{
|
{
|
||||||
SCM port;
|
SCM port;
|
||||||
FILE *f;
|
int fdes;
|
||||||
|
int flags = 0;
|
||||||
char *file;
|
char *file;
|
||||||
char *mode;
|
char *mode;
|
||||||
|
char *ptr;
|
||||||
|
|
||||||
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file);
|
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);
|
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);
|
file = SCM_ROCHARS (filename);
|
||||||
mode = SCM_ROCHARS (modes);
|
mode = SCM_ROCHARS (modes);
|
||||||
|
|
||||||
SCM_DEFER_INTS;
|
switch (*mode)
|
||||||
SCM_SYSCALL (f = fopen (file, mode));
|
{
|
||||||
if (!f)
|
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;
|
int en = errno;
|
||||||
|
|
||||||
scm_syserror_msg (s_open_file, "%s: %S",
|
scm_syserror_msg (s_open_file, "%s: %S",
|
||||||
scm_listify (scm_makfrom0str (strerror (errno)),
|
scm_cons (scm_makfrom0str (strerror (en)),
|
||||||
filename,
|
scm_cons (filename, SCM_EOL)),
|
||||||
SCM_UNDEFINED),
|
|
||||||
en);
|
en);
|
||||||
}
|
}
|
||||||
else
|
port = scm_fdes_to_port (fdes, mode, filename);
|
||||||
port = scm_stdio_to_port (f, mode, filename);
|
|
||||||
SCM_ALLOW_INTS;
|
|
||||||
return port;
|
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
|
MODE indicates whether FILE is open for reading or writing; it uses
|
||||||
the same notation as open-file's second argument.
|
the same notation as open-file's second argument.
|
||||||
Use NAME as the port's filename. */
|
Use NAME as the port's filename. */
|
||||||
|
|
||||||
SCM
|
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);
|
long mode_bits = scm_mode_bits (mode);
|
||||||
SCM port;
|
SCM port;
|
||||||
|
@ -331,38 +283,79 @@ scm_stdio_to_port (FILE *file, char *mode, SCM name)
|
||||||
|
|
||||||
SCM_NEWCELL (port);
|
SCM_NEWCELL (port);
|
||||||
SCM_DEFER_INTS;
|
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);
|
struct scm_fport *fp
|
||||||
SCM_SETPTAB_ENTRY (port, pt);
|
= (struct scm_fport *) scm_must_malloc (sizeof (struct scm_fport),
|
||||||
SCM_SETCAR (port, (scm_tc16_fport
|
"scm_fdes_to_port");
|
||||||
| mode_bits
|
fp->fdes = fdes;
|
||||||
| FPORT_READ_SAFE | FPORT_WRITE_SAFE));
|
fp->random = SCM_FDES_RANDOM_P (fdes);
|
||||||
SCM_SETSTREAM (port, (SCM) file);
|
|
||||||
if (SCM_BUF0 & SCM_CAR (port))
|
SCM_SETSTREAM (port, fp);
|
||||||
scm_setbuf0 (port);
|
if (mode_bits & SCM_BUF0)
|
||||||
SCM_PTAB_ENTRY (port)->file_name = name;
|
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;
|
SCM_ALLOW_INTS;
|
||||||
return port;
|
return port;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Like scm_stdio_to_port, except that:
|
/* Check whether an fport's fdes can supply input. */
|
||||||
- NAME is a standard C string, not a Guile string
|
static int
|
||||||
- we set the revealed count for FILE's file descriptor to 1, so
|
fport_input_waiting_p (SCM port)
|
||||||
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));
|
int fdes = SCM_FSTREAM (port)->fdes;
|
||||||
scm_set_port_revealed_x (port, SCM_MAKINUM (1));
|
|
||||||
return port;
|
#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 prinfport SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
|
||||||
|
|
||||||
static int
|
static int
|
||||||
|
@ -390,204 +383,160 @@ prinfport (exp, port, pstate)
|
||||||
return !0;
|
return !0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#ifdef GUILE_ISELECT
|
||||||
|
/* thread-local block for input on fport's fdes. */
|
||||||
static int
|
static void
|
||||||
local_fgetc (SCM port)
|
fport_wait_for_input (SCM port)
|
||||||
{
|
{
|
||||||
FILE *s = (FILE *) SCM_STREAM (port);
|
int fdes = SCM_FSTREAM (port)->fdes;
|
||||||
pre_read (port);
|
|
||||||
if (feof (s))
|
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;
|
return EOF;
|
||||||
else
|
else
|
||||||
return fgetc (s);
|
{
|
||||||
|
pt->read_pos = pt->read_buf + 1;
|
||||||
|
pt->read_end = pt->read_buf + count;
|
||||||
|
return (*(pt->read_buf));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static off_t
|
||||||
static char *
|
local_seek (SCM port, off_t offset, int whence)
|
||||||
local_fgets (SCM port, int *len)
|
|
||||||
{
|
{
|
||||||
FILE *f;
|
struct scm_fport *fp = SCM_FSTREAM (port);
|
||||||
|
|
||||||
char *buf = NULL;
|
return lseek (fp->fdes, offset, whence);
|
||||||
char *p; /* pointer to current buffer position */
|
}
|
||||||
int limit = 80; /* current size of buffer */
|
|
||||||
|
|
||||||
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
|
static void
|
||||||
ftell to determine how much we've read, then call the generic
|
local_fflush (SCM port)
|
||||||
function. We could use a separate scm_ptobfuns table with
|
{
|
||||||
scm_generic_fgets, but then we'd have to change SCM_FPORTP, etc.
|
struct scm_port_table *pt = SCM_PTAB_ENTRY (port);
|
||||||
Ideally, it should become something that means "this port has a
|
struct scm_fport *fp = SCM_FSTREAM (port);
|
||||||
file descriptor"; sometimes we reject sockets when we shouldn't.
|
char *ptr = pt->write_buf;
|
||||||
But I'm too stupid at the moment to do that right. */
|
int init_size = pt->write_pos - pt->write_buf;
|
||||||
if (SCM_CAR (port) & SCM_NOFTELL)
|
int remaining = init_size;
|
||||||
return scm_generic_fgets (port, len);
|
|
||||||
|
|
||||||
f = (FILE *) SCM_STREAM (port);
|
while (remaining > 0)
|
||||||
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);
|
int count;
|
||||||
SCM_TRY_CLRDY (port);
|
|
||||||
if (buf[(*len)++] == '\n' || *len == limit - 1)
|
SCM_SYSCALL (count = write (fp->fdes, ptr, remaining));
|
||||||
|
if (count < 0)
|
||||||
{
|
{
|
||||||
buf[*len] = '\0';
|
/* error. assume nothing was written this call, but
|
||||||
return buf;
|
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;
|
||||||
}
|
}
|
||||||
|
pt->write_pos = pt->write_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
|
|
||||||
|
|
||||||
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
|
static int
|
||||||
local_fclose (SCM port)
|
local_fclose (SCM port)
|
||||||
{
|
{
|
||||||
FILE *fp = (FILE *) SCM_STREAM (port);
|
struct scm_fport *fp = SCM_FSTREAM (port);
|
||||||
|
struct scm_port_table *pt = SCM_PTAB_ENTRY (port);
|
||||||
return fclose (fp);
|
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 =
|
scm_ptobfuns scm_fptob =
|
||||||
{
|
{
|
||||||
0,
|
0,
|
||||||
local_fclose,
|
local_fclose,
|
||||||
prinfport,
|
prinfport,
|
||||||
0,
|
0,
|
||||||
local_fputc,
|
|
||||||
local_fputs,
|
|
||||||
local_ffwrite,
|
|
||||||
local_fflush,
|
local_fflush,
|
||||||
local_fgetc,
|
local_fclose,
|
||||||
local_fgets,
|
fport_fill_buffer,
|
||||||
local_fclose
|
local_seek,
|
||||||
};
|
fport_input_waiting_p,
|
||||||
|
|
||||||
/* {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
|
|
||||||
};
|
};
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue