* Undo big endian check in configure since it was already in mzscheme;
* Make foreign use special handling for big endians depending on accessing a location directly or accessing an argument. svn: r623
This commit is contained in:
Eli Barzilay
parent
febd5f8fff
commit
268ed5df20
232
src/configure
vendored
232
src/configure
vendored
|
|
@ -1525,7 +1525,7 @@ fi
|
|||
|
||||
OS=`$UNAME -s`
|
||||
|
||||
###### Get data sizes & endian #######
|
||||
###### Get data sizes #######
|
||||
|
||||
ac_ext=c
|
||||
ac_cpp='$CPP $CPPFLAGS'
|
||||
|
|
@ -5016,236 +5016,6 @@ cat >>confdefs.h <<_ACEOF
|
|||
_ACEOF
|
||||
|
||||
|
||||
echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5
|
||||
echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6
|
||||
if test "${ac_cv_c_bigendian+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
# See if sys/param.h defines the BYTE_ORDER macro.
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
#include <sys/types.h>
|
||||
#include <sys/param.h>
|
||||
|
||||
int
|
||||
main ()
|
||||
{
|
||||
#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
|
||||
bogus endian macros
|
||||
#endif
|
||||
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
|
||||
(eval $ac_compile) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag"
|
||||
|| test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest.$ac_objext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
# It does; now see whether it defined to BIG_ENDIAN or not.
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
#include <sys/types.h>
|
||||
#include <sys/param.h>
|
||||
|
||||
int
|
||||
main ()
|
||||
{
|
||||
#if BYTE_ORDER != BIG_ENDIAN
|
||||
not big endian
|
||||
#endif
|
||||
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
|
||||
(eval $ac_compile) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag"
|
||||
|| test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest.$ac_objext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
ac_cv_c_bigendian=yes
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
ac_cv_c_bigendian=no
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
# It does not; compile a test program.
|
||||
if test "$cross_compiling" = yes; then
|
||||
# try to guess the endianness by grepping values into an object file
|
||||
ac_cv_c_bigendian=unknown
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
|
||||
short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
|
||||
void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; }
|
||||
short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
|
||||
short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
|
||||
void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; }
|
||||
int
|
||||
main ()
|
||||
{
|
||||
_ascii (); _ebcdic ();
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
|
||||
(eval $ac_compile) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag"
|
||||
|| test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest.$ac_objext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then
|
||||
ac_cv_c_bigendian=yes
|
||||
fi
|
||||
if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
|
||||
if test "$ac_cv_c_bigendian" = unknown; then
|
||||
ac_cv_c_bigendian=no
|
||||
else
|
||||
# finding both strings is unlikely to happen, but who knows?
|
||||
ac_cv_c_bigendian=unknown
|
||||
fi
|
||||
fi
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
int
|
||||
main ()
|
||||
{
|
||||
/* Are we little or big endian? From Harbison&Steele. */
|
||||
union
|
||||
{
|
||||
long l;
|
||||
char c[sizeof (long)];
|
||||
} u;
|
||||
u.l = 1;
|
||||
exit (u.c[sizeof (long) - 1] == 1);
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
ac_cv_c_bigendian=no
|
||||
else
|
||||
echo "$as_me: program exited with status $ac_status" >&5
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
( exit $ac_status )
|
||||
ac_cv_c_bigendian=yes
|
||||
fi
|
||||
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
|
||||
fi
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5
|
||||
echo "${ECHO_T}$ac_cv_c_bigendian" >&6
|
||||
case $ac_cv_c_bigendian in
|
||||
yes)
|
||||
|
||||
cat >>confdefs.h <<\_ACEOF
|
||||
#define WORDS_BIGENDIAN 1
|
||||
_ACEOF
|
||||
;;
|
||||
no)
|
||||
;;
|
||||
*)
|
||||
{ { echo "$as_me:$LINENO: error: unknown endianness
|
||||
presetting ac_cv_c_bigendian=no (or yes) will help" >&5
|
||||
echo "$as_me: error: unknown endianness
|
||||
presetting ac_cv_c_bigendian=no (or yes) will help" >&2;}
|
||||
{ (exit 1); exit 1; }; } ;;
|
||||
esac
|
||||
|
||||
|
||||
###### Some flags imply other flags #######
|
||||
|
||||
|
|
|
|||
|
|
@ -963,14 +963,31 @@ END_XFORM_SKIP;
|
|||
/*****************************************************************************/
|
||||
/* Scheme<-->C conversions */
|
||||
|
||||
static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src)
|
||||
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 */
|
||||
#ifdef SCHEME_BIG_ENDIAN
|
||||
, int args_loc
|
||||
#endif
|
||||
)
|
||||
#ifdef SCHEME_BIG_ENDIAN
|
||||
#define REF_CTYPE(ctype) ((sizeof(ctype)<sizeof(int)) && args_loc \
|
||||
? ((ctype)(((int*)src)[0])) : (((ctype *)src)[0]))
|
||||
#else
|
||||
#define REF_CTYPE(ctype) (((ctype *)src)[0])
|
||||
#endif
|
||||
{
|
||||
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
|
||||
if (SCHEME_FALSEP(CTYPE_USER_C2S(type)))
|
||||
return res;
|
||||
else
|
||||
|
|
@ -979,35 +996,36 @@ static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src)
|
|||
return (Scheme_Object*)src;
|
||||
} else switch (CTYPE_PRIMLABEL(type)) {
|
||||
case FOREIGN_void: return scheme_void;
|
||||
case FOREIGN_int8: return scheme_make_integer(((sizeof(Tsint8)<sizeof(int)) ? ((Tsint8)(((int*)src)[0])) : (((Tsint8*)src)[0])));
|
||||
case FOREIGN_uint8: return scheme_make_integer_from_unsigned(((sizeof(Tuint8)<sizeof(int)) ? ((Tuint8)(((int*)src)[0])) : (((Tuint8*)src)[0])));
|
||||
case FOREIGN_int16: return scheme_make_integer(((sizeof(Tsint16)<sizeof(int)) ? ((Tsint16)(((int*)src)[0])) : (((Tsint16*)src)[0])));
|
||||
case FOREIGN_uint16: return scheme_make_integer_from_unsigned(((sizeof(Tuint16)<sizeof(int)) ? ((Tuint16)(((int*)src)[0])) : (((Tuint16*)src)[0])));
|
||||
case FOREIGN_int32: return scheme_make_realinteger_value(((sizeof(Tsint32)<sizeof(int)) ? ((Tsint32)(((int*)src)[0])) : (((Tsint32*)src)[0])));
|
||||
case FOREIGN_uint32: return scheme_make_realinteger_value_from_unsigned(((sizeof(Tuint32)<sizeof(int)) ? ((Tuint32)(((int*)src)[0])) : (((Tuint32*)src)[0])));
|
||||
case FOREIGN_int64: return scheme_make_integer_value_from_long_long(((sizeof(Tsint64)<sizeof(int)) ? ((Tsint64)(((int*)src)[0])) : (((Tsint64*)src)[0])));
|
||||
case FOREIGN_uint64: return scheme_make_integer_value_from_unsigned_long_long(((sizeof(Tuint64)<sizeof(int)) ? ((Tuint64)(((int*)src)[0])) : (((Tuint64*)src)[0])));
|
||||
case FOREIGN_fixint: return scheme_make_integer(((sizeof(Tsint32)<sizeof(int)) ? ((Tsint32)(((int*)src)[0])) : (((Tsint32*)src)[0])));
|
||||
case FOREIGN_ufixint: return scheme_make_integer_from_unsigned(((sizeof(Tuint32)<sizeof(int)) ? ((Tuint32)(((int*)src)[0])) : (((Tuint32*)src)[0])));
|
||||
case FOREIGN_fixnum: return scheme_make_integer(((sizeof(long)<sizeof(int)) ? ((long)(((int*)src)[0])) : (((long*)src)[0])));
|
||||
case FOREIGN_ufixnum: return scheme_make_integer_from_unsigned(((sizeof(unsigned long)<sizeof(int)) ? ((unsigned long)(((int*)src)[0])) : (((unsigned long*)src)[0])));
|
||||
case FOREIGN_float: return scheme_make_float(((sizeof(float)<sizeof(int)) ? ((float)(((int*)src)[0])) : (((float*)src)[0])));
|
||||
case FOREIGN_double: return scheme_make_double(((sizeof(double)<sizeof(int)) ? ((double)(((int*)src)[0])) : (((double*)src)[0])));
|
||||
case FOREIGN_doubleS: return scheme_make_double(((sizeof(double)<sizeof(int)) ? ((double)(((int*)src)[0])) : (((double*)src)[0])));
|
||||
case FOREIGN_bool: return (((sizeof(int)<sizeof(int)) ? ((int)(((int*)src)[0])) : (((int*)src)[0]))?scheme_true:scheme_false);
|
||||
case FOREIGN_string_ucs_4: return scheme_make_char_string_without_copying(((sizeof(mzchar*)<sizeof(int)) ? ((mzchar*)(((int*)src)[0])) : (((mzchar**)src)[0])));
|
||||
case FOREIGN_string_utf_16: return utf16_pointer_to_ucs4_string(((sizeof(unsigned short*)<sizeof(int)) ? ((unsigned short*)(((int*)src)[0])) : (((unsigned short**)src)[0])));
|
||||
case FOREIGN_bytes: return (((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0]))==NULL)?scheme_false:scheme_make_byte_string_without_copying(((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0])));
|
||||
case FOREIGN_path: return (((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0]))==NULL)?scheme_false:scheme_make_path_without_copying(((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0])));
|
||||
case FOREIGN_symbol: return scheme_intern_symbol(((sizeof(char*)<sizeof(int)) ? ((char*)(((int*)src)[0])) : (((char**)src)[0])));
|
||||
case FOREIGN_pointer: return scheme_make_foreign_cpointer(((sizeof(void*)<sizeof(int)) ? ((void*)(((int*)src)[0])) : (((void**)src)[0])));
|
||||
case FOREIGN_scheme: return ((sizeof(Scheme_Object*)<sizeof(int)) ? ((Scheme_Object*)(((int*)src)[0])) : (((Scheme_Object**)src)[0]));
|
||||
case FOREIGN_int8: return scheme_make_integer(REF_CTYPE(Tsint8));
|
||||
case FOREIGN_uint8: return scheme_make_integer_from_unsigned(REF_CTYPE(Tuint8));
|
||||
case FOREIGN_int16: return scheme_make_integer(REF_CTYPE(Tsint16));
|
||||
case FOREIGN_uint16: return scheme_make_integer_from_unsigned(REF_CTYPE(Tuint16));
|
||||
case FOREIGN_int32: return scheme_make_realinteger_value(REF_CTYPE(Tsint32));
|
||||
case FOREIGN_uint32: return scheme_make_realinteger_value_from_unsigned(REF_CTYPE(Tuint32));
|
||||
case FOREIGN_int64: return scheme_make_integer_value_from_long_long(REF_CTYPE(Tsint64));
|
||||
case FOREIGN_uint64: return scheme_make_integer_value_from_unsigned_long_long(REF_CTYPE(Tuint64));
|
||||
case FOREIGN_fixint: return scheme_make_integer(REF_CTYPE(Tsint32));
|
||||
case FOREIGN_ufixint: return scheme_make_integer_from_unsigned(REF_CTYPE(Tuint32));
|
||||
case FOREIGN_fixnum: return scheme_make_integer(REF_CTYPE(long));
|
||||
case FOREIGN_ufixnum: return scheme_make_integer_from_unsigned(REF_CTYPE(unsigned long));
|
||||
case FOREIGN_float: return scheme_make_float(REF_CTYPE(float));
|
||||
case FOREIGN_double: return scheme_make_double(REF_CTYPE(double));
|
||||
case FOREIGN_doubleS: return scheme_make_double(REF_CTYPE(double));
|
||||
case FOREIGN_bool: return (REF_CTYPE(int)?scheme_true:scheme_false);
|
||||
case FOREIGN_string_ucs_4: return scheme_make_char_string_without_copying(REF_CTYPE(mzchar*));
|
||||
case FOREIGN_string_utf_16: return utf16_pointer_to_ucs4_string(REF_CTYPE(unsigned short*));
|
||||
case FOREIGN_bytes: return (REF_CTYPE(char*)==NULL)?scheme_false:scheme_make_byte_string_without_copying(REF_CTYPE(char*));
|
||||
case FOREIGN_path: return (REF_CTYPE(char*)==NULL)?scheme_false:scheme_make_path_without_copying(REF_CTYPE(char*));
|
||||
case FOREIGN_symbol: return scheme_intern_symbol(REF_CTYPE(char*));
|
||||
case FOREIGN_pointer: return scheme_make_foreign_cpointer(REF_CTYPE(void*));
|
||||
case FOREIGN_scheme: return REF_CTYPE(Scheme_Object*);
|
||||
case FOREIGN_fpointer: return scheme_void;
|
||||
case FOREIGN_struct: return scheme_make_foreign_cpointer(src);
|
||||
default: scheme_signal_error("corrupt foreign type: %V", type);
|
||||
}
|
||||
return NULL; /* shush the compiler */
|
||||
}
|
||||
#undef REF_CTYPE
|
||||
|
||||
/* Usually writes the C object to dst and returns NULL. When basetype_p is not
|
||||
* NULL, then any pointer value (any pointer or a struct) is returned, and the
|
||||
|
|
@ -1545,7 +1563,11 @@ 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
|
||||
}
|
||||
|
||||
/* (ptr-set! cpointer type [['abs] n] value) -> void */
|
||||
|
|
@ -1784,7 +1806,11 @@ 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
|
||||
}
|
||||
|
||||
/* see below */
|
||||
|
|
@ -1873,7 +1899,11 @@ 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
|
||||
argv[i] = v;
|
||||
}
|
||||
p = _scheme_apply(data->proc, argc, argv);
|
||||
|
|
|
|||
|
|
@ -791,14 +791,31 @@ void free_libffi_type(void *ignored, void *p)
|
|||
/*****************************************************************************/
|
||||
/* Scheme<-->C conversions */
|
||||
|
||||
static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src)
|
||||
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 */
|
||||
#ifdef SCHEME_BIG_ENDIAN
|
||||
, int args_loc
|
||||
#endif
|
||||
)
|
||||
#ifdef SCHEME_BIG_ENDIAN
|
||||
#define REF_CTYPE(ctype) ((sizeof(ctype)<sizeof(int)) && args_loc \
|
||||
? ((ctype)(((int*)src)[0])) : (((ctype *)src)[0]))
|
||||
#else
|
||||
#define REF_CTYPE(ctype) (((ctype *)src)[0])
|
||||
#endif
|
||||
{
|
||||
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
|
||||
if (SCHEME_FALSEP(CTYPE_USER_C2S(type)))
|
||||
return res;
|
||||
else
|
||||
|
|
@ -809,12 +826,7 @@ static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src)
|
|||
{:(for-each-type
|
||||
(~ "case FOREIGN_"cname": return "
|
||||
(if ctype
|
||||
(let ([x (list
|
||||
;; will cause a bug in big-endians with int8 & int16
|
||||
;; "(("ctype"*)src)[0]"
|
||||
"((sizeof("ctype")<sizeof(int))"
|
||||
" ? (("ctype")(((int*)src)[0]))"
|
||||
" : ((("ctype"*)src)[0]))")])
|
||||
(let ([x (list "REF_CTYPE("ctype")")])
|
||||
(if (procedure? c->s) (c->s x) (list c->s"("x")")))
|
||||
"scheme_void")";")):}
|
||||
case FOREIGN_struct: return scheme_make_foreign_cpointer(src);
|
||||
|
|
@ -822,6 +834,7 @@ static Scheme_Object *c_to_scheme(Scheme_Object *type, void *src)
|
|||
}
|
||||
return NULL; /* shush the compiler */
|
||||
}
|
||||
#undef REF_CTYPE
|
||||
|
||||
/* Usually writes the C object to dst and returns NULL. When basetype_p is not
|
||||
* NULL, then any pointer value (any pointer or a struct) is returned, and the
|
||||
|
|
@ -1153,7 +1166,11 @@ 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
|
||||
}
|
||||
|
||||
/* (ptr-set! cpointer type [['abs] n] value) -> void */
|
||||
|
|
@ -1388,7 +1405,11 @@ 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
|
||||
}
|
||||
|
||||
/* see below */
|
||||
|
|
@ -1475,7 +1496,11 @@ 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
|
||||
argv[i] = v;
|
||||
}
|
||||
p = _scheme_apply(data->proc, argc, argv);
|
||||
|
|
|
|||
|
|
@ -79,14 +79,13 @@ fi
|
|||
|
||||
OS=`$UNAME -s`
|
||||
|
||||
###### Get data sizes & endian #######
|
||||
###### Get data sizes #######
|
||||
|
||||
AC_CHECK_SIZEOF(char)
|
||||
AC_CHECK_SIZEOF(short)
|
||||
AC_CHECK_SIZEOF(int)
|
||||
AC_CHECK_SIZEOF(long)
|
||||
AC_CHECK_SIZEOF(long long)
|
||||
AC_C_BIGENDIAN()
|
||||
|
||||
###### Some flags imply other flags #######
|
||||
|
||||
|
|
|
|||
|
|
@ -16,6 +16,3 @@
|
|||
|
||||
/* The size of a `long long', as computed by sizeof. */
|
||||
#undef SIZEOF_LONG_LONG
|
||||
|
||||
/* Is this a big endian machine? */
|
||||
#undef WORDS_BIGENDIAN
|
||||
|
|
|
|||
|
|
@ -20,6 +20,3 @@
|
|||
|
||||
/* The size of a `long long', as computed by sizeof. */
|
||||
#undef SIZEOF_LONG_LONG
|
||||
|
||||
/* Is this a big endian machine? */
|
||||
#undef WORDS_BIGENDIAN
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user