summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/fports.c32
-rw-r--r--libguile/init.c81
-rw-r--r--libguile/ioext.c6
-rw-r--r--libguile/throw.c5
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)
{