diff options
Diffstat (limited to 'libguile/fports.c')
-rw-r--r-- | libguile/fports.c | 203 |
1 files changed, 149 insertions, 54 deletions
diff --git a/libguile/fports.c b/libguile/fports.c index 365d3ffe0..672f575a8 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -159,14 +159,14 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, size_t ndrained; char *drained; scm_t_port *pt; - scm_t_port_internal *pti; + scm_t_ptob_descriptor *ptob; port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - pti = SCM_PORT_GET_INTERNAL (port); + ptob = SCM_PORT_DESCRIPTOR (port); - if (pti->setvbuf == NULL) + if (ptob->setvbuf == NULL) scm_wrong_type_arg_msg (FUNC_NAME, 1, port, "port that supports 'setvbuf'"); @@ -217,7 +217,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) { @@ -227,7 +227,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, pt->read_buf_size = pt->saved_read_buf_size; } - pti->setvbuf (port, csize, csize); + ptob->setvbuf (port, csize, csize); if (ndrained > 0) /* Put DRAINED back to PORT. */ @@ -476,6 +476,8 @@ scm_open_file (SCM filename, SCM mode) static SCM k_guess_encoding = SCM_UNDEFINED; static SCM k_encoding = SCM_UNDEFINED; +SCM_INTERNAL SCM scm_i_open_file (SCM, SCM, SCM); + SCM_DEFINE (scm_i_open_file, "open-file", 2, 0, 1, (SCM filename, SCM mode, SCM keyword_args), "Open the file whose name is @var{filename}, and return a port\n" @@ -547,8 +549,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_port_internal *pti; + scm_t_fport *fp; /* Test that fdes is valid. */ #ifdef F_GETFL @@ -570,31 +571,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_new_port_table_entry (scm_tc16_fport); - SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits); - pt = SCM_PTAB_ENTRY (port); + 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); - /* File ports support 'setvbuf'. */ - pti = SCM_PORT_GET_INTERNAL (port); - pti->setvbuf = scm_fport_buffer_add; + if (mode_bits & SCM_BUF0) + scm_fport_buffer_add (port, 0, 0); + else + scm_fport_buffer_add (port, -1, -1); - { - 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 @@ -619,11 +610,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)) { @@ -632,8 +720,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) @@ -645,11 +733,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; } @@ -704,7 +792,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 @@ -838,32 +926,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 @@ -886,6 +980,7 @@ scm_make_fptob () scm_set_port_seek (tc, fport_seek); scm_set_port_truncate (tc, fport_truncate); scm_set_port_input_waiting (tc, fport_input_waiting); + scm_set_port_setvbuf (tc, scm_fport_buffer_add); return tc; } |