mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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

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);