better macrology for c_to_scheme
svn: r3682
This commit is contained in:
Eli Barzilay
parent
e0a2943e5b
commit
f63abcc9de
|
|
@ -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)<sizeof(int)) && args_loc \
|
||||
#define C2SCHEME(typ,src,argsloc) c_to_scheme(typ,src,argsloc)
|
||||
#define REF_CTYPE(ctype) (((sizeof(ctype)<sizeof(int)) && args_loc) \
|
||||
? ((ctype)(((int*)src)[0])) : (((ctype *)src)[0]))
|
||||
#else
|
||||
#define C2SCHEME(typ,src,argsloc) c_to_scheme(typ,src)
|
||||
#define REF_CTYPE(ctype) (((ctype *)src)[0])
|
||||
#endif
|
||||
|
||||
static Scheme_Object *C2SCHEME(Scheme_Object *type, void *src, int args_loc)
|
||||
{
|
||||
Scheme_Object *res, *base;
|
||||
if (!SCHEME_CTYPEP(type))
|
||||
scheme_wrong_type("C->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; i<argc; i++, p=SCHEME_CDR(p)) {
|
||||
#ifdef SCHEME_BIG_ENDIAN
|
||||
v = c_to_scheme(SCHEME_CAR(p),args[i],1);
|
||||
#else
|
||||
v = c_to_scheme(SCHEME_CAR(p),args[i]);
|
||||
#endif
|
||||
v = C2SCHEME(SCHEME_CAR(p), args[i], 1);
|
||||
argv[i] = v;
|
||||
}
|
||||
p = _scheme_apply(data->proc, argc, argv);
|
||||
|
|
|
|||
|
|
@ -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)<sizeof(int)) && args_loc \
|
||||
#define C2SCHEME(typ,src,argsloc) c_to_scheme(typ,src,argsloc)
|
||||
#define REF_CTYPE(ctype) (((sizeof(ctype)<sizeof(int)) && args_loc) \
|
||||
? ((ctype)(((int*)src)[0])) : (((ctype *)src)[0]))
|
||||
#else
|
||||
#define C2SCHEME(typ,src,argsloc) c_to_scheme(typ,src)
|
||||
#define REF_CTYPE(ctype) (((ctype *)src)[0])
|
||||
#endif
|
||||
|
||||
static Scheme_Object *C2SCHEME(Scheme_Object *type, void *src, int args_loc)
|
||||
{
|
||||
Scheme_Object *res, *base;
|
||||
if (!SCHEME_CTYPEP(type))
|
||||
scheme_wrong_type("C->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; i<argc; i++, p=SCHEME_CDR(p)) {
|
||||
#ifdef SCHEME_BIG_ENDIAN
|
||||
v = c_to_scheme(SCHEME_CAR(p),args[i],1);
|
||||
#else
|
||||
v = c_to_scheme(SCHEME_CAR(p),args[i]);
|
||||
#endif
|
||||
v = C2SCHEME(SCHEME_CAR(p), args[i], 1);
|
||||
argv[i] = v;
|
||||
}
|
||||
p = _scheme_apply(data->proc, argc, argv);
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user