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

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

@ -14,9 +14,9 @@
#ifdef MZ_USE_FFIPOLL #ifdef MZ_USE_FFIPOLL
# define MZ_USE_FFIPOLL_COND 1 # define MZ_USE_FFIPOLL_COND 1
#else #else /* MZ_USE_FFIPOLL undefined */
# define MZ_USE_FFIPOLL_COND 0 # define MZ_USE_FFIPOLL_COND 0
#endif #endif /* MZ_USE_FFIPOLL */
#ifndef SIZEOF_BOOL #ifndef SIZEOF_BOOL
# define SIZEOF_BOOL 0 # 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 to handle those anyway, since the call in the original
place may lead to a callback that should run in place may lead to a callback that should run in
this place. */ this place. */
# ifdef MZ_USE_FFIPOLL # ifndef MZ_USE_FFIPOLL
# else
check_foreign_work(0); 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; int i;
intptr_t basetype, offset, *offsets; intptr_t basetype, offset, *offsets;
#ifdef MZ_USE_PLACES #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; orig_place = 0;
#endif #endif
if (!cif) { 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 defined(MZ_USE_PLACES) && !defined(MZ_USE_FFIPOLL)
if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]); if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
else orig_place = 0; else orig_place = 0;
# endif /* MZ_USE_PLACES */ # endif /* defined(MZ_USE_PLACES) && !defined(MZ_USE_FFIPOLL) */
if (argc > 6) { if (argc > 6) {
if (!SCHEME_FALSEP(argv[6])) { if (!SCHEME_FALSEP(argv[6])) {
if (!SCHEME_CHAR_STRINGP(argv[6])) if (!SCHEME_CHAR_STRINGP(argv[6]))
@ -3910,12 +3909,17 @@ static Scheme_Object *callback_thunk(void *_qc, int argc, Scheme_Object *argv[])
static void check_foreign_work(int check_for_in_original) static void check_foreign_work(int check_for_in_original)
# ifdef MZ_USE_FFIPOLL # ifdef MZ_USE_FFIPOLL
XFORM_SKIP_PROC XFORM_SKIP_PROC
#endif # endif /* MZ_USE_FFIPOLL */
{ {
GC_CAN_IGNORE Queued_Callback *qc; GC_CAN_IGNORE Queued_Callback *qc;
ffi_callback_struct *data; ffi_callback_struct *data;
Scheme_Object *a[1], *proc; 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) { if (ffi_sync_queue) {
do { do {
mzrt_mutex_lock(ffi_sync_queue->lock); mzrt_mutex_lock(ffi_sync_queue->lock);
@ -3943,6 +3947,7 @@ XFORM_SKIP_PROC
} while (qc); } while (qc);
} }
#endif
#ifdef MZ_USE_PLACES #ifdef MZ_USE_PLACES
if (check_for_in_original && ((scheme_current_place_id == 0) || MZ_USE_FFIPOLL_COND) && orig_place_mutex) { if (check_for_in_original && ((scheme_current_place_id == 0) || MZ_USE_FFIPOLL_COND) && orig_place_mutex) {
@ -3981,7 +3986,7 @@ XFORM_SKIP_PROC
void scheme_check_foreign_work(void) void scheme_check_foreign_work(void)
# ifdef MZ_USE_FFIPOLL # ifdef MZ_USE_FFIPOLL
XFORM_SKIP_PROC XFORM_SKIP_PROC
#endif # endif /* MZ_USE_FFIPOLL */
{ {
check_foreign_work(1); check_foreign_work(1);
} }

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

@ -15,6 +15,12 @@ exec racket "$0" > `echo "$0" | sed 's/rktc$/c/'` "$0"
#include <errno.h> #include <errno.h>
@@@IFDEF{MZ_USE_FFIPOLL}{
# define MZ_USE_FFIPOLL_COND 1
}{
# define MZ_USE_FFIPOLL_COND 0
}
@@IFNDEF{SIZEOF_BOOL}{ @@IFNDEF{SIZEOF_BOOL}{
# define SIZEOF_BOOL 0 # define SIZEOF_BOOL 0
} }
@ -2669,10 +2675,12 @@ 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 to handle those anyway, since the call in the original
place may lead to a callback that should run in place may lead to a callback that should run in
this place. */ this place. */
@@IFNDEF{MZ_USE_FFIPOLL}{
check_foreign_work(0); check_foreign_work(0);
} }
} }
} }
}
#endif #endif
static void finish_ffi_call(ffi_cif *cif, void *c_func, intptr_t cfoff, static void finish_ffi_call(ffi_cif *cif, void *c_func, intptr_t cfoff,
@ -2744,7 +2752,7 @@ static Scheme_Object *ffi_do_call(int argc, Scheme_Object *argv[], Scheme_Object
int i; int i;
intptr_t basetype, offset, *offsets; intptr_t basetype, offset, *offsets;
#ifdef MZ_USE_PLACES #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; orig_place = 0;
#endif #endif
if (!cif) { if (!cif) {
@ -2884,7 +2892,7 @@ static Scheme_Object *ffi_name = NULL;
int i, nargs, save_errno; int i, nargs, save_errno;
Scheme_Object *lock = scheme_false; Scheme_Object *lock = scheme_false;
@@@IFDEF{MZ_USE_PLACES}{ @@@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 9}
}{ }{
@DEFINE{FFI_CALL_VEC_SIZE 8} @DEFINE{FFI_CALL_VEC_SIZE 8}
@ -2919,7 +2927,7 @@ static Scheme_Object *ffi_name = NULL;
} }
} else } else
save_errno = 0; 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]); if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
else orig_place = 0; 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) static void check_foreign_work(int check_for_in_original)
@@IFDEF{MZ_USE_FFIPOLL}{XFORM_SKIP_PROC}
{ {
GC_CAN_IGNORE Queued_Callback *qc; GC_CAN_IGNORE Queued_Callback *qc;
ffi_callback_struct *data; ffi_callback_struct *data;
Scheme_Object *a[1], *proc; 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) { if (ffi_sync_queue) {
do { do {
mzrt_mutex_lock(ffi_sync_queue->lock); mzrt_mutex_lock(ffi_sync_queue->lock);
@ -3092,9 +3106,10 @@ static void check_foreign_work(int check_for_in_original)
} while (qc); } while (qc);
} }
#endif
#ifdef MZ_USE_PLACES #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; FFI_Orig_Place_Call *todo;
void *sh; void *sh;
@ -3128,6 +3143,7 @@ static void check_foreign_work(int check_for_in_original)
} }
void scheme_check_foreign_work(void) void scheme_check_foreign_work(void)
@@IFDEF{MZ_USE_FFIPOLL}{XFORM_SKIP_PROC}
{ {
check_foreign_work(1); check_foreign_work(1);
} }