suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

atomic timeout hook must be place-local

Browse Source
This commit is contained in:
Matthew Flatt 2011-11-16 20:33:58 -07:00
parent eae7c5d5d7
commit 8483b8eea5
3 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/racket/include/scheme.h
View File

@ -1729,8 +1729,6 @@ extern void *scheme_malloc_envunbox(size_t);
/* embedding configuration and hooks */
/*========================================================================*/
typedef void (*Scheme_On_Atomic_Timeout_Proc)(int must_give_up);
#if SCHEME_DIRECT_EMBEDDED
#if defined(_IBMR2)
@ -1871,8 +1869,6 @@ MZ_EXTERN void scheme_register_static(void *ptr, intptr_t size);
# define MZ_REGISTER_STATIC(x) /* empty */
#endif
MZ_EXTERN Scheme_On_Atomic_Timeout_Proc scheme_on_atomic_timeout;
MZ_EXTERN void scheme_immediate_exit(int status);
MZ_EXTERN int scheme_new_param(void);

8
src/racket/include/schthread.h
View File

@ -105,6 +105,8 @@ typedef intptr_t objhead;
typedef void (*Scheme_Sleep_Proc)(float seconds, void *fds);
typedef void (*Scheme_On_Atomic_Timeout_Proc)(int must_give_up);
/* **************************************** */
#ifndef USE_THREAD_LOCAL
@ -342,6 +344,9 @@ typedef struct Thread_Local_Variables {
Scheme_Sleep_Proc scheme_place_sleep_;
struct Scheme_Bucket_Table *taint_intern_table_;
struct GHBN_Thread_Data *ghbn_thread_data_;
Scheme_On_Atomic_Timeout_Proc on_atomic_timeout_;
int atomic_timeout_auto_suspend_;
int atomic_timeout_atomic_level_;
} Thread_Local_Variables;
#if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS)
@ -685,6 +690,9 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define scheme_place_sleep XOA (scheme_get_thread_local_variables()->scheme_place_sleep_)
#define taint_intern_table XOA (scheme_get_thread_local_variables()->taint_intern_table_)
#define ghbn_thread_data XOA (scheme_get_thread_local_variables()->ghbn_thread_data_)
#define on_atomic_timeout XOA (scheme_get_thread_local_variables()->on_atomic_timeout_)
#define atomic_timeout_auto_suspend XOA (scheme_get_thread_local_variables()->atomic_timeout_auto_suspend_)
#define atomic_timeout_atomic_level XOA (scheme_get_thread_local_variables()->atomic_timeout_atomic_level_)
/* **************************************** */

20
src/racket/src/thread.c
View File

@ -225,9 +225,9 @@ HOOK_SHARED_OK void (*scheme_sleep)(float seconds, void *fds);
HOOK_SHARED_OK void (*scheme_notify_multithread)(int on);
HOOK_SHARED_OK void (*scheme_wakeup_on_input)(void *fds);
HOOK_SHARED_OK int (*scheme_check_for_break)(void);
HOOK_SHARED_OK Scheme_On_Atomic_Timeout_Proc scheme_on_atomic_timeout;
HOOK_SHARED_OK static int atomic_timeout_auto_suspend;
HOOK_SHARED_OK static int atomic_timeout_atomic_level;
THREAD_LOCAL_DECL(static Scheme_On_Atomic_Timeout_Proc on_atomic_timeout);
THREAD_LOCAL_DECL(static int atomic_timeout_auto_suspend);
THREAD_LOCAL_DECL(static int atomic_timeout_atomic_level);
THREAD_LOCAL_DECL(struct Scheme_GC_Pre_Post_Callback_Desc *gc_prepost_callback_descs);
@ -4344,7 +4344,7 @@ static void call_on_atomic_timeout(int must)
void **private_kill_next;
/* Save any state that has to do with the thread blocking or
sleeping, in case scheme_on_atomic_timeout() runs Racket code. */
sleeping, in case on_atomic_timeout() runs Racket code. */
running = p->running;
sleep_end = p->sleep_end;
@ -4364,7 +4364,7 @@ static void call_on_atomic_timeout(int must)
p->block_check = NULL;
p->block_needs_wakeup = NULL;
scheme_on_atomic_timeout(must);
on_atomic_timeout(must);
p->running = running;
p->sleep_end = sleep_end;
@ -4668,7 +4668,7 @@ void scheme_thread_block(float sleep_time)
swap_target = next;
next = NULL;
do_swap_thread();
} else if (do_atomic && scheme_on_atomic_timeout
} else if (do_atomic && on_atomic_timeout
&& (atomic_timeout_auto_suspend < 2)) {
if (!atomic_timeout_auto_suspend
|| (do_atomic <= atomic_timeout_atomic_level)) {
@ -4950,7 +4950,7 @@ int scheme_wait_until_suspend_ok(void)
{
int did = 0;
if (scheme_on_atomic_timeout) {
if (on_atomic_timeout) {
/* new-style atomic timeout */
if (do_atomic > atomic_timeout_atomic_level) {
scheme_log_abort("attempted to wait for suspend in nested atomic mode");
@ -4958,7 +4958,7 @@ int scheme_wait_until_suspend_ok(void)
}
}
while (do_atomic && scheme_on_atomic_timeout) {
while (do_atomic && on_atomic_timeout) {
did = 1;
if (atomic_timeout_auto_suspend)
atomic_timeout_auto_suspend++;
@ -4979,8 +4979,8 @@ Scheme_On_Atomic_Timeout_Proc scheme_set_on_atomic_timeout(Scheme_On_Atomic_Time
{
Scheme_On_Atomic_Timeout_Proc old;
old = scheme_on_atomic_timeout;
scheme_on_atomic_timeout = p;
old = on_atomic_timeout;
on_atomic_timeout = p;
if (p) {
atomic_timeout_auto_suspend = 1;
atomic_timeout_atomic_level = do_atomic;