}
#undef FUNC_NAME
+SCM
+scm_current_warning_port (void)
+{
+ static SCM cwp_var = SCM_BOOL_F;
+
+ if (scm_is_false (cwp_var))
+ cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
+
+ return scm_call_0 (scm_variable_ref (cwp_var));
+}
+
SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
(),
"Return the current-load-port.\n"
}
#undef FUNC_NAME
+
+SCM
+scm_set_current_warning_port (SCM port)
+{
+ static SCM cwp_var = SCM_BOOL_F;
+
+ if (scm_is_false (cwp_var))
+ cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
+
+ return scm_call_1 (scm_variable_ref (cwp_var), port);
+}
+
+
void
scm_dynwind_current_input_port (SCM port)
#define FUNC_NAME NULL
SCM_SET_CELL_WORD_1 (ret, (scm_t_bits) entry);
SCM_SET_CELL_WORD_2 (ret, (scm_t_bits) ptob);
-#if SCM_USE_PTHREAD_THREADS
- scm_i_pthread_mutex_init (&entry->lock, scm_i_pthread_mutexattr_recursive);
-#endif
+ entry->lock = scm_gc_malloc_pointerless (sizeof (*entry->lock), "port lock");
+ scm_i_pthread_mutex_init (entry->lock, scm_i_pthread_mutexattr_recursive);
entry->file_name = SCM_BOOL_F;
entry->rw_active = SCM_PORT_NEITHER;
\f
+/* The port lock. */
+
+static void
+lock_port (void *mutex)
+{
+ scm_i_pthread_mutex_lock (mutex);
+}
+
+static void
+unlock_port (void *mutex)
+{
+ scm_i_pthread_mutex_unlock (mutex);
+}
+
+void
+scm_dynwind_lock_port (SCM port)
+#define FUNC_NAME "dynwind-lock-port"
+{
+ scm_i_pthread_mutex_t *lock;
+ SCM_VALIDATE_OPPORT (SCM_ARG1, port);
+ scm_c_lock_port (port, &lock);
+ if (lock)
+ {
+ scm_dynwind_unwind_handler (unlock_port, lock, SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_rewind_handler (lock_port, lock, 0);
+ }
+}
+#undef FUNC_NAME
+
+
+\f
+
/* Revealed counts --- an oddity inherited from SCSH. */
/* Find a port in the table and return its revealed count.
int
scm_revealed_count (SCM port)
{
+ scm_i_pthread_mutex_t *lock;
int ret;
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
ret = SCM_REVEALED (port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
return ret;
}
#define FUNC_NAME s_scm_set_port_revealed_x
{
int r;
+ scm_i_pthread_mutex_t *lock;
+
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
r = scm_to_int (rcount);
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
SCM_REVEALED (port) = r;
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
(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_set_port_revealed_x
+#define FUNC_NAME s_scm_adjust_port_revealed_x
{
+ scm_i_pthread_mutex_t *lock;
int a;
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1, port);
a = scm_to_int (addend);
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
SCM_REVEALED (port) += a;
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
int
scm_get_byte_or_eof (SCM port)
{
+ scm_i_pthread_mutex_t *lock;
int ret;
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
ret = scm_get_byte_or_eof_unlocked (port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
return ret;
}
int
scm_peek_byte_or_eof (SCM port)
{
+ scm_i_pthread_mutex_t *lock;
int ret;
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
ret = scm_peek_byte_or_eof_unlocked (port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
return ret;
}
/* Call scm_fill_input until we have all the bytes that we need,
or we hit EOF. */
- while (pt->read_buf_size && (scm_fill_input (port) != EOF))
+ while (pt->read_buf_size && (scm_fill_input_unlocked (port) != EOF))
{
pt->read_buf_size -= (pt->read_end - pt->read_pos);
pt->read_pos = pt->read_buf = pt->read_end;
that a custom port implementation's entry points (in
particular, fill_input) can rely on the buffer always being
the same as they first set up. */
- while (size && (scm_fill_input (port) != EOF))
+ while (size && (scm_fill_input_unlocked (port) != EOF))
{
n_available = min (size, pt->read_end - pt->read_pos);
memcpy (buffer, pt->read_pos, n_available);
size_t
scm_c_read (SCM port, void *buffer, size_t size)
{
+ scm_i_pthread_mutex_t *lock;
size_t ret;
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
ret = scm_c_read_unlocked (port, buffer, size);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
return ret;
}
scm_t_wchar
scm_getc (SCM port)
{
+ scm_i_pthread_mutex_t *lock;
scm_t_wchar ret;
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
ret = scm_getc_unlocked (port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
return ret;
}
/* Pushback. */
void
-scm_unget_byte (int c, SCM port)
+scm_unget_byte_unlocked (int c, SCM port)
#define FUNC_NAME "scm_unget_byte"
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
}
#undef FUNC_NAME
+void
+scm_unget_byte (int c, SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_unget_byte_unlocked (c, port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
+
void
-scm_ungetc (scm_t_wchar c, SCM port)
+scm_ungetc_unlocked (scm_t_wchar c, SCM port)
#define FUNC_NAME "scm_ungetc"
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM_BOOL_F, SCM_MAKE_CHAR (c));
for (i = len - 1; i >= 0; i--)
- scm_unget_byte (result[i], port);
+ scm_unget_byte_unlocked (result[i], port);
if (SCM_UNLIKELY (result != result_buf))
free (result);
}
#undef FUNC_NAME
+void
+scm_ungetc (scm_t_wchar c, SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_ungetc_unlocked (c, port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
void
-scm_ungets (const char *s, int n, SCM port)
+scm_ungets_unlocked (const char *s, int n, SCM port)
{
/* This is simple minded and inefficient, but unreading strings is
* probably not a common operation, and remember that line and
* Please feel free to write an optimized version!
*/
while (n--)
- scm_ungetc (s[n], port);
+ scm_ungetc_unlocked (s[n], port);
}
+void
+scm_ungets (const char *s, int n, SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_ungets_unlocked (s, n, port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
(SCM port),
err = get_codepoint (port, &c, bytes, &len);
for (i = len - 1; i >= 0; i--)
- scm_unget_byte (bytes[i], port);
+ scm_unget_byte_unlocked (bytes[i], port);
SCM_COL (port) = column;
SCM_LINUM (port) = line;
c = SCM_CHAR (cobj);
- scm_ungetc (c, port);
+ scm_ungetc_unlocked (c, port);
return cobj;
}
#undef FUNC_NAME
n = scm_i_string_length (str);
while (n--)
- scm_ungetc (scm_i_string_ref (str, n), port);
+ scm_ungetc_unlocked (scm_i_string_ref (str, n), port);
return str;
}
/* Manipulating the buffers. */
+/* This routine does not take any locks, as it is usually called as part
+ of a port implementation. */
void
scm_port_non_buffer (scm_t_port *pt)
{
tries to refill the read buffer. it returns the first char from
the port, which is either EOF or *(pt->read_pos). */
int
-scm_fill_input (SCM port)
+scm_fill_input_unlocked (SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
return SCM_PORT_DESCRIPTOR (port)->fill_input (port);
}
+int
+scm_fill_input (SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ int ret;
+
+ scm_c_lock_port (port, &lock);
+ ret = scm_fill_input_unlocked (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+
+ return ret;
+}
+
/* move up to read_len chars from port's putback and/or read buffers
into memory starting at dest. returns the number of chars moved. */
size_t
#undef FUNC_NAME
void
-scm_end_input (SCM port)
+scm_end_input_unlocked (SCM port)
{
long offset;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM_PORT_DESCRIPTOR (port)->end_input (port, offset);
}
+void
+scm_end_input (SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_end_input_unlocked (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
+
SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
(SCM port),
"Flush the specified output port, or the current output port if @var{port}\n"
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPOUTPORT (1, port);
}
- scm_flush (port);
+ scm_flush_unlocked (port);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
void
-scm_flush (SCM port)
+scm_flush_unlocked (SCM port)
{
SCM_PORT_DESCRIPTOR (port)->flush (port);
}
+void
+scm_flush (SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_flush_unlocked (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
+
\f
/* Output. */
+void
+scm_putc (char c, SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_putc_unlocked (c, port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
+
+void
+scm_puts (const char *s, SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_puts_unlocked (s, port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
+
/* scm_c_write
*
* Used by an application to write arbitrary number of bytes to an SCM
* Warning: Doesn't update port line and column counts!
*/
void
-scm_c_write (SCM port, const void *ptr, size_t size)
+scm_c_write_unlocked (SCM port, const void *ptr, size_t size)
#define FUNC_NAME "scm_c_write"
{
scm_t_port *pt;
ptob = SCM_PORT_DESCRIPTOR (port);
if (pt->rw_active == SCM_PORT_READ)
- scm_end_input (port);
+ scm_end_input_unlocked (port);
ptob->write (port, ptr, size);
}
#undef FUNC_NAME
+void
+scm_c_write (SCM port, const void *ptr, size_t size)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_c_write_unlocked (port, ptr, size);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
+
/* scm_lfwrite
*
* This function differs from scm_c_write; it updates port line and
* column. */
void
-scm_lfwrite (const char *ptr, size_t size, SCM port)
+scm_lfwrite_unlocked (const char *ptr, size_t size, SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
if (pt->rw_active == SCM_PORT_READ)
- scm_end_input (port);
+ scm_end_input_unlocked (port);
ptob->write (port, ptr, size);
pt->rw_active = SCM_PORT_WRITE;
}
+void
+scm_lfwrite (const char *ptr, size_t size, SCM port)
+{
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
+ scm_lfwrite_unlocked (ptr, size, port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
+}
+
/* Write STR to PORT from START inclusive to END exclusive. */
void
scm_lfwrite_substr (SCM str, size_t start, size_t end, SCM port)
scm_t_port *pt = SCM_PTAB_ENTRY (port);
if (pt->rw_active == SCM_PORT_READ)
- scm_end_input (port);
+ scm_end_input_unlocked (port);
if (end == (size_t) -1)
end = scm_i_string_length (str);
if (!ptob->truncate)
SCM_MISC_ERROR ("port is not truncatable", SCM_EOL);
if (pt->rw_active == SCM_PORT_READ)
- scm_end_input (object);
+ scm_end_input_unlocked (object);
else if (pt->rw_active == SCM_PORT_WRITE)
ptob->flush (object);
void
scm_print_port_mode (SCM exp, SCM port)
{
- scm_puts (SCM_CLOSEDP (exp)
+ scm_puts_unlocked (SCM_CLOSEDP (exp)
? "closed: "
: (SCM_RDNG & SCM_CELL_WORD_0 (exp)
? (SCM_WRTNG & SCM_CELL_WORD_0 (exp)
char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp));
if (!type)
type = "port";
- scm_puts ("#<", port);
+ scm_puts_unlocked ("#<", port);
scm_print_port_mode (exp, port);
- scm_puts (type, port);
- scm_putc (' ', port);
+ scm_puts_unlocked (type, port);
+ scm_putc_unlocked (' ', port);
scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port);
- scm_putc ('>', port);
+ scm_putc_unlocked ('>', port);
return 1;
}
flush_output_port (void *closure, SCM port)
{
if (SCM_OPOUTPORTP (port))
- scm_flush (port);
+ scm_flush_unlocked (port);
}
SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
#include "libguile/ports.x"
/* Use Latin-1 as the default port encoding. */
- SCM_VARIABLE_SET (default_port_encoding_var, scm_make_fluid ());
- scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), SCM_BOOL_F);
+ SCM_VARIABLE_SET (default_port_encoding_var,
+ scm_make_fluid_with_default (SCM_BOOL_F));
scm_port_encoding_init = 1;
- SCM_VARIABLE_SET (scm_conversion_strategy, scm_make_fluid ());
- scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy),
- scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK));
+ SCM_VARIABLE_SET (scm_conversion_strategy,
+ scm_make_fluid_with_default
+ (scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK)));
scm_conversion_strategy_init = 1;
+ /* These bindings are used when boot-9 turns `current-input-port' et
+ al into parameters. They are then removed from the guile module. */
+ scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
+ scm_c_define ("%current-output-port-fluid", cur_outport_fluid);
+ scm_c_define ("%current-error-port-fluid", cur_errport_fluid);
}
/*
HCoop / bpt / guile.git / blobdiff