From f63abcc9de9e6098b58bcfaa59dc8ae4d5d3b79c Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 11 Jul 2006 20:34:59 +0000 Subject: [PATCH] better macrology for c_to_scheme svn: r3682 --- src/foreign/foreign.c | 41 ++++++++++++++--------------------------- src/foreign/foreign.ssc | 41 ++++++++++++++--------------------------- 2 files changed, 28 insertions(+), 54 deletions(-) diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c index 5b26908ad0..f5715e0e55 100644 --- a/src/foreign/foreign.c +++ b/src/foreign/foreign.c @@ -1066,36 +1066,33 @@ END_XFORM_SKIP; /*****************************************************************************/ /* Scheme<-->C conversions */ -static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src /* On big endian machines we need to know whether we're pulling a value from an * argument location where it always takes a whole word or straight from a - * memory location */ + * memory location -- deal with it via a C2SCHEME macro wrapper that is used + * for both the function definition and calls */ #ifdef SCHEME_BIG_ENDIAN - , int args_loc -#endif - ) -#ifdef SCHEME_BIG_ENDIAN -#define REF_CTYPE(ctype) ((sizeof(ctype)Scheme", "C-type", 0, 1, &type); base = CTYPE_BASETYPE(type); if (base != NULL) { -#ifdef SCHEME_BIG_ENDIAN - res = c_to_scheme(base, src, args_loc); -#else - res = c_to_scheme(base, src); -#endif + res = C2SCHEME(base, src, args_loc); if (SCHEME_FALSEP(CTYPE_USER_C2S(type))) return res; else return _scheme_apply(CTYPE_USER_C2S(type), 1, (Scheme_Object**)(&res)); } else if (CTYPE_PRIMLABEL(type) == FOREIGN_fpointer) { + /* No need for the REF_CTYPE trick for pointers */ return (Scheme_Object*)src; } else switch (CTYPE_PRIMLABEL(type)) { case FOREIGN_void: return scheme_void; @@ -1145,6 +1142,7 @@ static void* scheme_to_c(Scheme_Object *type, void *dst, type = CTYPE_BASETYPE(type); } if (CTYPE_PRIMLABEL(type) == FOREIGN_fpointer) { + /* No need for the SET_CTYPE trick for pointers */ if (SCHEME_FFICALLBACKP(val)) ((void**)dst)[0] = ((ffi_callback_struct*)val)->callback; else if (SCHEME_CPTRP(val)) @@ -1385,6 +1383,7 @@ static void* scheme_to_c(Scheme_Object *type, void *dst, } return NULL; /* shush the compiler */ } +#undef SET_CTYPE /*****************************************************************************/ /* C type information */ @@ -1666,11 +1665,7 @@ static Scheme_Object *foreign_ptr_ref(int argc, Scheme_Object *argv[]) scheme_wrong_type(MYNAME, "integer", 2, argc, argv); ptr = (char*)ptr XFORM_OK_PLUS (size * SCHEME_INT_VAL(argv[2])); } -#ifdef SCHEME_BIG_ENDIAN - return c_to_scheme(argv[1], ptr, 0); -#else - return c_to_scheme(argv[1], ptr); -#endif + return C2SCHEME(argv[1], ptr, 0); } /* (ptr-set! cpointer type [['abs] n] value) -> void */ @@ -1909,11 +1904,7 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) } break; } -#ifdef SCHEME_BIG_ENDIAN - return c_to_scheme(otype, p, 1); -#else - return c_to_scheme(otype, p); -#endif + return C2SCHEME(otype, p, 1); } /* see below */ @@ -2002,11 +1993,7 @@ void ffi_do_callback(ffi_cif* cif, void* resultp, void** args, void *userdata) else argv = scheme_malloc(argc * sizeof(Scheme_Object*)); for (i=0, p=data->itypes; iproc, argc, argv); diff --git a/src/foreign/foreign.ssc b/src/foreign/foreign.ssc index e3c28ab183..386a659e00 100755 --- a/src/foreign/foreign.ssc +++ b/src/foreign/foreign.ssc @@ -894,36 +894,33 @@ void free_libffi_type(void *ignored, void *p) /*****************************************************************************/ /* Scheme<-->C conversions */ -static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src /* On big endian machines we need to know whether we're pulling a value from an * argument location where it always takes a whole word or straight from a - * memory location */ + * memory location -- deal with it via a C2SCHEME macro wrapper that is used + * for both the function definition and calls */ #ifdef SCHEME_BIG_ENDIAN - , int args_loc -#endif - ) -#ifdef SCHEME_BIG_ENDIAN -#define REF_CTYPE(ctype) ((sizeof(ctype)Scheme", "C-type", 0, 1, &type); base = CTYPE_BASETYPE(type); if (base != NULL) { -#ifdef SCHEME_BIG_ENDIAN - res = c_to_scheme(base, src, args_loc); -#else - res = c_to_scheme(base, src); -#endif + res = C2SCHEME(base, src, args_loc); if (SCHEME_FALSEP(CTYPE_USER_C2S(type))) return res; else return _scheme_apply(CTYPE_USER_C2S(type), 1, (Scheme_Object**)(&res)); } else if (CTYPE_PRIMLABEL(type) == FOREIGN_fpointer) { + /* No need for the REF_CTYPE trick for pointers */ return (Scheme_Object*)src; } else switch (CTYPE_PRIMLABEL(type)) { {:(for-each-type @@ -954,6 +951,7 @@ static void* scheme_to_c(Scheme_Object *type, void *dst, type = CTYPE_BASETYPE(type); } if (CTYPE_PRIMLABEL(type) == FOREIGN_fpointer) { + /* No need for the SET_CTYPE trick for pointers */ if (SCHEME_FFICALLBACKP(val)) ((void**)dst)[0] = ((ffi_callback_struct*)val)->callback; else if (SCHEME_CPTRP(val)) @@ -1008,6 +1006,7 @@ static void* scheme_to_c(Scheme_Object *type, void *dst, } return NULL; /* shush the compiler */ } +#undef SET_CTYPE /*****************************************************************************/ /* C type information */ @@ -1269,11 +1268,7 @@ static void* scheme_to_c(Scheme_Object *type, void *dst, scheme_wrong_type(MYNAME, "integer", 2, argc, argv); ptr = (char*)ptr XFORM_OK_PLUS (size * SCHEME_INT_VAL(argv[2])); } -#ifdef SCHEME_BIG_ENDIAN - return c_to_scheme(argv[1], ptr, 0); -#else - return c_to_scheme(argv[1], ptr); -#endif + return C2SCHEME(argv[1], ptr, 0); } /* (ptr-set! cpointer type [['abs] n] value) -> void */ @@ -1508,11 +1503,7 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[]) } break; } -#ifdef SCHEME_BIG_ENDIAN - return c_to_scheme(otype, p, 1); -#else - return c_to_scheme(otype, p); -#endif + return C2SCHEME(otype, p, 1); } /* see below */ @@ -1599,11 +1590,7 @@ void ffi_do_callback(ffi_cif* cif, void* resultp, void** args, void *userdata) else argv = scheme_malloc(argc * sizeof(Scheme_Object*)); for (i=0, p=data->itypes; iproc, argc, argv);