mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 02:00:26 +02:00
Code Activity

Threading changes.

Browse source
This commit is contained in:
Marius Vollmer 2005-01-24 19:14:54 +00:00
parent be1b896c82
commit a54a94b397
34 changed files with 1298 additions and 1127 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/__scm.h
View file

@ -508,9 +508,9 @@ do { \
(private or global, with unwind where necessary), and remove the
remaining DEFER/ALLOWs. */
#define SCM_DEFER_INTS scm_rec_mutex_lock (&scm_i_defer_mutex);
#define SCM_DEFER_INTS do { } while (0);
#define SCM_ALLOW_INTS scm_rec_mutex_unlock (&scm_i_defer_mutex);
#define SCM_ALLOW_INTS do { } while (0);
#define SCM_REDEFER_INTS SCM_DEFER_INTS

5
libguile/error.c
View file

@ -131,10 +131,7 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
{
SCM ret;
scm_frame_begin (0);
scm_frame_unwind_handler ((void(*)(void*)) scm_mutex_unlock,
&scm_i_misc_mutex,
SCM_F_WIND_EXPLICITLY);
scm_mutex_lock (&scm_i_misc_mutex);
scm_frame_pthread_mutex_lock (&scm_i_misc_mutex);
ret = scm_from_locale_string (SCM_I_STRERROR (scm_to_int (err)));

34
libguile/eval.c
View file

@ -24,6 +24,8 @@
* which are treated differently with respect to DEVAL. The heads of these
* sections are marked with the string "SECTION:". */
#define _GNU_SOURCE
/* SECTION: This code is compiled once.
*/
@ -87,6 +89,8 @@ char *alloca ();
#include "libguile/eval.h"
#include <pthread.h>
static SCM unmemoize_exprs (SCM expr, SCM env);
@ -2641,7 +2645,7 @@ static SCM deval (SCM x, SCM env);
? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1)))))
SCM_REC_MUTEX (source_mutex);
pthread_mutex_t source_mutex = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP;
/* Lookup a given local variable in an environment. The local variable is
@ -2936,11 +2940,11 @@ scm_eval_body (SCM code, SCM env)
{
if (SCM_ISYMP (SCM_CAR (code)))
{
scm_rec_mutex_lock (&source_mutex);
scm_pthread_mutex_lock (&source_mutex);
/* check for race condition */
if (SCM_ISYMP (SCM_CAR (code)))
m_expand_body (code, env);
scm_rec_mutex_unlock (&source_mutex);
pthread_mutex_unlock (&source_mutex);
goto again;
}
}
@ -3326,11 +3330,11 @@ dispatch:
{
if (SCM_ISYMP (form))
{
scm_rec_mutex_lock (&source_mutex);
scm_pthread_mutex_lock (&source_mutex);
/* check for race condition */
if (SCM_ISYMP (SCM_CAR (x)))
m_expand_body (x, env);
scm_rec_mutex_unlock (&source_mutex);
pthread_mutex_unlock (&source_mutex);
goto nontoplevel_begin;
}
else
@ -4929,11 +4933,11 @@ tail:
{
if (SCM_ISYMP (SCM_CAR (proc)))
{
scm_rec_mutex_lock (&source_mutex);
scm_pthread_mutex_lock (&source_mutex);
/* check for race condition */
if (SCM_ISYMP (SCM_CAR (proc)))
m_expand_body (proc, args);
scm_rec_mutex_unlock (&source_mutex);
pthread_mutex_unlock (&source_mutex);
goto again;
}
else
@ -5560,13 +5564,19 @@ scm_makprom (SCM code)
{
SCM_RETURN_NEWSMOB2 (scm_tc16_promise,
SCM_UNPACK (code),
scm_make_rec_mutex ());
scm_make_recursive_mutex ());
}
static SCM
promise_mark (SCM promise)
{
scm_gc_mark (SCM_PROMISE_MUTEX (promise));
return SCM_PROMISE_DATA (promise);
}
static size_t
promise_free (SCM promise)
{
scm_rec_mutex_free (SCM_PROMISE_MUTEX (promise));
return 0;
}
@ -5590,7 +5600,7 @@ SCM_DEFINE (scm_force, "force", 1, 0, 0,
#define FUNC_NAME s_scm_force
{
SCM_VALIDATE_SMOB (1, promise, promise);
scm_rec_mutex_lock (SCM_PROMISE_MUTEX (promise));
scm_lock_mutex (SCM_PROMISE_MUTEX (promise));
if (!SCM_PROMISE_COMPUTED_P (promise))
{
SCM ans = scm_call_0 (SCM_PROMISE_DATA (promise));
@ -5600,7 +5610,7 @@ SCM_DEFINE (scm_force, "force", 1, 0, 0,
SCM_SET_PROMISE_COMPUTED (promise);
}
}
scm_rec_mutex_unlock (SCM_PROMISE_MUTEX (promise));
scm_unlock_mutex (SCM_PROMISE_MUTEX (promise));
return SCM_PROMISE_DATA (promise);
}
#undef FUNC_NAME
@ -6004,7 +6014,7 @@ scm_init_eval ()
SCM_N_EVAL_OPTIONS);
scm_tc16_promise = scm_make_smob_type ("promise", 0);
scm_set_smob_mark (scm_tc16_promise, scm_markcdr);
scm_set_smob_mark (scm_tc16_promise, promise_mark);
scm_set_smob_free (scm_tc16_promise, promise_free);
scm_set_smob_print (scm_tc16_promise, promise_print);

3
libguile/eval.h
View file

@ -71,8 +71,7 @@ SCM_API SCM scm_eval_options_interface (SCM setting);
(SCM_F_PROMISE_COMPUTED & SCM_SMOB_FLAGS (promise))
#define SCM_SET_PROMISE_COMPUTED(promise) \
SCM_SET_SMOB_FLAGS ((promise), SCM_F_PROMISE_COMPUTED)
#define SCM_PROMISE_MUTEX(promise) \
((scm_t_rec_mutex *) SCM_SMOB_DATA_2 (promise))
#define SCM_PROMISE_MUTEX SCM_SMOB_OBJECT_2
#define SCM_PROMISE_DATA SCM_SMOB_OBJECT
#define SCM_SET_PROMISE_DATA SCM_SET_SMOB_OBJECT

8
libguile/fports.c
View file

@ -201,7 +201,7 @@ scm_evict_ports (int fd)
{
long i;
scm_mutex_lock (&scm_i_port_table_mutex);
scm_pthread_mutex_lock (&scm_i_port_table_mutex);
for (i = 0; i < scm_i_port_table_size; i++)
{
@ -221,7 +221,7 @@ scm_evict_ports (int fd)
}
}
scm_mutex_unlock (&scm_i_port_table_mutex);
pthread_mutex_unlock (&scm_i_port_table_mutex);
}
@ -425,7 +425,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
}
scm_mutex_lock (&scm_i_port_table_mutex);
scm_pthread_mutex_lock (&scm_i_port_table_mutex);
port = scm_new_port_table_entry (scm_tc16_fport);
SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits);
@ -443,7 +443,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
scm_fport_buffer_add (port, -1, -1);
}
SCM_SET_FILENAME (port, name);
scm_mutex_unlock (&scm_i_port_table_mutex);
pthread_mutex_unlock (&scm_i_port_table_mutex);
return port;
}
#undef FUNC_NAME

59
libguile/futures.c
View file

@ -39,7 +39,7 @@ do { \
list = SCM_FUTURE_NEXT (list); \
} while (0)
SCM_MUTEX (future_admin_mutex);
pthread_mutex_t future_admin_mutex = PTHREAD_MUTEX_INITIALIZER;
static SCM futures = SCM_EOL;
static SCM young = SCM_EOL;
@ -99,8 +99,8 @@ static char *s_future = "future";
static void
cleanup (scm_t_future *future)
{
scm_mutex_destroy (&future->mutex);
scm_cond_destroy (&future->cond);
pthread_mutex_destroy (&future->mutex);
pthread_cond_destroy (&future->cond);
scm_gc_free (future, sizeof (*future), s_future);
#ifdef SCM_FUTURES_DEBUG
++n_dead;
@ -110,18 +110,18 @@ cleanup (scm_t_future *future)
static SCM
future_loop (scm_t_future *future)
{
scm_mutex_lock (&future->mutex);
scm_pthread_mutex_lock (&future->mutex);
do {
if (future->status == SCM_FUTURE_SIGNAL_ME)
scm_cond_broadcast (&future->cond);
pthread_cond_broadcast (&future->cond);
future->status = SCM_FUTURE_COMPUTING;
future->data = (SCM_CLOSUREP (future->data)
? scm_i_call_closure_0 (future->data)
: scm_call_0 (future->data));
scm_cond_wait (&future->cond, &future->mutex);
scm_pthread_cond_wait (&future->cond, &future->mutex);
} while (!future->die_p);
future->status = SCM_FUTURE_DEAD;
scm_mutex_unlock (&future->mutex);
pthread_mutex_unlock (&future->mutex);
return SCM_UNSPECIFIED;
}
@ -129,7 +129,7 @@ static SCM
future_handler (scm_t_future *future, SCM key, SCM args)
{
future->status = SCM_FUTURE_DEAD;
scm_mutex_unlock (&future->mutex);
pthread_mutex_unlock (&future->mutex);
return scm_apply_1 (*scm_loc_sys_thread_handler, key, args);
}
@ -139,15 +139,15 @@ alloc_future (SCM thunk)
scm_t_future *f = scm_gc_malloc (sizeof (*f), s_future);
SCM future;
f->data = SCM_BOOL_F;
scm_mutex_init (&f->mutex, &scm_i_plugin_mutex);
scm_cond_init (&f->cond, 0);
pthread_mutex_init (&f->mutex, NULL);
pthread_cond_init (&f->cond, NULL);
f->die_p = 0;
f->status = SCM_FUTURE_TASK_ASSIGNED;
scm_mutex_lock (&future_admin_mutex);
scm_pthread_mutex_lock (&future_admin_mutex);
SCM_NEWSMOB2 (future, scm_tc16_future, futures, f);
SCM_SET_FUTURE_DATA (future, thunk);
futures = future;
scm_mutex_unlock (&future_admin_mutex);
pthread_mutex_unlock (&future_admin_mutex);
scm_spawn_thread ((scm_t_catch_body) future_loop,
SCM_FUTURE (future),
(scm_t_catch_handler) future_handler,
@ -166,7 +166,7 @@ SCM
scm_i_make_future (SCM thunk)
{
SCM future;
scm_mutex_lock (&future_admin_mutex);
scm_pthread_mutex_lock (&future_admin_mutex);
while (1)
{
if (!scm_is_null (old))
@ -175,25 +175,25 @@ scm_i_make_future (SCM thunk)
UNLINK (young, future);
else
{
scm_mutex_unlock (&future_admin_mutex);
pthread_mutex_unlock (&future_admin_mutex);
return alloc_future (thunk);
}
if (scm_mutex_trylock (SCM_FUTURE_MUTEX (future)))
if (pthread_mutex_trylock (SCM_FUTURE_MUTEX (future)))
kill_future (future);
else if (!SCM_FUTURE_ALIVE_P (future))
{
scm_mutex_unlock (SCM_FUTURE_MUTEX (future));
pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
cleanup (SCM_FUTURE (future));
}
else
break;
}
LINK (futures, future);
scm_mutex_unlock (&future_admin_mutex);
pthread_mutex_unlock (&future_admin_mutex);
SCM_SET_FUTURE_DATA (future, thunk);
SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_TASK_ASSIGNED);
scm_cond_signal (SCM_FUTURE_COND (future));
scm_mutex_unlock (SCM_FUTURE_MUTEX (future));
pthread_cond_signal (SCM_FUTURE_COND (future));
pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
return future;
}
@ -223,20 +223,21 @@ SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0,
{
SCM res;
SCM_VALIDATE_FUTURE (1, future);
scm_mutex_lock (SCM_FUTURE_MUTEX (future));
scm_pthread_mutex_lock (SCM_FUTURE_MUTEX (future));
if (SCM_FUTURE_STATUS (future) != SCM_FUTURE_COMPUTING)
{
SCM_SET_FUTURE_STATUS (future, SCM_FUTURE_SIGNAL_ME);
scm_cond_wait (SCM_FUTURE_COND (future), SCM_FUTURE_MUTEX (future));
scm_pthread_cond_wait (SCM_FUTURE_COND (future),
SCM_FUTURE_MUTEX (future));
}
if (!SCM_FUTURE_ALIVE_P (future))
{
scm_mutex_unlock (SCM_FUTURE_MUTEX (future));
pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
SCM_MISC_ERROR ("requesting result from failed future ~A",
scm_list_1 (future));
}
res = SCM_FUTURE_DATA (future);
scm_mutex_unlock (SCM_FUTURE_MUTEX (future));
pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
return res;
}
#undef FUNC_NAME
@ -249,7 +250,7 @@ kill_futures (SCM victims)
SCM future;
UNLINK (victims, future);
kill_future (future);
scm_cond_signal (SCM_FUTURE_COND (future));
pthread_cond_signal (SCM_FUTURE_COND (future));
}
}
@ -259,12 +260,12 @@ cleanup_undead ()
SCM next = undead, *nextloc = &undead;
while (!scm_is_null (next))
{
if (scm_mutex_trylock (SCM_FUTURE_MUTEX (next)))
if (pthread_mutex_trylock (SCM_FUTURE_MUTEX (next)))
goto next;
else if (SCM_FUTURE_ALIVE_P (next))
{
scm_cond_signal (SCM_FUTURE_COND (next));
scm_mutex_unlock (SCM_FUTURE_MUTEX (next));
pthread_cond_signal (SCM_FUTURE_COND (next));
pthread_mutex_unlock (SCM_FUTURE_MUTEX (next));
next:
SCM_SET_GC_MARK (next);
nextloc = SCM_FUTURE_NEXTLOC (next);
@ -274,7 +275,7 @@ cleanup_undead ()
{
SCM future;
UNLINK (next, future);
scm_mutex_unlock (SCM_FUTURE_MUTEX (future));
pthread_mutex_unlock (SCM_FUTURE_MUTEX (future));
cleanup (SCM_FUTURE (future));
*nextloc = next;
}
@ -341,6 +342,8 @@ scan_futures (void *dummy1, void *dummy2, void *dummy3)
return 0;
}
scm_t_bits scm_tc16_future;
void
scm_init_futures ()
{

4
libguile/futures.h
View file

@ -29,8 +29,8 @@
typedef struct scm_t_future {
SCM data;
scm_t_mutex mutex;
scm_t_cond cond;
pthread_mutex_t mutex;
pthread_cond_t cond;
int status;
int die_p;
} scm_t_future;

6
libguile/gc-freelist.c
View file

@ -145,12 +145,6 @@ scm_gc_init_freelist (void)
int init_heap_size_2
= scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", SCM_DEFAULT_INIT_HEAP_SIZE_2);
/* These are the thread-local freelists. */
scm_key_create (&scm_i_freelist, free);
scm_key_create (&scm_i_freelist2, free);
SCM_FREELIST_CREATE (scm_i_freelist);
SCM_FREELIST_CREATE (scm_i_freelist2);
scm_init_freelist (&scm_i_master_freelist2, 2,
scm_getenv_int ("GUILE_MIN_YIELD_2", SCM_DEFAULT_MIN_YIELD_2));
scm_init_freelist (&scm_i_master_freelist, 1,

22
libguile/gc-malloc.c
View file

@ -110,21 +110,21 @@ scm_realloc (void *mem, size_t size)
if (ptr)
return ptr;
scm_rec_mutex_lock (&scm_i_sweep_mutex);
scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_i_sweep_all_segments ("realloc");
SCM_SYSCALL (ptr = realloc (mem, size));
if (ptr)
{
scm_rec_mutex_unlock (&scm_i_sweep_mutex);
pthread_mutex_unlock (&scm_i_sweep_mutex);
return ptr;
}
scm_igc ("realloc");
scm_i_sweep_all_segments ("realloc");
scm_rec_mutex_unlock (&scm_i_sweep_mutex);
pthread_mutex_unlock (&scm_i_sweep_mutex);
SCM_SYSCALL (ptr = realloc (mem, size));
if (ptr)
@ -180,10 +180,10 @@ scm_strdup (const char *str)
static void
decrease_mtrigger (size_t size, const char * what)
{
scm_i_plugin_mutex_lock (&scm_i_gc_admin_mutex);
pthread_mutex_lock (&scm_i_gc_admin_mutex);
scm_mallocated -= size;
scm_gc_malloc_collected += size;
scm_i_plugin_mutex_unlock (&scm_i_gc_admin_mutex);
pthread_mutex_unlock (&scm_i_gc_admin_mutex);
}
static void
@ -192,7 +192,7 @@ increase_mtrigger (size_t size, const char *what)
size_t mallocated = 0;
int overflow = 0, triggered = 0;
scm_i_plugin_mutex_lock (&scm_i_gc_admin_mutex);
pthread_mutex_lock (&scm_i_gc_admin_mutex);
if (ULONG_MAX - size < scm_mallocated)
overflow = 1;
else
@ -202,12 +202,10 @@ increase_mtrigger (size_t size, const char *what)
if (scm_mallocated > scm_mtrigger)
triggered = 1;
}
scm_i_plugin_mutex_unlock (&scm_i_gc_admin_mutex);
pthread_mutex_unlock (&scm_i_gc_admin_mutex);
if (overflow)
{
scm_memory_error ("Overflow of scm_mallocated: too much memory in use.");
}
scm_memory_error ("Overflow of scm_mallocated: too much memory in use.");
/*
A program that uses a lot of malloced collectable memory (vectors,
@ -220,7 +218,7 @@ increase_mtrigger (size_t size, const char *what)
unsigned long prev_alloced;
float yield;
scm_rec_mutex_lock (&scm_i_sweep_mutex);
scm_pthread_mutex_lock (&scm_i_sweep_mutex);
prev_alloced = mallocated;
scm_igc (what);
@ -265,7 +263,7 @@ increase_mtrigger (size_t size, const char *what)
#endif
}
scm_rec_mutex_unlock (&scm_i_sweep_mutex);
pthread_mutex_unlock (&scm_i_sweep_mutex);
}
}

16
libguile/gc-mark.c
View file

@ -144,6 +144,7 @@ Perhaps this would work better with an explicit markstack?
*/
void
scm_gc_mark_dependencies (SCM p)
#define FUNC_NAME "scm_gc_mark_dependencies"
@ -154,7 +155,7 @@ scm_gc_mark_dependencies (SCM p)
ptr = p;
scm_mark_dependencies_again:
cell_type = SCM_GC_CELL_TYPE (ptr);
switch (SCM_ITAG7 (cell_type))
{
@ -414,15 +415,16 @@ gc_mark_loop:
abort();
}
}
if (SCM_GC_MARK_P (ptr))
{
return;
}
if (SCM_GC_MARK_P (ptr))
{
return;
}
SCM_SET_GC_MARK (ptr);
goto scm_mark_dependencies_again;
goto scm_mark_dependencies_again;
}
#undef FUNC_NAME

27
libguile/gc.c
View file

@ -15,6 +15,7 @@
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#define _GNU_SOURCE
/* #define DEBUGINFO */
@ -71,7 +72,7 @@ unsigned int scm_gc_running_p = 0;
/* Lock this mutex before doing lazy sweeping.
*/
scm_t_rec_mutex scm_i_sweep_mutex;
pthread_mutex_t scm_i_sweep_mutex = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP;
/* Set this to != 0 if every cell that is accessed shall be checked:
*/
@ -206,9 +207,6 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
scm_t_key scm_i_freelist;
scm_t_key scm_i_freelist2;
/* scm_mtrigger
* is the number of bytes of malloc allocation needed to trigger gc.
@ -447,7 +445,7 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
{
SCM cell;
scm_rec_mutex_lock (&scm_i_sweep_mutex);
scm_pthread_mutex_lock (&scm_i_sweep_mutex);
*free_cells = scm_i_sweep_some_segments (freelist);
if (*free_cells == SCM_EOL && scm_i_gc_grow_heap_p (freelist))
@ -489,7 +487,7 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
*free_cells = SCM_FREE_CELL_CDR (cell);
scm_rec_mutex_unlock (&scm_i_sweep_mutex);
pthread_mutex_unlock (&scm_i_sweep_mutex);
return cell;
}
@ -504,7 +502,7 @@ scm_t_c_hook scm_after_gc_c_hook;
void
scm_igc (const char *what)
{
scm_rec_mutex_lock (&scm_i_sweep_mutex);
scm_pthread_mutex_lock (&scm_i_sweep_mutex);
++scm_gc_running_p;
scm_c_hook_run (&scm_before_gc_c_hook, 0);
@ -608,7 +606,7 @@ scm_igc (const char *what)
*/
--scm_gc_running_p;
scm_c_hook_run (&scm_after_gc_c_hook, 0);
scm_rec_mutex_unlock (&scm_i_sweep_mutex);
pthread_mutex_unlock (&scm_i_sweep_mutex);
/*
For debugging purposes, you could do
@ -890,18 +888,13 @@ scm_storage_prehistory ()
scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
}
scm_t_mutex scm_i_gc_admin_mutex;
pthread_mutex_t scm_i_gc_admin_mutex = PTHREAD_MUTEX_INITIALIZER;
int
scm_init_storage ()
{
size_t j;
/* Fixme: Should use mutexattr from the low-level API. */
scm_rec_mutex_init (&scm_i_sweep_mutex, &scm_i_plugin_rec_mutex);
scm_i_plugin_mutex_init (&scm_i_gc_admin_mutex, &scm_i_plugin_mutex);
j = SCM_NUM_PROTECTS;
while (j)
scm_sys_protects[--j] = SCM_BOOL_F;
@ -919,12 +912,18 @@ scm_init_storage ()
if (!scm_i_port_table)
return 1;
#if 0
/* We can't have a cleanup handler since we have no thread to run it
in. */
#ifdef HAVE_ATEXIT
atexit (cleanup);
#else
#ifdef HAVE_ON_EXIT
on_exit (cleanup, 0);
#endif
#endif
#endif
scm_stand_in_procs = scm_c_make_hash_table (257);

22
libguile/gc.h
View file

@ -25,12 +25,7 @@
#include "libguile/__scm.h"
#include "libguile/hooks.h"
#if SCM_USE_PTHREAD_THREADS
# include "libguile/pthread-threads.h"
#else
# include "libguile/null-threads.h"
#endif
#include "libguile/threads.h"
@ -230,12 +225,12 @@ SCM_API int scm_debug_cells_gc_interval ;
void scm_i_expensive_validation_check (SCM cell);
#endif
SCM_API scm_t_mutex scm_i_gc_admin_mutex;
SCM_API pthread_mutex_t scm_i_gc_admin_mutex;
SCM_API int scm_block_gc;
SCM_API int scm_gc_heap_lock;
SCM_API unsigned int scm_gc_running_p;
SCM_API scm_t_rec_mutex scm_i_sweep_mutex;
SCM_API pthread_mutex_t scm_i_sweep_mutex;
#if (SCM_ENABLE_DEPRECATED == 1)
@ -255,13 +250,10 @@ SCM_API size_t scm_default_max_segment_size;
SCM_API size_t scm_max_segment_size;
#define SCM_FREELIST_CREATE(key) \
do { SCM *ls = (SCM *) malloc (sizeof (SCM)); \
*ls = SCM_EOL; \
scm_setspecific ((key), ls); } while (0)
#define SCM_FREELIST_LOC(key) ((SCM *) scm_getspecific (key))
SCM_API scm_t_key scm_i_freelist;
SCM_API scm_t_key scm_i_freelist2;
#define SCM_SET_FREELIST_LOC(key,ptr) pthread_setspecific ((key), (ptr))
#define SCM_FREELIST_LOC(key) ((SCM *) pthread_getspecific (key))
SCM_API pthread_key_t scm_i_freelist;
SCM_API pthread_key_t scm_i_freelist2;
SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;

23
libguile/hashtab.c
View file

@ -30,6 +30,27 @@
#include "libguile/hashtab.h"
static void
loop (void)
{
int loop = 1;
printf ("looping %d\n", getpid ());
while (loop)
;
}
void
scm_i_hashtable_decrement (SCM h)
{
scm_t_hashtable *t = SCM_HASHTABLE (h);
if (t->n_items == 0)
{
printf ("hashtab underflow\n");
loop ();
}
t->n_items--;
}
/* NOTES
*
* 1. The current hash table implementation uses weak alist vectors
@ -145,7 +166,7 @@ scm_i_rehash (SCM table,
SCM_HASHTABLE (table)->closure = closure;
}
SCM_HASHTABLE (table)->size_index = i;
new_size = hashtable_size[i];
if (i <= SCM_HASHTABLE (table)->min_size_index)
SCM_HASHTABLE (table)->lower = 0;

5
libguile/hashtab.h
View file

@ -55,7 +55,12 @@ extern scm_t_bits scm_tc16_hashtable;
#define SCM_HASHTABLE_N_ITEMS(x) (SCM_HASHTABLE (x)->n_items)
#define SCM_SET_HASHTABLE_N_ITEMS(x, n) (SCM_HASHTABLE (x)->n_items = n)
#define SCM_HASHTABLE_INCREMENT(x) (SCM_HASHTABLE_N_ITEMS(x)++)
#if 0
#define SCM_HASHTABLE_DECREMENT(x) (SCM_HASHTABLE_N_ITEMS(x)--)
#else
SCM_API void scm_i_hashtable_decrement (SCM h);
#define SCM_HASHTABLE_DECREMENT(x) scm_i_hashtable_decrement(x)
#endif
#define SCM_HASHTABLE_UPPER(x) (SCM_HASHTABLE (x)->upper)
#define SCM_HASHTABLE_LOWER(x) (SCM_HASHTABLE (x)->lower)

135
libguile/init.c
View file

@ -133,46 +133,6 @@
#include <unistd.h>
#endif
/* Setting up the stack. */
static void
restart_stack (void *base)
{
scm_dynwinds = SCM_EOL;
SCM_DYNENV (scm_rootcont) = SCM_EOL;
SCM_THROW_VALUE (scm_rootcont) = SCM_EOL;
SCM_DFRAME (scm_rootcont) = scm_last_debug_frame = 0;
SCM_BASE (scm_rootcont) = base;
}
static void
start_stack (void *base)
{
SCM root;
root = scm_permanent_object (scm_make_root (SCM_UNDEFINED));
scm_set_root (SCM_ROOT_STATE (root));
scm_stack_base = base;
scm_exitval = SCM_BOOL_F; /* vestigial */
scm_root->fluids = scm_i_make_initial_fluids ();
/* Create an object to hold the root continuation.
*/
{
scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs),
"continuation");
contregs->num_stack_items = 0;
contregs->seq = 0;
SCM_NEWSMOB (scm_rootcont, scm_tc16_continuation, contregs);
}
/* The remainder of stack initialization is factored out to another
* function so that if this stack is ever exitted, it can be
* re-entered using restart_stack. */
restart_stack (base);
}
#if 0
@ -345,11 +305,9 @@ struct main_func_closure
char **argv; /* the argument list it should receive */
};
static void scm_init_guile_1 (SCM_STACKITEM *base);
static void scm_boot_guile_1 (SCM_STACKITEM *base,
struct main_func_closure *closure);
static SCM invoke_main_func(void *body_data);
static void *invoke_main_func(void *body_data);
/* Fire up the Guile Scheme interpreter.
@ -383,10 +341,6 @@ static SCM invoke_main_func(void *body_data);
void
scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
{
/* The garbage collector uses the address of this variable as one
end of the stack, and the address of one of its own local
variables as the other end. */
SCM_STACKITEM dummy;
struct main_func_closure c;
c.main_func = main_func;
@ -394,19 +348,47 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
c.argc = argc;
c.argv = argv;
scm_boot_guile_1 (&dummy, &c);
scm_with_guile (invoke_main_func, &c);
}
static void *
invoke_main_func (void *body_data)
{
struct main_func_closure *closure = (struct main_func_closure *) body_data;
scm_set_program_arguments (closure->argc, closure->argv, 0);
(*closure->main_func) (closure->closure, closure->argc, closure->argv);
scm_restore_signals ();
/* This tick gives any pending
* asyncs a chance to run. This must be done after
* the call to scm_restore_signals.
*/
SCM_ASYNC_TICK;
/* If the caller doesn't want this, they should exit from main_func
themselves.
*/
pthread_exit (NULL);
/* never reached */
return NULL;
}
#if 0
void
scm_init_guile ()
{
scm_init_guile_1 ((SCM_STACKITEM *)scm_get_stack_base ());
scm_i_init_guile ((SCM_STACKITEM *)scm_get_stack_base ());
}
#endif
pthread_mutex_t scm_i_init_mutex = PTHREAD_MUTEX_INITIALIZER;
int scm_initialized_p = 0;
static void
scm_init_guile_1 (SCM_STACKITEM *base)
void
scm_i_init_guile (SCM_STACKITEM *base)
{
if (scm_initialized_p)
return;
@ -427,7 +409,7 @@ scm_init_guile_1 (SCM_STACKITEM *base)
scm_block_gc = 1;
scm_storage_prehistory ();
scm_threads_prehistory ();
scm_threads_prehistory (base);
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_hashtab_prehistory (); /* requires storage_prehistory */
@ -448,8 +430,7 @@ scm_init_guile_1 (SCM_STACKITEM *base)
scm_init_variable (); /* all bindings need variables */
scm_init_continuations ();
scm_init_root (); /* requires continuations */
scm_init_threads (base);
start_stack (base);
scm_init_threads ();
scm_init_gsubr ();
scm_init_thread_procs (); /* requires gsubrs */
scm_init_procprop ();
@ -551,6 +532,8 @@ scm_init_guile_1 (SCM_STACKITEM *base)
scm_i_init_deprecated ();
#endif
scm_init_threads_root_root ();
scm_initialized_p = 1;
scm_block_gc = 0; /* permit the gc to run */
@ -567,50 +550,6 @@ scm_init_guile_1 (SCM_STACKITEM *base)
scm_load_startup_files ();
}
/* Record here whether SCM_BOOT_GUILE_1 has already been called. This
variable is now here and not inside SCM_BOOT_GUILE_1 so that one
can tweak it. This is necessary for unexec to work. (Hey, "1-live"
is the name of a local radiostation...) */
int scm_boot_guile_1_live = 0;
static void
scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
{
scm_init_guile_1 (base);
/* This function is not re-entrant. */
if (scm_boot_guile_1_live)
abort ();
scm_boot_guile_1_live = 1;
scm_set_program_arguments (closure->argc, closure->argv, 0);
invoke_main_func (closure);
scm_restore_signals ();
/* This tick gives any pending
* asyncs a chance to run. This must be done after
* the call to scm_restore_signals.
*/
SCM_ASYNC_TICK;
/* If the caller doesn't want this, they should return from
main_func themselves. */
exit (0);
}
static SCM
invoke_main_func (void *body_data)
{
struct main_func_closure *closure = (struct main_func_closure *) body_data;
(*closure->main_func) (closure->closure, closure->argc, closure->argv);
/* never reached */
return SCM_UNDEFINED;
}
/*
Local Variables:

4
libguile/init.h
View file

@ -23,8 +23,10 @@
#include "libguile/__scm.h"
#include "libguile/threads.h"
SCM_API pthread_mutex_t scm_i_init_mutex;
SCM_API int scm_initialized_p;
SCM_API void scm_init_guile (void);
@ -35,6 +37,8 @@ SCM_API void scm_boot_guile (int argc, char **argv,
char **argv),
void *closure);
SCM_API void scm_i_init_guile (SCM_STACKITEM *base);
SCM_API void scm_load_startup_files (void);
#endif /* SCM_INIT_H */

9
libguile/inline.h
View file

@ -67,15 +67,6 @@ SCM
scm_cell (scm_t_bits car, scm_t_bits cdr)
{
SCM z;
/* We retrieve the SCM pointer only once since the call to
SCM_FREELIST_LOC will be slightly expensive when we support
preemptive multithreading. SCM_FREELIST_LOC will then retrieve
the thread specific freelist.
Until then, SCM_FREELIST_DOC expands to (&scm_i_freelist) and the
following code will compile to the same as if we had worked
directly on the scm_i_freelist variable.
*/
SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist);
if (scm_gc_running_p)

4
libguile/ioext.c
View file

@ -280,14 +280,14 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
int_fd = scm_to_int (fd);
scm_mutex_lock (&scm_i_port_table_mutex);
scm_pthread_mutex_lock (&scm_i_port_table_mutex);
for (i = 0; i < scm_i_port_table_size; i++)
{
if (SCM_OPFPORTP (scm_i_port_table[i]->port)
&& ((scm_t_fport *) scm_i_port_table[i]->stream)->fdes == int_fd)
result = scm_cons (scm_i_port_table[i]->port, result);
}
scm_mutex_unlock (&scm_i_port_table_mutex);
pthread_mutex_unlock (&scm_i_port_table_mutex);
return result;
}
#undef FUNC_NAME

22
libguile/ports.c
View file

@ -493,7 +493,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);
pthread_mutex_t scm_i_port_table_mutex = PTHREAD_MUTEX_INITIALIZER;
/* This function is not and should not be thread safe. */
@ -764,9 +764,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_pthread_mutex_lock (&scm_i_port_table_mutex);
scm_remove_from_port_table (port);
scm_mutex_unlock (&scm_i_port_table_mutex);
pthread_mutex_unlock (&scm_i_port_table_mutex);
SCM_CLR_PORT_OPEN_FLAG (port);
return scm_from_bool (rv >= 0);
}
@ -815,18 +815,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_pthread_mutex_lock (&scm_i_port_table_mutex);
n = scm_i_port_table_size;
scm_mutex_unlock (&scm_i_port_table_mutex);
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_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);
pthread_mutex_unlock (&scm_i_port_table_mutex);
for (i = 0; i < n; i++)
proc (data, SCM_SIMPLE_VECTOR_REF (ports, i));
@ -938,13 +938,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_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);
pthread_mutex_unlock (&scm_i_port_table_mutex);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -1638,7 +1638,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_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 +1647,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);
pthread_mutex_unlock (&scm_i_port_table_mutex);
return answer;
}
}

2
libguile/ports.h
View file

@ -111,7 +111,7 @@ typedef struct
SCM_API scm_t_port **scm_i_port_table;
SCM_API long scm_i_port_table_size; /* Number of ports in scm_i_port_table. */
SCM_API scm_t_mutex scm_i_port_table_mutex;
SCM_API pthread_mutex_t scm_i_port_table_mutex;
#define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)

12
libguile/posix.c
View file

@ -40,6 +40,7 @@
#include "libguile/validate.h"
#include "libguile/posix.h"
#include "libguile/i18n.h"
#include "libguile/threads.h"
#ifdef HAVE_STRING_H
@ -820,11 +821,11 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
return SCM_BOOL_F;
fd = SCM_FPORT_FDES (port);
scm_mutex_lock (&scm_i_misc_mutex);
scm_pthread_mutex_lock (&scm_i_misc_mutex);
SCM_SYSCALL (result = ttyname (fd));
err = errno;
ret = scm_from_locale_string (result);
scm_mutex_unlock (&scm_i_misc_mutex);
pthread_mutex_unlock (&scm_i_misc_mutex);
if (!result)
{
@ -1505,15 +1506,12 @@ SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0,
char *c_key, *c_salt;
scm_frame_begin (0);
scm_frame_unwind_handler ((void(*)(void*)) scm_mutex_unlock,
&scm_i_misc_mutex,
SCM_F_WIND_EXPLICITLY);
scm_mutex_lock (&scm_i_misc_mutex);
scm_frame_pthread_mutex_lock (&scm_i_misc_mutex);
c_key = scm_to_locale_string (key);
scm_frame_free (c_key);
c_salt = scm_to_locale_string (salt);
scm_frame_free (c_key);
scm_frame_free (c_salt);
ret = scm_from_locale_string (crypt (c_key, c_salt));

18
libguile/print.c
View file

@ -133,7 +133,7 @@ do { \
SCM scm_print_state_vtable = SCM_BOOL_F;
static SCM print_state_pool = SCM_EOL;
SCM_MUTEX (print_state_mutex);
pthread_mutex_t print_state_mutex = PTHREAD_MUTEX_INITIALIZER;
#ifdef GUILE_DEBUG /* Used for debugging purposes */
@ -173,13 +173,13 @@ scm_make_print_state ()
SCM answer = SCM_BOOL_F;
/* First try to allocate a print state from the pool */
scm_i_plugin_mutex_lock (&print_state_mutex);
pthread_mutex_lock (&print_state_mutex);
if (!scm_is_null (print_state_pool))
{
answer = SCM_CAR (print_state_pool);
print_state_pool = SCM_CDR (print_state_pool);
}
scm_i_plugin_mutex_unlock (&print_state_mutex);
pthread_mutex_unlock (&print_state_mutex);
return scm_is_false (answer) ? make_print_state () : answer;
}
@ -197,10 +197,10 @@ scm_free_print_state (SCM print_state)
pstate->fancyp = 0;
pstate->revealed = 0;
pstate->highlight_objects = SCM_EOL;
scm_i_plugin_mutex_lock (&print_state_mutex);
pthread_mutex_lock (&print_state_mutex);
handle = scm_cons (print_state, print_state_pool);
print_state_pool = handle;
scm_i_plugin_mutex_unlock (&print_state_mutex);
pthread_mutex_unlock (&print_state_mutex);
}
SCM
@ -692,13 +692,13 @@ scm_prin1 (SCM exp, SCM port, int writingp)
else
{
/* First try to allocate a print state from the pool */
scm_i_plugin_mutex_lock (&print_state_mutex);
pthread_mutex_lock (&print_state_mutex);
if (!scm_is_null (print_state_pool))
{
handle = print_state_pool;
print_state_pool = SCM_CDR (print_state_pool);
}
scm_i_plugin_mutex_unlock (&print_state_mutex);
pthread_mutex_unlock (&print_state_mutex);
if (scm_is_false (handle))
handle = scm_list_1 (make_print_state ());
pstate_scm = SCM_CAR (handle);
@ -715,10 +715,10 @@ scm_prin1 (SCM exp, SCM port, int writingp)
if (scm_is_true (handle) && !pstate->revealed)
{
scm_i_plugin_mutex_lock (&print_state_mutex);
pthread_mutex_lock (&print_state_mutex);
SCM_SETCDR (handle, print_state_pool);
print_state_pool = handle;
scm_i_plugin_mutex_unlock (&print_state_mutex);
pthread_mutex_unlock (&print_state_mutex);
}
}

6
libguile/root.c
View file

@ -46,7 +46,6 @@ root_mark (SCM root)
scm_gc_mark (s->rootcont);
scm_gc_mark (s->dynwinds);
scm_gc_mark (s->progargs);
scm_gc_mark (s->exitval);
scm_gc_mark (s->cur_inp);
scm_gc_mark (s->cur_outp);
scm_gc_mark (s->cur_errp);
@ -91,7 +90,6 @@ scm_make_root (SCM parent)
root_state->rootcont
= root_state->dynwinds
= root_state->progargs
= root_state->exitval
= root_state->cur_inp
= root_state->cur_outp
= root_state->cur_errp
@ -346,6 +344,10 @@ scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler)
/* Initialized in scm_threads_prehistory.
*/
pthread_key_t scm_i_root_key;
void
scm_init_root ()
{

9
libguile/root.h
View file

@ -64,8 +64,7 @@ typedef struct scm_root_state
/* It is very inefficient to have this variable in the root state. */
scm_t_debug_frame *last_debug_frame;
SCM progargs; /* vestigial */
SCM exitval; /* vestigial */
SCM progargs;
SCM cur_inp;
SCM cur_outp;
@ -87,6 +86,10 @@ typedef struct scm_root_state
*/
} scm_root_state;
#define scm_root ((scm_root_state *) pthread_getspecific (scm_i_root_key))
#define scm_set_root(new_root) pthread_setspecific (scm_i_root_key, new_root)
SCM_API pthread_key_t scm_i_root_key;
#define scm_stack_base (scm_root->stack_base)
#define scm_save_regs_gc_mark (scm_root->save_regs_gc_mark)
#define scm_errjmp_bad (scm_root->errjmp_bad)
@ -101,8 +104,6 @@ typedef struct scm_root_state
#define scm_cur_errp (scm_root->cur_errp)
#define scm_cur_loadp (scm_root->cur_loadp)
#define scm_root ((scm_root_state *) SCM_THREAD_LOCAL_DATA)
#define scm_set_root(new_root) SCM_SET_THREAD_LOCAL_DATA (new_root)

26
libguile/strings.c
View file

@ -136,7 +136,7 @@ scm_i_stringbuf_free (SCM buf)
STRINGBUF_OUTLINE_LENGTH (buf) + 1, "string");
}
SCM_MUTEX (stringbuf_write_mutex);
pthread_mutex_t stringbuf_write_mutex = PTHREAD_MUTEX_INITIALIZER;
/* Copy-on-write strings.
*/
@ -209,9 +209,9 @@ scm_i_substring (SCM str, size_t start, size_t end)
SCM buf;
size_t str_start;
get_str_buf_start (&str, &buf, &str_start);
scm_i_plugin_mutex_lock (&stringbuf_write_mutex);
pthread_mutex_lock (&stringbuf_write_mutex);
SET_STRINGBUF_SHARED (buf);
scm_i_plugin_mutex_unlock (&stringbuf_write_mutex);
pthread_mutex_unlock (&stringbuf_write_mutex);
return scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
(scm_t_bits)str_start + start,
(scm_t_bits) end - start);
@ -223,9 +223,9 @@ scm_i_substring_read_only (SCM str, size_t start, size_t end)
SCM buf;
size_t str_start;
get_str_buf_start (&str, &buf, &str_start);
scm_i_plugin_mutex_lock (&stringbuf_write_mutex);
pthread_mutex_lock (&stringbuf_write_mutex);
SET_STRINGBUF_SHARED (buf);
scm_i_plugin_mutex_unlock (&stringbuf_write_mutex);
pthread_mutex_unlock (&stringbuf_write_mutex);
return scm_double_cell (RO_STRING_TAG, SCM_UNPACK(buf),
(scm_t_bits)str_start + start,
(scm_t_bits) end - start);
@ -334,7 +334,7 @@ scm_i_string_writable_chars (SCM orig_str)
if (IS_RO_STRING (str))
scm_misc_error (NULL, "string is read-only: ~s", scm_list_1 (orig_str));
scm_i_plugin_mutex_lock (&stringbuf_write_mutex);
pthread_mutex_lock (&stringbuf_write_mutex);
if (STRINGBUF_SHARED (buf))
{
/* Clone stringbuf. For this, we put all threads to sleep.
@ -343,7 +343,7 @@ scm_i_string_writable_chars (SCM orig_str)
size_t len = STRING_LENGTH (str);
SCM new_buf;
scm_i_plugin_mutex_unlock (&stringbuf_write_mutex);
pthread_mutex_unlock (&stringbuf_write_mutex);
new_buf = make_stringbuf (len);
memcpy (STRINGBUF_CHARS (new_buf),
@ -357,7 +357,7 @@ scm_i_string_writable_chars (SCM orig_str)
buf = new_buf;
scm_i_plugin_mutex_lock (&stringbuf_write_mutex);
pthread_mutex_lock (&stringbuf_write_mutex);
}
return STRINGBUF_CHARS (buf) + start;
@ -366,7 +366,7 @@ scm_i_string_writable_chars (SCM orig_str)
void
scm_i_string_stop_writing (void)
{
scm_i_plugin_mutex_unlock (&stringbuf_write_mutex);
pthread_mutex_unlock (&stringbuf_write_mutex);
}
/* Symbols.
@ -396,9 +396,9 @@ scm_i_make_symbol (SCM name, scm_t_bits flags,
if (start == 0 && length == STRINGBUF_LENGTH (buf))
{
/* reuse buf. */
scm_i_plugin_mutex_lock (&stringbuf_write_mutex);
pthread_mutex_lock (&stringbuf_write_mutex);
SET_STRINGBUF_SHARED (buf);
scm_i_plugin_mutex_unlock (&stringbuf_write_mutex);
pthread_mutex_unlock (&stringbuf_write_mutex);
}
else
{
@ -441,9 +441,9 @@ SCM
scm_i_symbol_substring (SCM sym, size_t start, size_t end)
{
SCM buf = SYMBOL_STRINGBUF (sym);
scm_i_plugin_mutex_lock (&stringbuf_write_mutex);
pthread_mutex_lock (&stringbuf_write_mutex);
SET_STRINGBUF_SHARED (buf);
scm_i_plugin_mutex_unlock (&stringbuf_write_mutex);
pthread_mutex_unlock (&stringbuf_write_mutex);
return scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
(scm_t_bits)start, (scm_t_bits) end - start);
}

4
libguile/strports.c
View file

@ -288,7 +288,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
else
str = scm_c_substring (str, 0, str_len);
scm_mutex_lock (&scm_i_port_table_mutex);
scm_pthread_mutex_lock (&scm_i_port_table_mutex);
z = scm_new_port_table_entry (scm_tc16_strport);
pt = SCM_PTAB_ENTRY(z);
SCM_SETSTREAM (z, SCM_UNPACK (str));
@ -301,7 +301,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
pt->rw_random = 1;
scm_mutex_unlock (&scm_i_port_table_mutex);
pthread_mutex_unlock (&scm_i_port_table_mutex);
/* ensure write_pos is writable. */
if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)

4
libguile/symbols.c
View file

@ -279,9 +279,9 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
prefix = scm_from_locale_string (" g");
/* mutex in case another thread looks and incs at the exact same moment */
scm_mutex_lock (&scm_i_misc_mutex);
scm_pthread_mutex_lock (&scm_i_misc_mutex);
n = gensym_counter++;
scm_mutex_unlock (&scm_i_misc_mutex);
pthread_mutex_unlock (&scm_i_misc_mutex);
n_digits = scm_iint2str (n, 10, buf);
suffix = scm_from_locale_stringn (buf, n_digits);

1393
libguile/threads.c
View file

File diff suppressed because it is too large Load diff

192
libguile/threads.h
View file

@ -27,165 +27,89 @@
#include "libguile/throw.h"
#include "libguile/root.h"
#include "libguile/iselect.h"
#include "libguile/threads-plugin.h"
#include <pthread.h>
/* smob tags for the thread datatypes */
SCM_API scm_t_bits scm_tc16_thread;
SCM_API scm_t_bits scm_tc16_mutex;
SCM_API scm_t_bits scm_tc16_fair_mutex;
SCM_API scm_t_bits scm_tc16_condvar;
SCM_API scm_t_bits scm_tc16_fair_condvar;
typedef struct scm_thread {
struct scm_thread *next_thread;
/* For general blocking.
*/
pthread_cond_t sleep_cond;
/* This mutex represents this threads right to access the heap.
That right can temporarily be taken away by the GC.
*/
pthread_mutex_t heap_mutex;
SCM freelist, freelist2;
int clear_freelists_p; /* set if GC was done while thread was asleep */
SCM root;
SCM handle;
pthread_t pthread;
SCM result;
int exited;
/* For keeping track of the stack and registers. */
SCM_STACKITEM *base;
SCM_STACKITEM *top;
jmp_buf regs;
} scm_thread;
#define SCM_THREADP(x) SCM_SMOB_PREDICATE (scm_tc16_thread, x)
#define SCM_THREAD_DATA(x) ((scm_thread *) SCM_SMOB_DATA (x))
#define SCM_MUTEXP(x) SCM_SMOB_PREDICATE (scm_tc16_mutex, x)
#define SCM_FAIR_MUTEX_P(x) SCM_SMOB_PREDICATE (scm_tc16_fair_mutex, x)
#define SCM_MUTEX_DATA(x) ((void *) SCM_SMOB_DATA (x))
#define SCM_CONDVARP(x) SCM_SMOB_PREDICATE (scm_tc16_condvar, x)
#define SCM_FAIR_CONDVAR_P(x) SCM_SMOB_PREDICATE (scm_tc16_fair_condvar, x)
#define SCM_CONDVAR_DATA(x) ((void *) SCM_SMOB_DATA (x))
#define SCM_VALIDATE_THREAD(pos, a) \
SCM_MAKE_VALIDATE_MSG (pos, a, THREADP, "thread")
#define SCM_VALIDATE_MUTEX(pos, a) \
SCM_ASSERT_TYPE (SCM_MUTEXP (a) || SCM_FAIR_MUTEX_P (a), \
SCM_ASSERT_TYPE (SCM_MUTEXP (a), \
a, pos, FUNC_NAME, "mutex");
#define SCM_VALIDATE_CONDVAR(pos, a) \
SCM_ASSERT_TYPE (SCM_CONDVARP (a) || SCM_FAIR_CONDVAR_P (a), \
SCM_ASSERT_TYPE (SCM_CONDVARP (a), \
a, pos, FUNC_NAME, "condition variable");
SCM_API void scm_threads_mark_stacks (void);
SCM_API void scm_init_threads (SCM_STACKITEM *);
SCM_API void scm_init_thread_procs (void);
#if SCM_USE_PTHREAD_THREADS
# include "libguile/pthread-threads.h"
#else
# include "libguile/null-threads.h"
#endif
/*----------------------------------------------------------------------*/
/* Low-level C API */
/* The purpose of this API is seamless, simple and thread package
independent interaction with Guile threads from the application.
Note that Guile also uses it to implement itself, just like
with the rest of the application API.
*/
/* MDJ 021209 <djurfeldt@nada.kth.se>:
The separation of the plugin interface (currently in
pthread-threads.h and null-threads.h) and the low-level C API needs
to be completed in a sensible way.
*/
/* Deprecate this name and rename to scm_thread_create?
Introduce the other two arguments in pthread_create to prepare for
the future?
*/
SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data,
scm_t_catch_handler handler, void *handler_data);
SCM_API scm_t_thread scm_c_scm2thread (SCM thread);
#define scm_thread_join scm_i_plugin_thread_join
#define scm_thread_detach scm_i_plugin_thread_detach
#define scm_thread_self scm_i_plugin_thread_self
#define scm_thread_yield scm_i_plugin_thread_yield
#define scm_mutex_init scm_i_plugin_mutex_init
#define scm_mutex_destroy scm_i_plugin_mutex_destroy
SCM_API int scm_mutex_lock (scm_t_mutex *m);
#define scm_mutex_trylock scm_i_plugin_mutex_trylock
#define scm_mutex_unlock scm_i_plugin_mutex_unlock
/* Guile itself needs recursive mutexes. See for example the
implentation of scm_force in eval.c.
Note that scm_rec_mutex_lock et al can be replaced by direct usage
of the corresponding pthread functions if we use the pthread
debugging API to access the stack top (in which case there is no
longer any need to save the top of the stack before blocking).
It's therefore highly motivated to use these calls in situations
where Guile or the application needs recursive mutexes.
*/
#define scm_rec_mutex_init scm_i_plugin_rec_mutex_init
#define scm_rec_mutex_destroy scm_i_plugin_rec_mutex_destroy
/* It's a safer bet to use the following functions.
The future of the _init functions is uncertain.
*/
SCM_API scm_t_rec_mutex *scm_make_rec_mutex (void);
SCM_API void scm_rec_mutex_free (scm_t_rec_mutex *);
SCM_API int scm_rec_mutex_lock (scm_t_rec_mutex *m);
#define scm_rec_mutex_trylock scm_i_plugin_rec_mutex_trylock
#define scm_rec_mutex_unlock scm_i_plugin_rec_mutex_unlock
#define scm_cond_init scm_i_plugin_cond_init
#define scm_cond_destroy scm_i_plugin_cond_destroy
SCM_API int scm_cond_wait (scm_t_cond *c, scm_t_mutex *m);
SCM_API int scm_cond_timedwait (scm_t_cond *c,
scm_t_mutex *m,
const scm_t_timespec *t);
#define scm_cond_signal scm_i_plugin_cond_signal
#define scm_cond_broadcast scm_i_plugin_cond_broadcast
#define scm_key_create scm_i_plugin_key_create
#define scm_key_delete scm_i_plugin_key_delete
SCM_API int scm_setspecific (scm_t_key k, void *s);
SCM_API void *scm_getspecific (scm_t_key k);
#define scm_thread_select scm_internal_select
/* The application must scm_leave_guile() before entering any piece of
code which can
1. block, or
2. execute for any longer period of time without calling SCM_TICK
Note, though, that it is *not* necessary to use these calls
together with any call in this API.
code which can block.
*/
SCM_API void scm_enter_guile (void);
SCM_API void scm_leave_guile (void);
/* Better versions (although we need the former ones also in order to
avoid forcing code restructuring in existing applications): */
/*fixme* Not implemented yet! */
SCM_API void *scm_in_guile (void (*func) (void*), void *data);
SCM_API void *scm_outside_guile (void (*func) (void*), void *data);
/* These are versions of the ordinary sleep and usleep functions
that play nicely with the thread system. */
SCM_API unsigned long scm_thread_sleep (unsigned long);
SCM_API unsigned long scm_thread_usleep (unsigned long);
/* End of low-level C API */
/*----------------------------------------------------------------------*/
typedef struct scm_thread scm_thread;
SCM_API void scm_i_enter_guile (scm_thread *t);
SCM_API scm_thread *scm_i_leave_guile (void);
SCM_API void *scm_with_guile (void *(*func)(void *), void *data);
SCM_API void *scm_without_guile (void *(*func)(void *), void *data);
SCM_API void *scm_i_with_guile_and_parent (void *(*func)(void *), void *data,
SCM parent);
/* Critical sections */
/* This is the generic critical section for places where we are too
lazy to allocate a specific mutex. */
extern scm_t_mutex scm_i_critical_section_mutex;
extern pthread_mutex_t scm_i_critical_section_mutex;
#define SCM_CRITICAL_SECTION_START \
scm_mutex_lock (&scm_i_critical_section_mutex)
scm_pthread_mutex_lock (&scm_i_critical_section_mutex)
#define SCM_CRITICAL_SECTION_END \
scm_mutex_unlock (&scm_i_critical_section_mutex)
/* This is the temporary support for the old ALLOW/DEFER ints sections */
extern scm_t_rec_mutex scm_i_defer_mutex;
pthread_mutex_unlock (&scm_i_critical_section_mutex)
extern int scm_i_thread_go_to_sleep;
@ -193,8 +117,12 @@ void scm_i_thread_put_to_sleep (void);
void scm_i_thread_wake_up (void);
void scm_i_thread_invalidate_freelists (void);
void scm_i_thread_sleep_for_gc (void);
void scm_threads_prehistory (void);
void scm_threads_prehistory (SCM_STACKITEM *);
void scm_threads_init_first_thread (void);
SCM_API void scm_threads_mark_stacks (void);
SCM_API void scm_init_threads (void);
SCM_API void scm_init_thread_procs (void);
SCM_API void scm_init_threads_root_root (void);
#define SCM_THREAD_SWITCHING_CODE \
do { \
@ -211,12 +139,11 @@ SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
SCM_API SCM scm_yield (void);
SCM_API SCM scm_join_thread (SCM t);
SCM_API SCM scm_make_mutex (void);
SCM_API SCM scm_make_fair_mutex (void);
SCM_API SCM scm_make_recursive_mutex (void);
SCM_API SCM scm_lock_mutex (SCM m);
SCM_API SCM scm_try_mutex (SCM m);
SCM_API SCM scm_unlock_mutex (SCM m);
SCM_API SCM scm_make_condition_variable (void);
SCM_API SCM scm_make_fair_condition_variable (void);
SCM_API SCM scm_wait_condition_variable (SCM cond, SCM mutex);
SCM_API SCM scm_timed_wait_condition_variable (SCM cond, SCM mutex,
SCM abstime);
@ -232,17 +159,24 @@ SCM_API SCM scm_thread_exited_p (SCM thread);
SCM_API scm_root_state *scm_i_thread_root (SCM thread);
#define SCM_CURRENT_THREAD \
((scm_thread *) scm_i_plugin_getspecific (scm_i_thread_key))
extern scm_t_key scm_i_thread_key;
((scm_thread *) pthread_getspecific (scm_i_thread_key))
SCM_API pthread_key_t scm_i_thread_key;
/* These macros have confusing names.
They really refer to the root state of the running thread. */
#define SCM_THREAD_LOCAL_DATA (scm_getspecific (scm_i_root_state_key))
#define SCM_SET_THREAD_LOCAL_DATA(x) scm_i_set_thread_data(x)
SCM_API scm_t_key scm_i_root_state_key;
SCM_API void scm_i_set_thread_data (void *);
SCM_API pthread_mutex_t scm_i_misc_mutex;
SCM_API scm_t_mutex scm_i_misc_mutex;
/* Convenience functions for working with the pthread API in guile
mode.
*/
SCM_API int scm_pthread_mutex_lock (pthread_mutex_t *mutex);
SCM_API void scm_frame_pthread_mutex_lock (pthread_mutex_t *mutex);
SCM_API int scm_pthread_cond_wait (pthread_cond_t *cond,
pthread_mutex_t *mutex);
SCM_API int scm_pthread_cond_timedwait (pthread_cond_t *cond,
pthread_mutex_t *mutex,
const struct timespec *abstime);
SCM_API unsigned long scm_thread_sleep (unsigned long);
SCM_API unsigned long scm_thread_usleep (unsigned long);
#endif /* SCM_THREADS_H */

2
libguile/throw.c
View file

@ -460,7 +460,7 @@ scm_handle_by_message (void *handler_data, SCM tag, SCM args)
}
handler_message (handler_data, tag, args);
exit (2);
pthread_exit (NULL);
}

4
libguile/vports.c
View file

@ -194,14 +194,14 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
SCM_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME);
SCM_VALIDATE_STRING (2, modes);
scm_mutex_lock (&scm_i_port_table_mutex);
scm_pthread_mutex_lock (&scm_i_port_table_mutex);
z = scm_new_port_table_entry (scm_tc16_sfport);
pt = SCM_PTAB_ENTRY (z);
scm_port_non_buffer (pt);
SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_i_mode_bits (modes));
SCM_SETSTREAM (z, SCM_UNPACK (pv));
scm_mutex_unlock (&scm_i_port_table_mutex);
pthread_mutex_unlock (&scm_i_port_table_mutex);
return z;
}
#undef FUNC_NAME