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

Some cleanups, mainly around badly indented CPP directives.

Browse Source
This commit is contained in:
Eli Barzilay 2012-03-25 15:37:18 -04:00
parent 89dee6f6c1
commit acfe585c93
2 changed files with 289 additions and 280 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
src/foreign/foreign.c
View File

@ -1339,10 +1339,11 @@ END_XFORM_SKIP;
#endif #endif
/* The sync field: /* The sync field:
NULL => non-atomic mode * NULL => non-atomic mode
#t => atomic mode, no sync proc * #t => atomic mode, no sync proc
proc => non-atomic mode, sync proc * proc => non-atomic mode, sync proc
(box proc) => atomic mode, sync proc */ * (box proc) => atomic mode, sync proc
*/
/*****************************************************************************/ /*****************************************************************************/
/* Pointer objects */ /* Pointer objects */
@ -2741,6 +2742,11 @@ static void *orig_place_signal_handle;
static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff, 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, int nargs, GC_CAN_IGNORE ForeignAny *ivals, void **avalues,
intptr_t *offsets, void *p) intptr_t *offsets, void *p)
/* This function can trigger a GC, but it won't escape --- unless
the called function goes back to Racket and raises an exception,
and raising an exception in a callback creates all sorts of
other problems, anyway. No other Racket threads will run in the
place, so it's ok for the arguments to have stack addresses. */
{ {
FFI_Orig_Place_Call *todo; FFI_Orig_Place_Call *todo;
void *sh; void *sh;
@ -2758,6 +2764,8 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
GCs while we wait, but still wake up on an external signal. */ GCs while we wait, but still wake up on an external signal. */
GC_check_master_gc_request(); GC_check_master_gc_request();
/* If a GC is needed from here on, a signal will be posted
to the current place */
while (1) { while (1) {
todo->cif = cif; todo->cif = cif;
@ -2785,15 +2793,15 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
mzrt_mutex_unlock(orig_place_mutex); mzrt_mutex_unlock(orig_place_mutex);
if (!ready) { if (!ready) {
/* tell original-place thread that there's work: */ /* Tell original-place thread that there's work: */
scheme_signal_received_at(orig_place_signal_handle); scheme_signal_received_at(orig_place_signal_handle);
/* wait for notificiation: */ /* Wait for notificiation or a master-GC request: */
scheme_wait_until_signal_received(); scheme_wait_until_signal_received();
} }
mzrt_mutex_lock(orig_place_mutex); mzrt_mutex_lock(orig_place_mutex);
if (!todo->signal_handle) { if (!todo->signal_handle) {
/* done */ /* Done */
mzrt_mutex_unlock(orig_place_mutex); mzrt_mutex_unlock(orig_place_mutex);
free(todo); free(todo);
break; break;
@ -2986,12 +2994,12 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
GC_CAN_IGNORE ffi_type *rtype, **atypes; GC_CAN_IGNORE ffi_type *rtype, **atypes;
GC_CAN_IGNORE ffi_cif *cif; GC_CAN_IGNORE ffi_cif *cif;
int i, nargs, save_errno; int i, nargs, save_errno;
#ifdef MZ_USE_PLACES # ifdef MZ_USE_PLACES
int orig_place; int orig_place;
# define FFI_CALL_VEC_SIZE 8 # define FFI_CALL_VEC_SIZE 8
#else # else /* MZ_USE_PLACES undefined */
# define FFI_CALL_VEC_SIZE 7 # define FFI_CALL_VEC_SIZE 7
#endif # endif /* MZ_USE_PLACES */
cp = unwrap_cpointer_property(argv[0]); cp = unwrap_cpointer_property(argv[0]);
if (!SCHEME_FFIANYPTRP(cp)) if (!SCHEME_FFIANYPTRP(cp))
scheme_wrong_type(MYNAME, "ffi-obj-or-cpointer", 0, argc, argv); scheme_wrong_type(MYNAME, "ffi-obj-or-cpointer", 0, argc, argv);
@ -3022,12 +3030,10 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
} }
} else } else
save_errno = 0; save_errno = 0;
#ifdef MZ_USE_PLACES # ifdef MZ_USE_PLACES
if (argc > 5) { if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
orig_place = SCHEME_TRUEP(argv[5]); else orig_place = 0;
} else # endif /* MZ_USE_PLACES */
orig_place = 0;
#endif
atypes = malloc(nargs * sizeof(ffi_type*)); atypes = malloc(nargs * sizeof(ffi_type*));
for (i=0, p=itypes; i<nargs; i++, p=SCHEME_CDR(p)) { for (i=0, p=itypes; i<nargs; i++, p=SCHEME_CDR(p)) {
if (NULL == (base = get_ctype_base(SCHEME_CAR(p)))) if (NULL == (base = get_ctype_base(SCHEME_CAR(p))))
@ -3052,9 +3058,9 @@ static Scheme_Object *foreign_ffi_call(int argc, Scheme_Object *argv[])
SCHEME_VEC_ELS(data)[4] = (Scheme_Object*)cif; SCHEME_VEC_ELS(data)[4] = (Scheme_Object*)cif;
SCHEME_VEC_ELS(data)[5] = scheme_make_integer(ooff); SCHEME_VEC_ELS(data)[5] = scheme_make_integer(ooff);
SCHEME_VEC_ELS(data)[6] = scheme_make_integer(save_errno); SCHEME_VEC_ELS(data)[6] = scheme_make_integer(save_errno);
#ifdef MZ_USE_PLACES # ifdef MZ_USE_PLACES
SCHEME_VEC_ELS(data)[7] = (orig_place ? scheme_true : scheme_false); SCHEME_VEC_ELS(data)[7] = (orig_place ? scheme_true : scheme_false);
#endif # endif /* MZ_USE_PLACES */
scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL); scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
return scheme_make_closed_prim_w_arity return scheme_make_closed_prim_w_arity
(ffi_do_call, (void*)data, SCHEME_BYTE_STR_VAL(p), (ffi_do_call, (void*)data, SCHEME_BYTE_STR_VAL(p),
@ -3359,9 +3365,9 @@ static Scheme_Object *foreign_ffi_callback(int argc, Scheme_Object *argv[])
GC_CAN_IGNORE closure_and_cif *cl_cif_args; GC_CAN_IGNORE closure_and_cif *cl_cif_args;
GC_CAN_IGNORE ffi_callback_t do_callback; GC_CAN_IGNORE ffi_callback_t do_callback;
GC_CAN_IGNORE void *callback_data; GC_CAN_IGNORE void *callback_data;
#ifdef MZ_USE_MZRT # ifdef MZ_USE_MZRT
int keep_queue = 0; int keep_queue = 0;
#endif # endif /* MZ_USE_MZRT */
if (!SCHEME_PROCP(argv[0])) if (!SCHEME_PROCP(argv[0]))
scheme_wrong_type(MYNAME, "procedure", 0, argc, argv); scheme_wrong_type(MYNAME, "procedure", 0, argc, argv);
@ -3377,7 +3383,7 @@ static Scheme_Object *foreign_ffi_callback(int argc, Scheme_Object *argv[])
if (argc > 5) if (argc > 5)
(void)scheme_check_proc_arity2(MYNAME, 1, 5, argc, argv, 1); (void)scheme_check_proc_arity2(MYNAME, 1, 5, argc, argv, 1);
if (((argc > 5) && SCHEME_TRUEP(argv[5]))) { if (((argc > 5) && SCHEME_TRUEP(argv[5]))) {
#ifdef MZ_USE_MZRT # ifdef MZ_USE_MZRT
if (!ffi_sync_queue) { if (!ffi_sync_queue) {
mzrt_thread_id tid; mzrt_thread_id tid;
void *sig_hand; void *sig_hand;
@ -3393,12 +3399,13 @@ static Scheme_Object *foreign_ffi_callback(int argc, Scheme_Object *argv[])
sync = argv[5]; sync = argv[5];
if (is_atomic) sync = scheme_box(sync); if (is_atomic) sync = scheme_box(sync);
keep_queue = 1; keep_queue = 1;
#endif # endif /* MZ_USE_MZRT */
do_callback = ffi_queue_callback; do_callback = ffi_queue_callback;
} else } else
do_callback = ffi_do_callback; do_callback = ffi_do_callback;
/* malloc space for everything needed, so a single free gets rid of this */ /* malloc space for everything needed, so a single free gets rid of this */
cl_cif_args = scheme_malloc_code(sizeof(closure_and_cif) + nargs*sizeof(ffi_cif*)); cl_cif_args =
scheme_malloc_code(sizeof(closure_and_cif) + nargs*sizeof(ffi_cif*));
cl = &(cl_cif_args->closure); /* cl is the same as cl_cif_args */ cl = &(cl_cif_args->closure); /* cl is the same as cl_cif_args */
cif = &(cl_cif_args->cif); cif = &(cl_cif_args->cif);
atypes = (ffi_type **)(((char*)cl_cif_args) + sizeof(closure_and_cif)); atypes = (ffi_type **)(((char*)cl_cif_args) + sizeof(closure_and_cif));
@ -3428,28 +3435,29 @@ static Scheme_Object *foreign_ffi_callback(int argc, Scheme_Object *argv[])
# else /* MZ_PRECISE_GC undefined */ # else /* MZ_PRECISE_GC undefined */
callback_data = (void*)data; callback_data = (void*)data;
# endif /* MZ_PRECISE_GC */ # endif /* MZ_PRECISE_GC */
#ifdef MZ_USE_MZRT # ifdef MZ_USE_MZRT
if (keep_queue) { if (keep_queue) {
/* For ffi_queue_callback(), add a level of indirection in /* For ffi_queue_callback(), add a level of indirection in `data' to
`data' to hold the place-specific `ffi_sync_queue'. hold the place-specific `ffi_sync_queue'. Use
Use `free_cl_cif_data_args' to clean up this extra level. */ `free_cl_cif_data_args' to clean up this extra level. */
GC_CAN_IGNORE void **tmp; GC_CAN_IGNORE void **tmp;
tmp = (void **)malloc(sizeof(void*) * 2); tmp = (void **)malloc(sizeof(void*) * 2);
tmp[0] = callback_data; tmp[0] = callback_data;
tmp[1] = ffi_sync_queue; tmp[1] = ffi_sync_queue;
callback_data = (void *)tmp; callback_data = (void *)tmp;
} }
#endif # endif /* MZ_USE_MZRT */
cl_cif_args->data = callback_data; cl_cif_args->data = callback_data;
if (ffi_prep_closure(cl, cif, do_callback, (void*)(cl_cif_args->data)) if (ffi_prep_closure(cl, cif, do_callback, (void*)(cl_cif_args->data))
!= FFI_OK) != FFI_OK)
scheme_signal_error scheme_signal_error
("internal error: ffi_prep_closure did not return FFI_OK"); ("internal error: ffi_prep_closure did not return FFI_OK");
#ifdef MZ_USE_MZRT # ifdef MZ_USE_MZRT
if (keep_queue) if (keep_queue)
scheme_register_finalizer(data, free_cl_cif_queue_args, cl_cif_args, NULL, NULL); scheme_register_finalizer(data, free_cl_cif_queue_args, cl_cif_args,
NULL, NULL);
else else
#endif # endif /* MZ_USE_MZRT */
scheme_register_finalizer(data, free_cl_cif_args, cl_cif_args, NULL, NULL); scheme_register_finalizer(data, free_cl_cif_args, cl_cif_args, NULL, NULL);
return (Scheme_Object*)data; return (Scheme_Object*)data;
} }

63
src/foreign/foreign.rktc
View File

@ -1121,10 +1121,11 @@ ffi_abi sym_to_abi(char *who, Scheme_Object *sym)
[sync "Scheme_Object*"]] [sync "Scheme_Object*"]]
/* The sync field: /* The sync field:
NULL => non-atomic mode * NULL => non-atomic mode
#t => atomic mode, no sync proc * #t => atomic mode, no sync proc
proc => non-atomic mode, sync proc * proc => non-atomic mode, sync proc
(box proc) => atomic mode, sync proc */ * (box proc) => atomic mode, sync proc
*/
/*****************************************************************************/ /*****************************************************************************/
/* Pointer objects */ /* Pointer objects */
@ -1484,7 +1485,7 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
if (basetype == 0) basetype = 1; /* int is the default type */ if (basetype == 0) basetype = 1; /* int is the default type */
/* don't assume anything, so it can be used to verify compiler assumptions */ /* don't assume anything, so it can be used to verify compiler assumptions */
/* (only forbid stuff that the compiler doesn't allow) */ /* (only forbid stuff that the compiler doesn't allow) */
@@DEFINE{RETSIZE(t) res=((stars==0)?sizeof(t):sizeof(t *))} @DEFINE{RETSIZE(t) res=((stars==0)?sizeof(t):sizeof(t *))}
switch (basetype) { switch (basetype) {
case 1: /* int */ case 1: /* int */
switch (intsize) { switch (intsize) {
@ -2345,12 +2346,12 @@ static Scheme_Object *ffi_name_prefix = NULL;
GC_CAN_IGNORE ffi_type *rtype, **atypes; GC_CAN_IGNORE ffi_type *rtype, **atypes;
GC_CAN_IGNORE ffi_cif *cif; GC_CAN_IGNORE ffi_cif *cif;
int i, nargs, save_errno; int i, nargs, save_errno;
#ifdef MZ_USE_PLACES @@@IFDEF{MZ_USE_PLACES}{
int orig_place; int orig_place;
# define FFI_CALL_VEC_SIZE 8 @DEFINE{FFI_CALL_VEC_SIZE 8}
#else }{
# define FFI_CALL_VEC_SIZE 7 @DEFINE{FFI_CALL_VEC_SIZE 7}
#endif }
cp = unwrap_cpointer_property(argv[0]); cp = unwrap_cpointer_property(argv[0]);
if (!SCHEME_FFIANYPTRP(cp)) if (!SCHEME_FFIANYPTRP(cp))
scheme_wrong_type(MYNAME, "ffi-obj-or-cpointer", 0, argc, argv); scheme_wrong_type(MYNAME, "ffi-obj-or-cpointer", 0, argc, argv);
@ -2381,12 +2382,10 @@ static Scheme_Object *ffi_name_prefix = NULL;
} }
} else } else
save_errno = 0; save_errno = 0;
#ifdef MZ_USE_PLACES @@IFDEF{MZ_USE_PLACES}{
if (argc > 5) { if (argc > 5) orig_place = SCHEME_TRUEP(argv[5]);
orig_place = SCHEME_TRUEP(argv[5]); else orig_place = 0;
} else }
orig_place = 0;
#endif
atypes = malloc(nargs * sizeof(ffi_type*)); atypes = malloc(nargs * sizeof(ffi_type*));
for (i=0, p=itypes; i<nargs; i++, p=SCHEME_CDR(p)) { for (i=0, p=itypes; i<nargs; i++, p=SCHEME_CDR(p)) {
if (NULL == (base = get_ctype_base(SCHEME_CAR(p)))) if (NULL == (base = get_ctype_base(SCHEME_CAR(p))))
@ -2411,9 +2410,9 @@ static Scheme_Object *ffi_name_prefix = NULL;
SCHEME_VEC_ELS(data)[4] = (Scheme_Object*)cif; SCHEME_VEC_ELS(data)[4] = (Scheme_Object*)cif;
SCHEME_VEC_ELS(data)[5] = scheme_make_integer(ooff); SCHEME_VEC_ELS(data)[5] = scheme_make_integer(ooff);
SCHEME_VEC_ELS(data)[6] = scheme_make_integer(save_errno); SCHEME_VEC_ELS(data)[6] = scheme_make_integer(save_errno);
#ifdef MZ_USE_PLACES @@IFDEF{MZ_USE_PLACES}{
SCHEME_VEC_ELS(data)[7] = (orig_place ? scheme_true : scheme_false); SCHEME_VEC_ELS(data)[7] = (orig_place ? scheme_true : scheme_false);
#endif }
scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL); scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
return scheme_make_closed_prim_w_arity return scheme_make_closed_prim_w_arity
(ffi_do_call, (void*)data, SCHEME_BYTE_STR_VAL(p), (ffi_do_call, (void*)data, SCHEME_BYTE_STR_VAL(p),
@ -2715,9 +2714,9 @@ void free_cl_cif_queue_args(void *ignored, void *p)
GC_CAN_IGNORE closure_and_cif *cl_cif_args; GC_CAN_IGNORE closure_and_cif *cl_cif_args;
GC_CAN_IGNORE ffi_callback_t do_callback; GC_CAN_IGNORE ffi_callback_t do_callback;
GC_CAN_IGNORE void *callback_data; GC_CAN_IGNORE void *callback_data;
#ifdef MZ_USE_MZRT @@IFDEF{MZ_USE_MZRT}{
int keep_queue = 0; int keep_queue = 0;
#endif }
if (!SCHEME_PROCP(argv[0])) if (!SCHEME_PROCP(argv[0]))
scheme_wrong_type(MYNAME, "procedure", 0, argc, argv); scheme_wrong_type(MYNAME, "procedure", 0, argc, argv);
@ -2733,7 +2732,7 @@ void free_cl_cif_queue_args(void *ignored, void *p)
if (argc > 5) if (argc > 5)
(void)scheme_check_proc_arity2(MYNAME, 1, 5, argc, argv, 1); (void)scheme_check_proc_arity2(MYNAME, 1, 5, argc, argv, 1);
if (((argc > 5) && SCHEME_TRUEP(argv[5]))) { if (((argc > 5) && SCHEME_TRUEP(argv[5]))) {
#ifdef MZ_USE_MZRT @@IFDEF{MZ_USE_MZRT}{
if (!ffi_sync_queue) { if (!ffi_sync_queue) {
mzrt_thread_id tid; mzrt_thread_id tid;
void *sig_hand; void *sig_hand;
@ -2749,12 +2748,13 @@ void free_cl_cif_queue_args(void *ignored, void *p)
sync = argv[5]; sync = argv[5];
if (is_atomic) sync = scheme_box(sync); if (is_atomic) sync = scheme_box(sync);
keep_queue = 1; keep_queue = 1;
#endif }
do_callback = ffi_queue_callback; do_callback = ffi_queue_callback;
} else } else
do_callback = ffi_do_callback; do_callback = ffi_do_callback;
/* malloc space for everything needed, so a single free gets rid of this */ /* malloc space for everything needed, so a single free gets rid of this */
cl_cif_args = scheme_malloc_code(sizeof(closure_and_cif) + nargs*sizeof(ffi_cif*)); cl_cif_args =
scheme_malloc_code(sizeof(closure_and_cif) + nargs*sizeof(ffi_cif*));
cl = &(cl_cif_args->closure); /* cl is the same as cl_cif_args */ cl = &(cl_cif_args->closure); /* cl is the same as cl_cif_args */
cif = &(cl_cif_args->cif); cif = &(cl_cif_args->cif);
atypes = (ffi_type **)(((char*)cl_cif_args) + sizeof(closure_and_cif)); atypes = (ffi_type **)(((char*)cl_cif_args) + sizeof(closure_and_cif));
@ -2780,28 +2780,29 @@ void free_cl_cif_queue_args(void *ignored, void *p)
}{ }{
callback_data = (void*)data; callback_data = (void*)data;
} }
#ifdef MZ_USE_MZRT @@IFDEF{MZ_USE_MZRT}{
if (keep_queue) { if (keep_queue) {
/* For ffi_queue_callback(), add a level of indirection in /* For ffi_queue_callback(), add a level of indirection in `data' to
`data' to hold the place-specific `ffi_sync_queue'. hold the place-specific `ffi_sync_queue'. Use
Use `free_cl_cif_data_args' to clean up this extra level. */ `free_cl_cif_data_args' to clean up this extra level. */
GC_CAN_IGNORE void **tmp; GC_CAN_IGNORE void **tmp;
tmp = (void **)malloc(sizeof(void*) * 2); tmp = (void **)malloc(sizeof(void*) * 2);
tmp[0] = callback_data; tmp[0] = callback_data;
tmp[1] = ffi_sync_queue; tmp[1] = ffi_sync_queue;
callback_data = (void *)tmp; callback_data = (void *)tmp;
} }
#endif }
cl_cif_args->data = callback_data; cl_cif_args->data = callback_data;
if (ffi_prep_closure(cl, cif, do_callback, (void*)(cl_cif_args->data)) if (ffi_prep_closure(cl, cif, do_callback, (void*)(cl_cif_args->data))
!= FFI_OK) != FFI_OK)
scheme_signal_error scheme_signal_error
("internal error: ffi_prep_closure did not return FFI_OK"); ("internal error: ffi_prep_closure did not return FFI_OK");
#ifdef MZ_USE_MZRT @@IFDEF{MZ_USE_MZRT}{
if (keep_queue) if (keep_queue)
scheme_register_finalizer(data, free_cl_cif_queue_args, cl_cif_args, NULL, NULL); scheme_register_finalizer(data, free_cl_cif_queue_args, cl_cif_args,
NULL, NULL);
else else
#endif }
scheme_register_finalizer(data, free_cl_cif_args, cl_cif_args, NULL, NULL); scheme_register_finalizer(data, free_cl_cif_args, cl_cif_args, NULL, NULL);
return (Scheme_Object*)data; return (Scheme_Object*)data;
} }