/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+ * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
{
int cmode;
long csize;
- SCM drained;
+ size_t ndrained;
+ char *drained;
scm_t_port *pt;
port = SCM_COERCE_OUTPORT (port);
pt = SCM_PTAB_ENTRY (port);
if (SCM_INPUT_PORT_P (port))
- drained = scm_drain_input (port);
+ {
+ /* Drain pending input from PORT. Don't use `scm_drain_input' since
+ it returns a string, whereas we want binary input here. */
+ ndrained = pt->read_end - pt->read_pos;
+ if (pt->read_buf == pt->putback_buf)
+ ndrained += pt->saved_read_end - pt->saved_read_pos;
+
+ if (ndrained > 0)
+ {
+ drained = scm_gc_malloc_pointerless (ndrained, "file port");
+ scm_take_from_input_buffers (port, drained, ndrained);
+ }
+ }
else
- drained = scm_nullstr;
+ ndrained = 0;
if (SCM_OUTPUT_PORT_P (port))
scm_flush_unlocked (port);
scm_fport_buffer_add (port, csize, csize);
- if (scm_is_true (drained) && scm_c_string_length (drained))
- scm_unread_string (drained, port);
+ if (ndrained > 0)
+ /* Put DRAINED back to PORT. */
+ while (ndrained-- > 0)
+ scm_unget_byte (drained[ndrained], port);
return SCM_UNSPECIFIED;
}
#endif
}
+
+\f
+
+/* 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
+
+
\f
static int
fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
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
HCoop / bpt / guile.git / blobdiff