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

ffi/unsafe: allow callbacks during wait for foreign call in main place

Browse Source 
That is, make a combination of `#:in-original-place? #t' on a call
and `#:async-apply ....' on a callback work.
This commit is contained in:
Matthew Flatt 2012-07-30 07:52:15 -06:00
parent 87a8f70148
commit eeb8739417
2 changed files with 32 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/foreign/foreign.c
View File

@ -2887,6 +2887,8 @@ static mzrt_mutex *orig_place_mutex;
static FFI_Orig_Place_Call *orig_place_calls, *orig_place_calls_tail;
static void *orig_place_signal_handle;
static void check_foreign_work(int check_for_in_original);
static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
int nargs, GC_CAN_IGNORE ForeignAny *ivals, void **avalues,
intptr_t *offsets, void *p)
@ -2976,6 +2978,13 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
scheme_start_atomic();
scheme_thread_block(0.0);
scheme_end_atomic_no_swap();
/* Since we called scheme_thread_block() in atomic mode,
it doesn't check for foreign callbacks. We'd like
to handle those anyway, since the call in the original
place may lead to a callback that should run in
this place. */
check_foreign_work(0);
}
}
}
@ -3308,7 +3317,7 @@ static Scheme_Object *callback_thunk(void *_qc, int argc, Scheme_Object *argv[])
return scheme_void;
}
void scheme_check_foreign_work(void)
static void check_foreign_work(int check_for_in_original)
{
GC_CAN_IGNORE Queued_Callback *qc;
ffi_callback_struct *data;
@ -3343,7 +3352,7 @@ void scheme_check_foreign_work(void)
}
#ifdef MZ_USE_PLACES
if ((scheme_current_place_id == 0) && orig_place_mutex) {
if (check_for_in_original && (scheme_current_place_id == 0) && orig_place_mutex) {
FFI_Orig_Place_Call *todo;
void *sh;
@ -3376,6 +3385,11 @@ void scheme_check_foreign_work(void)
#endif
}
void scheme_check_foreign_work(void)
{
check_foreign_work(1);
}
#endif
void ffi_queue_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)

18
src/foreign/foreign.rktc
View File

@ -2246,6 +2246,8 @@ static mzrt_mutex *orig_place_mutex;
static FFI_Orig_Place_Call *orig_place_calls, *orig_place_calls_tail;
static void *orig_place_signal_handle;
static void check_foreign_work(int check_for_in_original);
static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
int nargs, GC_CAN_IGNORE ForeignAny *ivals, void **avalues,
intptr_t *offsets, void *p)
@ -2335,6 +2337,13 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
scheme_start_atomic();
scheme_thread_block(0.0);
scheme_end_atomic_no_swap();
/* Since we called scheme_thread_block() in atomic mode,
it doesn't check for foreign callbacks. We'd like
to handle those anyway, since the call in the original
place may lead to a callback that should run in
this place. */
check_foreign_work(0);
}
}
}
@ -2664,7 +2673,7 @@ static Scheme_Object *callback_thunk(void *_qc, int argc, Scheme_Object *argv[])
return scheme_void;
}
void scheme_check_foreign_work(void)
static void check_foreign_work(int check_for_in_original)
{
GC_CAN_IGNORE Queued_Callback *qc;
ffi_callback_struct *data;
@ -2699,7 +2708,7 @@ void scheme_check_foreign_work(void)
}
#ifdef MZ_USE_PLACES
if ((scheme_current_place_id == 0) && orig_place_mutex) {
if (check_for_in_original && (scheme_current_place_id == 0) && orig_place_mutex) {
FFI_Orig_Place_Call *todo;
void *sh;
@ -2732,6 +2741,11 @@ void scheme_check_foreign_work(void)
#endif
}
void scheme_check_foreign_work(void)
{
check_foreign_work(1);
}
#endif
void ffi_queue_callback(ffi_cif* cif, void* resultp, void** args, void *userdata)