diff options
Diffstat (limited to 'libguile/fports.c')
-rw-r--r-- | libguile/fports.c | 190 |
1 files changed, 144 insertions, 46 deletions
diff --git a/libguile/fports.c b/libguile/fports.c index 70732e5a0..13d1dd732 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -207,7 +207,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, ndrained = 0; if (SCM_OUTPUT_PORT_P (port)) - scm_flush (port); + scm_flush_unlocked (port); if (pt->read_buf == pt->putback_buf) { @@ -541,7 +541,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) #define FUNC_NAME "scm_fdes_to_port" { SCM port; - scm_t_port *pt; + scm_t_fport *fp; /* Test that fdes is valid. */ #ifdef F_GETFL @@ -563,26 +563,21 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name) SCM_SYSERROR; #endif - scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); + fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport), + "file port"); + fp->fdes = fdes; + + port = scm_c_make_port (scm_tc16_fport, mode_bits, (scm_t_bits)fp); + + SCM_PTAB_ENTRY (port)->rw_random = SCM_FDES_RANDOM_P (fdes); + + if (mode_bits & SCM_BUF0) + scm_fport_buffer_add (port, 0, 0); + else + scm_fport_buffer_add (port, -1, -1); - port = scm_new_port_table_entry (scm_tc16_fport); - SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits); - pt = SCM_PTAB_ENTRY(port); - { - scm_t_fport *fp - = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport), - "file port"); - - 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); - else - scm_fport_buffer_add (port, -1, -1); - } SCM_SET_FILENAME (port, name); - scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); + return port; } #undef FUNC_NAME @@ -607,11 +602,108 @@ fport_input_waiting (SCM port) return pollfd.revents & POLLIN ? 1 : 0; } + + + +/* Revealed counts --- an oddity inherited from SCSH. */ + +#define SCM_REVEALED(x) (SCM_FSTREAM(x)->revealed) + +static SCM revealed_ports = SCM_EOL; +static scm_i_pthread_mutex_t revealed_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; + +/* Find a port in the table and return its revealed count. + Also used by the garbage collector. + */ +int +scm_revealed_count (SCM port) +{ + int ret; + + scm_i_pthread_mutex_lock (&revealed_lock); + ret = SCM_REVEALED (port); + scm_i_pthread_mutex_unlock (&revealed_lock); + + return ret; +} + +SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0, + (SCM port), + "Return the revealed count for @var{port}.") +#define FUNC_NAME s_scm_port_revealed +{ + port = SCM_COERCE_OUTPORT (port); + SCM_VALIDATE_OPFPORT (1, port); + return scm_from_int (scm_revealed_count (port)); +} +#undef FUNC_NAME + +/* Set the revealed count for a port. */ +SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0, + (SCM port, SCM rcount), + "Sets the revealed count for a port to a given value.\n" + "The return value is unspecified.") +#define FUNC_NAME s_scm_set_port_revealed_x +{ + int r, prev; + + port = SCM_COERCE_OUTPORT (port); + SCM_VALIDATE_OPFPORT (1, port); + + r = scm_to_int (rcount); + + scm_i_pthread_mutex_lock (&revealed_lock); + + prev = SCM_REVEALED (port); + SCM_REVEALED (port) = r; + + if (r && !prev) + revealed_ports = scm_cons (port, revealed_ports); + else if (prev && !r) + revealed_ports = scm_delq_x (port, revealed_ports); + + scm_i_pthread_mutex_unlock (&revealed_lock); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +/* Set the revealed count for a port. */ +SCM_DEFINE (scm_adjust_port_revealed_x, "adjust-port-revealed!", 2, 0, 0, + (SCM port, SCM addend), + "Add @var{addend} to the revealed count of @var{port}.\n" + "The return value is unspecified.") +#define FUNC_NAME s_scm_adjust_port_revealed_x +{ + int a; + + port = SCM_COERCE_OUTPORT (port); + SCM_VALIDATE_OPFPORT (1, port); + + a = scm_to_int (addend); + if (!a) + return SCM_UNSPECIFIED; + + scm_i_pthread_mutex_lock (&revealed_lock); + + SCM_REVEALED (port) += a; + if (SCM_REVEALED (port) == a) + revealed_ports = scm_cons (port, revealed_ports); + else if (!SCM_REVEALED (port)) + revealed_ports = scm_delq_x (port, revealed_ports); + + scm_i_pthread_mutex_unlock (&revealed_lock); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + static int fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { - scm_puts ("#<", port); + scm_puts_unlocked ("#<", port); scm_print_port_mode (exp, port); if (SCM_OPFPORTP (exp)) { @@ -620,8 +712,8 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) if (scm_is_string (name) || scm_is_symbol (name)) scm_display (name, port); else - scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); - scm_putc (' ', port); + scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); + scm_putc_unlocked (' ', port); fdes = (SCM_FSTREAM (exp))->fdes; #if (defined HAVE_TTYNAME) && (defined HAVE_POSIX) @@ -633,11 +725,11 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) } else { - scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); - scm_putc (' ', port); + scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); + scm_putc_unlocked (' ', port); scm_uintprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port); } - scm_putc ('>', port); + scm_putc_unlocked ('>', port); return 1; } @@ -692,7 +784,7 @@ fport_seek (SCM port, scm_t_off offset, int whence) if (offset != 0 || whence != SEEK_CUR) { /* could expand to avoid a second seek. */ - scm_end_input (port); + scm_end_input_unlocked (port); result = rv = lseek_or_lseek64 (fp->fdes, offset, whence); } else @@ -826,32 +918,38 @@ fport_end_input (SCM port, int offset) pt->rw_active = SCM_PORT_NEITHER; } +static void +close_the_fd (void *data) +{ + scm_t_fport *fp = data; + + close (fp->fdes); + /* There's already one exception. That's probably enough! */ + errno = 0; +} + static int fport_close (SCM port) { scm_t_fport *fp = SCM_FSTREAM (port); - scm_t_port *pt = SCM_PTAB_ENTRY (port); int rv; + scm_dynwind_begin (0); + scm_dynwind_unwind_handler (close_the_fd, fp, 0); fport_flush (port); - SCM_SYSCALL (rv = close (fp->fdes)); - if (rv == -1 && errno != EBADF) - { - if (scm_gc_running_p) - /* silently ignore the error. scm_error would abort if we - called it now. */ - ; - else - scm_syserror ("fport_close"); - } - 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"); - 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"); - return rv; + scm_dynwind_end (); + + scm_port_non_buffer (SCM_PTAB_ENTRY (port)); + + rv = close (fp->fdes); + if (rv) + /* It's not useful to retry after EINTR, as the file descriptor is + in an undefined state. See http://lwn.net/Articles/365294/. + Instead just throw an error if close fails, trusting that the fd + was cleaned up. */ + scm_syserror ("fport_close"); + + return 0; } static size_t |