}
#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;
}
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;
}
void
scm_unget_byte (int c, SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_unget_byte_unlocked (c, port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
void
void
scm_ungetc (scm_t_wchar c, SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_ungetc_unlocked (c, port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
void
void
scm_ungets (const char *s, int n, SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_ungets_unlocked (s, n, port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
int
scm_fill_input (SCM port)
{
+ scm_i_pthread_mutex_t *lock;
int ret;
- scm_c_lock_port (port);
+ scm_c_lock_port (port, &lock);
ret = scm_fill_input_unlocked (port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
return ret;
}
void
scm_end_input (SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_end_input_unlocked (port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
void
scm_flush (SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_flush_unlocked (port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
void
scm_putc (char c, SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_putc_unlocked (c, port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
void
scm_puts (const char *s, SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_puts_unlocked (s, port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
/* scm_c_write
* 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;
}
#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);
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)
#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