summaryrefslogtreecommitdiff
path: root/libguile/ports.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/ports.c')
-rw-r--r--libguile/ports.c132
1 files changed, 61 insertions, 71 deletions
diff --git a/libguile/ports.c b/libguile/ports.c
index ffa01f71f..5fe2e0763 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -41,6 +41,7 @@
#include "libguile/validate.h"
#include "libguile/ports.h"
#include "libguile/vectors.h"
+#include "libguile/fluids.h"
#ifdef HAVE_STRING_H
#include <string.h>
@@ -121,7 +122,7 @@ scm_make_port_type (char *name,
char *tmp;
if (255 <= scm_numptob)
goto ptoberr;
- SCM_DEFER_INTS;
+ SCM_CRITICAL_SECTION_START;
SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs,
(1 + scm_numptob)
* sizeof (scm_t_ptob_descriptor)));
@@ -148,7 +149,7 @@ scm_make_port_type (char *name,
scm_numptob++;
}
- SCM_ALLOW_INTS;
+ SCM_CRITICAL_SECTION_END;
if (!tmp)
{
ptoberr:
@@ -246,7 +247,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
scm_t_port *pt;
if (SCM_UNBNDP (port))
- port = scm_cur_inp;
+ port = scm_current_input_port ();
else
SCM_VALIDATE_OPINPORT (1, port);
@@ -341,6 +342,11 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
/* Standard ports --- current input, output, error, and more(!). */
+static SCM cur_inport_fluid;
+static SCM cur_outport_fluid;
+static SCM cur_errport_fluid;
+static SCM cur_loadport_fluid;
+
SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
(),
"Return the current input port. This is the default port used\n"
@@ -348,7 +354,7 @@ SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
"returns the @dfn{standard input} in Unix and C terminology.")
#define FUNC_NAME s_scm_current_input_port
{
- return scm_cur_inp;
+ return scm_fluid_ref (cur_inport_fluid);
}
#undef FUNC_NAME
@@ -360,7 +366,7 @@ SCM_DEFINE (scm_current_output_port, "current-output-port", 0, 0, 0,
"Unix and C terminology.")
#define FUNC_NAME s_scm_current_output_port
{
- return scm_cur_outp;
+ return scm_fluid_ref (cur_outport_fluid);
}
#undef FUNC_NAME
@@ -370,7 +376,7 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
"@dfn{standard error} in Unix and C terminology).")
#define FUNC_NAME s_scm_current_error_port
{
- return scm_cur_errp;
+ return scm_fluid_ref (cur_errport_fluid);
}
#undef FUNC_NAME
@@ -380,7 +386,7 @@ SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
"The load port is used internally by @code{primitive-load}.")
#define FUNC_NAME s_scm_current_load_port
{
- return scm_cur_loadp;
+ return scm_fluid_ref (cur_loadport_fluid);
}
#undef FUNC_NAME
@@ -393,9 +399,9 @@ SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0,
"so that they use the supplied @var{port} for input or output.")
#define FUNC_NAME s_scm_set_current_input_port
{
- SCM oinp = scm_cur_inp;
+ SCM oinp = scm_fluid_ref (cur_inport_fluid);
SCM_VALIDATE_OPINPORT (1, port);
- scm_cur_inp = port;
+ scm_fluid_set_x (cur_inport_fluid, port);
return oinp;
}
#undef FUNC_NAME
@@ -406,10 +412,10 @@ SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0,
"Set the current default output port to @var{port}.")
#define FUNC_NAME s_scm_set_current_output_port
{
- SCM ooutp = scm_cur_outp;
+ SCM ooutp = scm_fluid_ref (cur_outport_fluid);
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPOUTPORT (1, port);
- scm_cur_outp = port;
+ scm_fluid_set_x (cur_outport_fluid, port);
return ooutp;
}
#undef FUNC_NAME
@@ -420,69 +426,47 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
"Set the current default error port to @var{port}.")
#define FUNC_NAME s_scm_set_current_error_port
{
- SCM oerrp = scm_cur_errp;
+ SCM oerrp = scm_fluid_ref (cur_errport_fluid);
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPOUTPORT (1, port);
- scm_cur_errp = port;
+ scm_fluid_set_x (cur_errport_fluid, port);
return oerrp;
}
#undef FUNC_NAME
-typedef struct {
- SCM value;
- SCM (*getter) (void);
- SCM (*setter) (SCM);
-} swap_data;
-
-static void
-swap_port (SCM scm_data)
-{
- swap_data *d = (swap_data *)SCM_MALLOCDATA (scm_data);
- SCM t;
-
- t = d->getter ();
- d->setter (d->value);
- d->value = t;
-}
-
-static void
-scm_frame_current_foo_port (SCM port,
- SCM (*getter) (void), SCM (*setter) (SCM))
-{
- SCM scm_data = scm_malloc_obj (sizeof (swap_data));
- swap_data *data = (swap_data *)SCM_MALLOCDATA (scm_data);
- data->value = port;
- data->getter = getter;
- data->setter = setter;
-
- scm_frame_rewind_handler_with_scm (swap_port, scm_data,
- SCM_F_WIND_EXPLICITLY);
- scm_frame_unwind_handler_with_scm (swap_port, scm_data,
- SCM_F_WIND_EXPLICITLY);
-}
-
void
scm_frame_current_input_port (SCM port)
+#define FUNC_NAME NULL
{
- scm_frame_current_foo_port (port,
- scm_current_input_port,
- scm_set_current_input_port);
+ SCM_VALIDATE_OPINPORT (1, port);
+ scm_frame_fluid (cur_inport_fluid, port);
}
+#undef FUNC_NAME
void
scm_frame_current_output_port (SCM port)
+#define FUNC_NAME NULL
{
- scm_frame_current_foo_port (port,
- scm_current_output_port,
- scm_set_current_output_port);
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_VALIDATE_OPOUTPORT (1, port);
+ scm_frame_fluid (cur_outport_fluid, port);
}
+#undef FUNC_NAME
void
scm_frame_current_error_port (SCM port)
+#define FUNC_NAME NULL
+{
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_VALIDATE_OPOUTPORT (1, port);
+ scm_frame_fluid (cur_errport_fluid, port);
+}
+#undef FUNC_NAME
+
+void
+scm_i_frame_current_load_port (SCM port)
{
- scm_frame_current_foo_port (port,
- scm_current_error_port,
- scm_set_current_error_port);
+ scm_frame_fluid (cur_loadport_fluid, port);
}
@@ -493,7 +477,7 @@ scm_t_port **scm_i_port_table;
long scm_i_port_table_size = 0; /* Number of ports in scm_i_port_table. */
long scm_i_port_table_room = 20; /* Size of the array. */
-SCM_GLOBAL_MUTEX (scm_i_port_table_mutex);
+scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
/* This function is not and should not be thread safe. */
@@ -764,9 +748,9 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
rv = (scm_ptobs[i].close) (port);
else
rv = 0;
- scm_mutex_lock (&scm_i_port_table_mutex);
+ scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
scm_remove_from_port_table (port);
- scm_mutex_unlock (&scm_i_port_table_mutex);
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
SCM_CLR_PORT_OPEN_FLAG (port);
return scm_from_bool (rv >= 0);
}
@@ -815,18 +799,18 @@ scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
can change arbitrarily (from a GC, for example). So we first
collect the ports into a vector. -mvo */
- scm_mutex_lock (&scm_i_port_table_mutex);
+ scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
n = scm_i_port_table_size;
- scm_mutex_unlock (&scm_i_port_table_mutex);
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
ports = scm_c_make_vector (n, SCM_BOOL_F);
- scm_mutex_lock (&scm_i_port_table_mutex);
+ scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
if (n > scm_i_port_table_size)
n = scm_i_port_table_size;
for (i = 0; i < n; i++)
SCM_SIMPLE_VECTOR_SET (ports, i, scm_i_port_table[i]->port);
- scm_mutex_unlock (&scm_i_port_table_mutex);
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
for (i = 0; i < n; i++)
proc (data, SCM_SIMPLE_VECTOR_REF (ports, i));
@@ -919,7 +903,7 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
#define FUNC_NAME s_scm_force_output
{
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ port = scm_current_output_port ();
else
{
port = SCM_COERCE_OUTPORT (port);
@@ -938,13 +922,13 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
{
size_t i;
- scm_mutex_lock (&scm_i_port_table_mutex);
+ scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
for (i = 0; i < scm_i_port_table_size; i++)
{
if (SCM_OPOUTPORTP (scm_i_port_table[i]->port))
scm_flush (scm_i_port_table[i]->port);
}
- scm_mutex_unlock (&scm_i_port_table_mutex);
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -958,7 +942,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
{
int c;
if (SCM_UNBNDP (port))
- port = scm_cur_inp;
+ port = scm_current_input_port ();
SCM_VALIDATE_OPINPORT (1, port);
c = scm_getc (port);
if (EOF == c)
@@ -1300,7 +1284,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
{
int c, column;
if (SCM_UNBNDP (port))
- port = scm_cur_inp;
+ port = scm_current_input_port ();
else
SCM_VALIDATE_OPINPORT (1, port);
column = SCM_COL(port);
@@ -1325,7 +1309,7 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0,
SCM_VALIDATE_CHAR (1, cobj);
if (SCM_UNBNDP (port))
- port = scm_cur_inp;
+ port = scm_current_input_port ();
else
SCM_VALIDATE_OPINPORT (2, port);
@@ -1346,7 +1330,7 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
{
SCM_VALIDATE_STRING (1, str);
if (SCM_UNBNDP (port))
- port = scm_cur_inp;
+ port = scm_current_input_port ();
else
SCM_VALIDATE_OPINPORT (2, port);
@@ -1638,7 +1622,7 @@ write_void_port (SCM port SCM_UNUSED,
static SCM
scm_i_void_port (long mode_bits)
{
- scm_mutex_lock (&scm_i_port_table_mutex);
+ scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
{
SCM answer = scm_new_port_table_entry (scm_tc16_void_port);
scm_t_port * pt = SCM_PTAB_ENTRY(answer);
@@ -1647,7 +1631,7 @@ scm_i_void_port (long mode_bits)
SCM_SETSTREAM (answer, 0);
SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits);
- scm_mutex_unlock (&scm_i_port_table_mutex);
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return answer;
}
}
@@ -1683,6 +1667,12 @@ scm_init_ports ()
scm_tc16_void_port = scm_make_port_type ("void", fill_input_void_port,
write_void_port);
+
+ cur_inport_fluid = scm_permanent_object (scm_make_fluid ());
+ cur_outport_fluid = scm_permanent_object (scm_make_fluid ());
+ cur_errport_fluid = scm_permanent_object (scm_make_fluid ());
+ cur_loadport_fluid = scm_permanent_object (scm_make_fluid ());
+
#include "libguile/ports.x"
}