diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-05-08 17:21:59 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-05-08 17:24:24 +0200 |
commit | 012062a0d61cbd297dd58c8168433518c8b450cc (patch) | |
tree | fca9076c455e3d200b0e17f4bc365b79f15c832e | |
parent | d7fcaec39247b014f3d6aa2ca96a5ff903bc6706 (diff) | |
download | guile-012062a0d61cbd297dd58c8168433518c8b450cc.tar.gz |
Fix small integer return value packing on big endian machines.
* libguile/foreign.c (pack): Add `return_value_p' parameter. Update
callers.
When RETURN_VALUE_P is true, assume LOC points to an `ffi_arg', and
cast its results to the relevant type. This fixes packing of integer
return values smaller than `int' on SPARC64 and PowerPC64. Reported
by Nelson H. F. Beebe <beebe@math.utah.edu>.
-rw-r--r-- | libguile/foreign.c | 49 |
1 files changed, 39 insertions, 10 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index ae9e27a8d..68e0efab5 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -965,9 +965,12 @@ unpack (const ffi_type *type, void *loc, SCM x) } #undef FUNC_NAME -/* Return a Scheme representation of the foreign value at LOC of type TYPE. */ +/* Return a Scheme representation of the foreign value at LOC of type + TYPE. When RETURN_VALUE_P is true, LOC is assumed to point to a + return value buffer; otherwise LOC is assumed to point to an + argument buffer. */ static SCM -pack (const ffi_type * type, const void *loc) +pack (const ffi_type * type, const void *loc, int return_value_p) { switch (type->type) { @@ -977,22 +980,48 @@ pack (const ffi_type * type, const void *loc) return scm_from_double (*(float *) loc); case FFI_TYPE_DOUBLE: return scm_from_double (*(double *) loc); + + /* For integer return values smaller than `int', libffi stores the + result in an `ffi_arg'-long buffer, of which only the + significant bits must be kept---hence the pair of casts below. + See <http://thread.gmane.org/gmane.comp.lib.ffi.general/406> + for details. */ + case FFI_TYPE_UINT8: - return scm_from_uint8 (*(scm_t_uint8 *) loc); + if (return_value_p) + return scm_from_uint8 ((scm_t_uint8) *(ffi_arg *) loc); + else + return scm_from_uint8 (* (scm_t_uint8 *) loc); case FFI_TYPE_SINT8: - return scm_from_int8 (*(scm_t_int8 *) loc); + if (return_value_p) + return scm_from_int8 ((scm_t_int8) *(ffi_arg *) loc); + else + return scm_from_int8 (* (scm_t_int8 *) loc); case FFI_TYPE_UINT16: - return scm_from_uint16 (*(scm_t_uint16 *) loc); + if (return_value_p) + return scm_from_uint16 ((scm_t_uint16) *(ffi_arg *) loc); + else + return scm_from_uint16 (* (scm_t_uint16 *) loc); case FFI_TYPE_SINT16: - return scm_from_int16 (*(scm_t_int16 *) loc); + if (return_value_p) + return scm_from_int16 ((scm_t_int16) *(ffi_arg *) loc); + else + return scm_from_int16 (* (scm_t_int16 *) loc); case FFI_TYPE_UINT32: - return scm_from_uint32 (*(scm_t_uint32 *) loc); + if (return_value_p) + return scm_from_uint32 ((scm_t_uint32) *(ffi_arg *) loc); + else + return scm_from_uint32 (* (scm_t_uint32 *) loc); case FFI_TYPE_SINT32: - return scm_from_int32 (*(scm_t_int32 *) loc); + if (return_value_p) + return scm_from_int32 ((scm_t_int32) *(ffi_arg *) loc); + else + return scm_from_int32 (* (scm_t_int32 *) loc); case FFI_TYPE_UINT64: return scm_from_uint64 (*(scm_t_uint64 *) loc); case FFI_TYPE_SINT64: return scm_from_int64 (*(scm_t_int64 *) loc); + case FFI_TYPE_STRUCT: { void *mem = scm_gc_malloc_pointerless (type->size, "foreign"); @@ -1060,7 +1089,7 @@ scm_i_foreign_call (SCM foreign, const SCM *argv) /* off we go! */ ffi_call (cif, func, rvalue, args); - return pack (cif->rtype, rvalue); + return pack (cif->rtype, rvalue, 1); } @@ -1082,7 +1111,7 @@ invoke_closure (ffi_cif *cif, void *ret, void **args, void *data) /* Pack ARGS to SCM values, setting ARGV pointers. */ for (i = 0; i < cif->nargs; i++) - argv[i] = pack (cif->arg_types[i], args[i]); + argv[i] = pack (cif->arg_types[i], args[i], 0); result = scm_call_n (proc, argv, cif->nargs); |