--- orig/libguile/fports.c +++ mod/libguile/fports.c @@ -86,71 +86,78 @@ scm_t_bits scm_tc16_fport; +static void fport_flush (SCM port); + +/* Hints passed to the GC allocation functions for port buffers and file + ports. */ +static const char gc_port_buffer_hint[] = "port buffer"; +static const char gc_file_port_hint[] = "file port"; /* default buffer size, used if the O/S won't supply a value. */ static const size_t default_buffer_size = 1024; -/* create FPORT buffer with specified sizes (or -1 to use default size or - 0 for no buffer. */ +/* 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, long read_size, int write_size) +fport_buffer_add (SCM port, long c_buffer_size) #define FUNC_NAME "scm_fport_buffer_add" { + SCM buffer_size, mode; + int c_mode = _IOFBF; scm_t_port *pt = SCM_PTAB_ENTRY (port); - if (read_size == -1 || write_size == -1) + if (c_buffer_size == -1) { - size_t default_size; #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE struct stat st; scm_t_fport *fp = SCM_FSTREAM (port); - - default_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size + + c_buffer_size = (fstat (fp->fdes, &st) == -1) ? default_buffer_size : st.st_blksize; #else - default_size = default_buffer_size; + c_buffer_size = default_buffer_size; #endif - if (read_size == -1) - read_size = default_size; - if (write_size == -1) - write_size = default_size; } - if (SCM_INPUT_PORT_P (port) && read_size > 0) - { - pt->read_buf = scm_gc_malloc (read_size, "port buffer"); - pt->read_pos = pt->read_end = pt->read_buf; - pt->read_buf_size = read_size; - } + buffer_size = scm_from_long (c_buffer_size); + c_mode = (SCM_CELL_WORD_0 (port) & SCM_BUFLINE) ? _IOLBF : _IOFBF; + mode = scm_from_int (c_mode); + + if (SCM_INPUT_PORT_P (port) && (buffer_size > 0)) + scm_setvbuf_input (port, mode, buffer_size); else { pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf; pt->read_buf_size = 1; } - if (SCM_OUTPUT_PORT_P (port) && write_size > 0) - { - pt->write_buf = scm_gc_malloc (write_size, "port buffer"); - pt->write_pos = pt->write_buf; - pt->write_buf_size = write_size; - } + if (SCM_OUTPUT_PORT_P (port) && (buffer_size > 0)) + scm_setvbuf_output (port, mode, buffer_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_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0); - else - SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0); } #undef FUNC_NAME +/* Convert MODE to a C buffering mode. */ +static inline int +scm_to_buffer_mode (SCM mode, const char *func_name) +{ + int c_mode; + + c_mode = scm_to_int (mode); + if (c_mode != _IONBF && c_mode != _IOFBF && c_mode != _IOLBF) + scm_out_of_range (func_name, mode); + + return c_mode; +} + SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, (SCM port, SCM mode, SCM size), - "Set the buffering mode for @var{port}. @var{mode} can be:\n" + "Set the input and output buffering mode for @var{port}. " + "@var{mode} can be:\n" "@table @code\n" "@item _IONBF\n" "non-buffered\n" @@ -162,61 +169,163 @@ "@end table") #define FUNC_NAME s_scm_setvbuf { - int cmode; - long csize; - scm_t_port *pt; - port = SCM_COERCE_OUTPORT (port); - SCM_VALIDATE_OPFPORT (1,port); - cmode = scm_to_int (mode); - if (cmode != _IONBF && cmode != _IOFBF && cmode != _IOLBF) - scm_out_of_range (FUNC_NAME, mode); + SCM_VALIDATE_OPFPORT (1, port); + + if (SCM_INPUT_PORT_P (port)) + scm_setvbuf_input (port, mode, size); + + if (SCM_OUTPUT_PORT_P (port)) + scm_setvbuf_output (port, mode, size); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_setvbuf_input, "setvbuf-input", 2, 1, 0, + (SCM port, SCM mode, SCM size), + "Set the input buffering mode for @var{port}, with the " + "@var{mode} and @var{size} arguments akin to those of " + "@code{setvbuf}.") +#define FUNC_NAME s_scm_setvbuf_input +{ + scm_t_port *c_port; + int c_mode; + size_t c_size; + unsigned char *new_buf; - if (cmode == _IOLBF) + SCM_VALIDATE_FPORT (1, port); + SCM_VALIDATE_OPINPORT (1, port); + + c_port = SCM_PTAB_ENTRY (port); + c_mode = scm_to_buffer_mode (mode, FUNC_NAME); + if (SCM_UNBNDP (size)) { - SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE); - cmode = _IOFBF; + if (c_mode == _IOFBF) + c_size = -1; + else + c_size = 0; + } + else + { + c_size = scm_to_int (size); + if (c_size < 0 || (c_mode == _IONBF && c_size > 0)) + scm_out_of_range (FUNC_NAME, size); + } + + if (c_port->read_buf == c_port->putback_buf) + { + /* Silently discard buffered and put-back chars. */ + c_port->read_buf = c_port->saved_read_buf; + c_port->read_pos = c_port->saved_read_pos; + c_port->read_end = c_port->saved_read_end; + c_port->read_buf_size = c_port->saved_read_buf_size; + } + + if (c_size == 0) + { + new_buf = &c_port->shortbuf, c_size = 1; + if (c_port->read_buf != &c_port->shortbuf) + scm_gc_free (c_port->read_buf, c_port->read_buf_size, + gc_port_buffer_hint); } else { - SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~(scm_t_bits)SCM_BUFLINE); + if (c_port->read_buf != &c_port->shortbuf) + new_buf = scm_gc_realloc (c_port->read_buf, + c_port->read_buf_size, c_size, + gc_port_buffer_hint); + else + new_buf = scm_gc_malloc (c_size, gc_port_buffer_hint); } + c_port->read_buf = new_buf; + c_port->read_end = new_buf; + c_port->read_pos = new_buf; + c_port->read_buf_size = c_size; + + if ((c_port->read_buf_size == 0) && (c_port->write_buf_size == 0)) + SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0); + else + SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_setvbuf_output, "setvbuf-output", 2, 1, 0, + (SCM port, SCM mode, SCM size), + "Set the output buffering mode for @var{port}, with the " + "@var{mode} and @var{size} arguments akin to those of " + "@code{setvbuf}.") +#define FUNC_NAME s_scm_setvbuf_output +{ + scm_t_port *c_port; + int c_mode; + size_t c_size; + unsigned char *new_buf; + + SCM_VALIDATE_FPORT (1, port); + + c_port = SCM_PTAB_ENTRY (port); + c_mode = scm_to_buffer_mode (mode, FUNC_NAME); if (SCM_UNBNDP (size)) { - if (cmode == _IOFBF) - csize = -1; + if (c_mode == _IOFBF) + c_size = -1; else - csize = 0; + c_size = 0; } else { - csize = scm_to_int (size); - if (csize < 0 || (cmode == _IONBF && csize > 0)) + c_size = scm_to_int (size); + if (c_size < 0 || (c_mode == _IONBF && c_size > 0)) scm_out_of_range (FUNC_NAME, size); } - pt = SCM_PTAB_ENTRY (port); + /* Note: line buffering is only supported by `fport_write ()'. */ + if (c_mode == _IOLBF) + { + SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUFLINE); + c_mode = _IOFBF; + } + else + SCM_SET_CELL_WORD_0 (port, + SCM_CELL_WORD_0 (port) & ~(scm_t_bits) SCM_BUFLINE); - /* silently discards buffered and put-back chars. */ - if (pt->read_buf == pt->putback_buf) + if (c_size == 0) { - pt->read_buf = pt->saved_read_buf; - pt->read_pos = pt->saved_read_pos; - pt->read_end = pt->saved_read_end; - pt->read_buf_size = pt->saved_read_buf_size; + new_buf = &c_port->shortbuf, c_size = 1; + if (c_port->write_buf != &c_port->shortbuf) + scm_gc_free (c_port->write_buf, c_port->write_buf_size, + gc_port_buffer_hint); } - if (pt->read_buf != &pt->shortbuf) - scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer"); - if (pt->write_buf != &pt->shortbuf) - scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer"); + else + { + if (c_port->write_buf != &c_port->shortbuf) + new_buf = scm_gc_realloc (c_port->write_buf, + c_port->write_buf_size, c_size, + gc_port_buffer_hint); + else + new_buf = scm_gc_malloc (c_size, gc_port_buffer_hint); + } + + c_port->write_buf = new_buf; + c_port->write_end = new_buf + c_size; + c_port->write_pos = new_buf; + c_port->write_buf_size = c_size; + + if ((c_port->read_buf_size == 0) && (c_port->write_buf_size == 0)) + SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) | SCM_BUF0); + else + SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0); - scm_fport_buffer_add (port, csize, csize); return SCM_UNSPECIFIED; } #undef FUNC_NAME + /* Move ports with the specified file descriptor to new descriptors, * resetting the revealed count to 0. */ @@ -459,15 +568,16 @@ pt = SCM_PTAB_ENTRY(port); { scm_t_fport *fp - = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port"); + = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), + gc_file_port_hint); fp->fdes = fdes; pt->rw_random = SCM_FDES_RANDOM_P (fdes); SCM_SETSTREAM (port, fp); if (mode_bits & SCM_BUF0) - scm_fport_buffer_add (port, 0, 0); + fport_buffer_add (port, 0); else - scm_fport_buffer_add (port, -1, -1); + fport_buffer_add (port, -1); } SCM_SET_FILENAME (port, name); scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); @@ -583,8 +693,6 @@ } #endif /* !__MINGW32__ */ -static void fport_flush (SCM port); - /* fill a port's read-buffer with a single read. returns the first char or EOF if end of file. */ static int @@ -892,10 +1000,10 @@ if (pt->read_buf == pt->putback_buf) pt->read_buf = pt->saved_read_buf; if (pt->read_buf != &pt->shortbuf) - scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer"); + scm_gc_free (pt->read_buf, pt->read_buf_size, gc_port_buffer_hint); if (pt->write_buf != &pt->shortbuf) - scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer"); - scm_gc_free (fp, sizeof (*fp), "file port"); + scm_gc_free (pt->write_buf, pt->write_buf_size, gc_port_buffer_hint); + scm_gc_free (fp, sizeof (*fp), gc_file_port_hint); return rv; } --- orig/libguile/fports.h +++ mod/libguile/fports.h @@ -49,6 +49,8 @@ SCM_API SCM scm_setbuf0 (SCM port); SCM_API SCM scm_setvbuf (SCM port, SCM mode, SCM size); +SCM_API SCM scm_setvbuf_input (SCM port, SCM mode, SCM size); +SCM_API SCM scm_setvbuf_output (SCM port, SCM mode, SCM size); SCM_API void scm_evict_ports (int fd); SCM_API SCM scm_open_file (SCM filename, SCM modes); SCM_API SCM scm_fdes_to_port (int fdes, char *mode, SCM name);