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

Update "foreign.rktc" for --enable-ffipoll

Browse Source 
This is an adjustment for 96d212d376, since "foreign.rktc" is the
source for "foreign.c".
This commit is contained in:
Matthew Flatt 2016-08-04 20:27:10 -06:00
parent 3769d82b74
commit a229640251
2 changed files with 39 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
racket/src/foreign/foreign.c
View File

@ -14,9 +14,9 @@
#ifdef MZ_USE_FFIPOLL
# define MZ_USE_FFIPOLL_COND 1
#else
#else /* MZ_USE_FFIPOLL undefined */
# define MZ_USE_FFIPOLL_COND 0
#endif
#endif /* MZ_USE_FFIPOLL */
#ifndef SIZEOF_BOOL
# define SIZEOF_BOOL 0
@ -3511,10 +3511,9 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
to handle those anyway, since the call in the original
place may lead to a callback that should run in
this place. */
# ifdef MZ_USE_FFIPOLL
# else
# ifndef MZ_USE_FFIPOLL
check_foreign_work(0);
# endif
# endif /* MZ_USE_FFIPOLL */
}
}
}
@ -3589,7 +3588,7 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
int i;
intptr_t basetype, offset, *offsets;
#ifdef MZ_USE_PLACES
if (orig_place && ((scheme_current_place_id == 0) && !MZ_USE_FFIPOLL_COND))
if (orig_place && (scheme_current_place_id == 0) && !MZ_USE_FFIPOLL_COND)
orig_place = 0;
#endif
if (!cif) {
@ -3769,7 +3768,7 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
# if defined(MZ_USE_PLACES) && !defined(MZ_USE_FFIPOLL)
if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
else orig_place = 0;
# endif /* MZ_USE_PLACES */
# endif /* defined(MZ_USE_PLACES) && !defined(MZ_USE_FFIPOLL) */
if (argc > 6) {
if (!SCHEME_FALSEP(argv[6])) {
if (!SCHEME_CHAR_STRINGP(argv[6]))
@ -3908,14 +3907,19 @@ static Scheme_Object *callback_thunk(void *_qc, int argc, Scheme_Object *argv[])
}
static void check_foreign_work(int check_for_in_original)
#ifdef MZ_USE_FFIPOLL
XFORM_SKIP_PROC
#endif
# ifdef MZ_USE_FFIPOLL
XFORM_SKIP_PROC
# endif /* MZ_USE_FFIPOLL */
{
GC_CAN_IGNORE Queued_Callback *qc;
ffi_callback_struct *data;
Scheme_Object *a[1], *proc;
#ifdef MZ_USE_FFIPOLL
/* We don't currently support callbacks from C to Racket in FFIPOLL
mode, and this function is not allowed to touch the GC or Racket
in that mode. */
#else
if (ffi_sync_queue) {
do {
mzrt_mutex_lock(ffi_sync_queue->lock);
@ -3943,6 +3947,7 @@ XFORM_SKIP_PROC
} while (qc);
}
#endif
#ifdef MZ_USE_PLACES
if (check_for_in_original && ((scheme_current_place_id == 0) || MZ_USE_FFIPOLL_COND) && orig_place_mutex) {
@ -3979,9 +3984,9 @@ XFORM_SKIP_PROC
}
void scheme_check_foreign_work(void)
#ifdef MZ_USE_FFIPOLL
XFORM_SKIP_PROC
#endif
# ifdef MZ_USE_FFIPOLL
XFORM_SKIP_PROC
# endif /* MZ_USE_FFIPOLL */
{
check_foreign_work(1);
}

26
racket/src/foreign/foreign.rktc
View File

@ -15,6 +15,12 @@ exec racket "$0" > `echo "$0" | sed 's/rktc$/c/'` "$0"
#include <errno.h>
@@@IFDEF{MZ_USE_FFIPOLL}{
# define MZ_USE_FFIPOLL_COND 1
}{
# define MZ_USE_FFIPOLL_COND 0
}
@@IFNDEF{SIZEOF_BOOL}{
# define SIZEOF_BOOL 0
}
@ -2669,7 +2675,9 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
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);
@@IFNDEF{MZ_USE_FFIPOLL}{
check_foreign_work(0);
}
}
}
}
@ -2744,7 +2752,7 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
int i;
intptr_t basetype, offset, *offsets;
#ifdef MZ_USE_PLACES
if (orig_place && (scheme_current_place_id == 0))
if (orig_place && (scheme_current_place_id == 0) && !MZ_USE_FFIPOLL_COND)
orig_place = 0;
#endif
if (!cif) {
@ -2884,7 +2892,7 @@ static Scheme_Object *ffi_name = NULL;
int i, nargs, save_errno;
Scheme_Object *lock = scheme_false;
@@@IFDEF{MZ_USE_PLACES}{
int orig_place;
int orig_place = MZ_USE_FFIPOLL_COND;
@DEFINE{FFI_CALL_VEC_SIZE 9}
}{
@DEFINE{FFI_CALL_VEC_SIZE 8}
@ -2919,7 +2927,7 @@ static Scheme_Object *ffi_name = NULL;
}
} else
save_errno = 0;
@@IFDEF{MZ_USE_PLACES}{
@@IF{defined(MZ_USE_PLACES) && !defined(MZ_USE_FFIPOLL)}{
if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
else orig_place = 0;
}
@ -3060,11 +3068,17 @@ static Scheme_Object *callback_thunk(void *_qc, int argc, Scheme_Object *argv[])
}
static void check_foreign_work(int check_for_in_original)
@@IFDEF{MZ_USE_FFIPOLL}{XFORM_SKIP_PROC}
{
GC_CAN_IGNORE Queued_Callback *qc;
ffi_callback_struct *data;
Scheme_Object *a[1], *proc;
#ifdef MZ_USE_FFIPOLL
/* We don't currently support callbacks from C to Racket in FFIPOLL
mode, and this function is not allowed to touch the GC or Racket
in that mode. */
#else
if (ffi_sync_queue) {
do {
mzrt_mutex_lock(ffi_sync_queue->lock);
@ -3092,9 +3106,10 @@ static void check_foreign_work(int check_for_in_original)
} while (qc);
}
#endif
#ifdef MZ_USE_PLACES
if (check_for_in_original && (scheme_current_place_id == 0) && orig_place_mutex) {
if (check_for_in_original && ((scheme_current_place_id == 0) || MZ_USE_FFIPOLL_COND) && orig_place_mutex) {
FFI_Orig_Place_Call *todo;
void *sh;
@ -3128,6 +3143,7 @@ static void check_foreign_work(int check_for_in_original)
}
void scheme_check_foreign_work(void)
@@IFDEF{MZ_USE_FFIPOLL}{XFORM_SKIP_PROC}
{
check_foreign_work(1);
}