diff options
-rw-r--r-- | libguile/fports.c | 32 | ||||
-rw-r--r-- | libguile/init.c | 81 | ||||
-rw-r--r-- | libguile/ioext.c | 6 | ||||
-rw-r--r-- | libguile/throw.c | 5 |
4 files changed, 86 insertions, 38 deletions
diff --git a/libguile/fports.c b/libguile/fports.c index 5a1205f19..5660fa838 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -67,6 +67,9 @@ scm_sizet fwrite (); #include "iselect.h" +/* default buffer size, used if the O/S won't supply a value. */ +static const int default_buffer_size = 1024; + /* create FPORT buffer with specified sizes (or -1 to use default size or 0 for no buffer. */ static void @@ -82,11 +85,10 @@ scm_fport_buffer_add (SCM port, int read_size, int write_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; + default_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size + : st.st_blksize; #else - default_size = 1024; + default_size = default_buffer_size; #endif if (read_size == -1) read_size = default_size; @@ -359,14 +361,28 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, /* 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. */ - + NAME is a string to be used as the port's filename. +*/ SCM scm_fdes_to_port (int fdes, char *mode, SCM name) +#define FUNC_NAME "scm_fdes_to_port" { long mode_bits = scm_mode_bits (mode); SCM port; scm_port *pt; + int flags; + + /* test that fdes is valid. */ + flags = fcntl (fdes, F_GETFL, 0); + if (flags == -1) + SCM_SYSERROR; + flags &= O_ACCMODE; + if (flags != O_RDWR + && ((flags != O_WRONLY && (mode_bits & SCM_WRTNG)) + || (flags != O_RDONLY && (mode_bits & SCM_RDNG)))) + { + SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL); + } SCM_NEWCELL (port); SCM_DEFER_INTS; @@ -378,7 +394,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name) struct scm_fport *fp = (struct scm_fport *) malloc (sizeof (struct scm_fport)); if (fp == NULL) - scm_memory_error ("scm_fdes_to_port"); + SCM_MEMORY_ERROR; fp->fdes = fdes; pt->rw_random = SCM_FDES_RANDOM_P (fdes); SCM_SETSTREAM (port, fp); @@ -391,7 +407,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name) SCM_ALLOW_INTS; return port; } - +#undef FUNC_NAME /* Return a lower bound on the number of bytes available for input. */ static int diff --git a/libguile/init.c b/libguile/init.c index f170bd1f0..2cda6eb64 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -248,32 +248,69 @@ check_config (void) /* initializing standard and current I/O ports */ -/* Like scm_fdes_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 FDES won't be closed when the port object is GC'd. - - when FDES is not a valid file descripter (as determined by - fstat), we open "/dev/null" and use that instead. In that case, - the revealed count is left at zero. -*/ +typedef struct +{ + int fdes; + char *mode; + char *name; +} stream_body_data; + +/* proc to be called in scope of exception handler stream_handler. */ static SCM -scm_standard_stream_to_port (int fdes, char *mode, char *name) +stream_body (void *data) { - struct stat st; - if (fstat (fdes, &st) == -1) - { - /* We do not bother to check errno. When fstat fails, there is - generally no point in trying to use FDES, I think. */ + stream_body_data *body_data = (stream_body_data *) data; + SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, + scm_makfrom0str (body_data->name)); - fdes = open ("/dev/null", (mode[0] == 'r')? O_RDONLY : O_WRONLY); - return scm_fdes_to_port (fdes, mode, scm_makfrom0str (name)); - } - else + SCM_REVEALED (port) = 1; + return port; +} + +/* exception handler for stream_body. */ +static SCM +stream_handler (void *data, SCM tag, SCM throw_args) +{ + return SCM_BOOL_F; +} + +/* Convert a file descriptor to a port, using scm_fdes_to_port. + - NAME is a C string, not a Guile string + - set the revealed count for FILE's file descriptor to 1, so + that fdes won't be closed when the port object is GC'd. + - catch exceptions: allow Guile to be able to start up even + if it has been handed bogus stdin/stdout/stderr. In this case + try to open a new stream on /dev/null. */ +static SCM +scm_standard_stream_to_port (int fdes, char *mode, char *name) +{ + SCM port; + stream_body_data body_data; + + body_data.fdes = fdes; + body_data.mode = mode; + body_data.name = name; + port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, + stream_handler, NULL); + if (SCM_FALSEP (port)) { - SCM port = scm_fdes_to_port (fdes, mode, scm_makfrom0str (name)); - scm_set_port_revealed_x (port, SCM_MAKINUM (1)); - return port; - } + /* FIXME: /dev/null portability. there's also *null-device* in + r4rs.scm. */ + int null_fdes = open ("/dev/null", + (mode[0] == 'r') ? O_RDONLY : O_WRONLY); + + body_data.fdes = null_fdes; + port = (null_fdes == -1) ? SCM_BOOL_F + : scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, + stream_handler, NULL); + /* if the standard fdes was not allocated, reset the revealed count + on the grounds that the user doesn't know what it is. */ + if (SCM_NFALSEP (port) && null_fdes != fdes) + SCM_REVEALED (port) = 0; + /* if port is still #f, we'll just leave it like that and + an error will be raised on the first attempt to use it. */ + } + return port; } /* Create standard ports from stdin, stdout, and stderr. */ diff --git a/libguile/ioext.c b/libguile/ioext.c index 56cdcea6d..98b9fff1a 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -448,13 +448,11 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0, "by @ref{File Ports, open-file}.") #define FUNC_NAME s_scm_fdopen { - SCM port; - SCM_VALIDATE_INUM (1,fdes); SCM_VALIDATE_ROSTRING (2,modes); SCM_COERCE_SUBSTR (modes); - port = scm_fdes_to_port (SCM_INUM (fdes), SCM_ROCHARS (modes), SCM_BOOL_F); - return port; + + return scm_fdes_to_port (SCM_INUM (fdes), SCM_ROCHARS (modes), SCM_BOOL_F); } #undef FUNC_NAME diff --git a/libguile/throw.c b/libguile/throw.c index 9096c8216..b3f9ed1d0 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -148,13 +148,11 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */ BODY is a pointer to a C function which runs the body of the catch; this is the code you can throw from. We call it like this: - BODY (BODY_DATA, JMPBUF) + BODY (BODY_DATA) where: BODY_DATA is just the BODY_DATA argument we received; we pass it through to BODY as its first argument. The caller can make BODY_DATA point to anything useful that BODY might need. - JMPBUF is the Scheme jmpbuf object corresponding to this catch, - which we have just created and initialized. HANDLER is a pointer to a C function to deal with a throw to TAG, should one occur. We call it like this: @@ -610,7 +608,6 @@ SCM_DEFINE (scm_throw, "throw", 1, 0, 1, } #undef FUNC_NAME - SCM scm_ithrow (SCM key, SCM args, int noreturn) { |