}
#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;
/* The port lock. */
static void
-lock_port (SCM port)
+lock_port (void *mutex)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_lock (mutex);
}
static void
-unlock_port (SCM port)
+unlock_port (void *mutex)
{
- scm_c_unlock_port (port);
+ scm_i_pthread_mutex_unlock (mutex);
}
void
scm_dynwind_lock_port (SCM port)
+#define FUNC_NAME "dynwind-lock-port"
{
- scm_dynwind_unwind_handler_with_scm (unlock_port, port,
- SCM_F_WIND_EXPLICITLY);
- scm_dynwind_rewind_handler_with_scm (lock_port, port,
- SCM_F_WIND_EXPLICITLY);
+ 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
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
void
scm_c_write (SCM port, const void *ptr, size_t size)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_c_write_unlocked (port, ptr, size);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
/* scm_lfwrite
void
scm_lfwrite (const char *ptr, size_t size, SCM port)
{
- scm_c_lock_port (port);
+ scm_i_pthread_mutex_t *lock;
+ scm_c_lock_port (port, &lock);
scm_lfwrite_unlocked (ptr, size, port);
- scm_c_unlock_port (port);
+ if (lock)
+ scm_i_pthread_mutex_unlock (lock);
+
}
/* Write STR to PORT from START inclusive to END exclusive. */
(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);
}
/*