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

adjust _float' and _double' FFI types to accept any inexact real

Browse Source 
whether single-precision or double-precision
This commit is contained in:
Matthew Flatt 2011-01-31 17:58:35 -07:00
parent f9bcdc9baf
commit 1e09a544a6
3 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/racket/foreign-test.rktl
View File

@ -374,7 +374,9 @@ added.
(foo-test "foo_byte" '(156) (_fun _byte -> _byte))
(foo-test "foo_ubyte" '(156) (_fun _ubyte -> _ubyte))
(foo-test "foo_double" '(81.0) (_fun _double -> _double))
(foo-test "foo_double" '(81.0f0) (_fun _double -> _double))
(foo-test "foo_float" '(81.0) (_fun _float -> _float))
(foo-test "foo_float" '(81.0f0) (_fun _float -> _float))
(exit) ;=======================================================================
(newline)

16
src/foreign/foreign.c
View File

@ -674,8 +674,8 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* Type Name: float
* LibFfi type: ffi_type_float
* C type: float
* Predicate: SCHEME_FLTP(<Scheme>)
* Scheme->C: SCHEME_FLT_VAL(<Scheme>)
* Predicate: SCHEME_FLOATP(<Scheme>)
* Scheme->C: SCHEME_FLOAT_VAL(<Scheme>)
* S->C offset: 0
* C->Scheme: scheme_make_float(<C>)
*/
@ -684,8 +684,8 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* Type Name: double
* LibFfi type: ffi_type_double
* C type: double
* Predicate: SCHEME_DBLP(<Scheme>)
* Scheme->C: SCHEME_DBL_VAL(<Scheme>)
* Predicate: SCHEME_FLOATP(<Scheme>)
* Scheme->C: SCHEME_FLOAT_VAL(<Scheme>)
* S->C offset: 0
* C->Scheme: scheme_make_double(<C>)
*/
@ -1507,9 +1507,9 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
delta += (sizeof(int)-sizeof(float));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_FLTP(val)) {
if (SCHEME_FLOATP(val)) {
float tmp;
tmp = (float)(SCHEME_FLT_VAL(val));
tmp = (float)(SCHEME_FLOAT_VAL(val));
(((float*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","float",0,1,&(val));
@ -1522,9 +1522,9 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
delta += (sizeof(int)-sizeof(double));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_DBLP(val)) {
if (SCHEME_FLOATP(val)) {
double tmp;
tmp = (double)(SCHEME_DBL_VAL(val));
tmp = (double)(SCHEME_FLOAT_VAL(val));
(((double*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","double",0,1,&(val));

4
src/foreign/foreign.rktc
View File

@ -640,9 +640,9 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
@(defctype* '(ufixnum "umzintptr")
"uintptr_t" "INT" "UINT" "integer_from_unsigned")
@(defctype* 'float "float" "FLT" "FLT" "float")
@(defctype* 'float "float" "FLOAT" "FLOAT" "float")
@(defctype* 'double "double" "DBL" "DBL" "double")
@(defctype* 'double "double" "FLOAT" "FLOAT" "double")
@;
@; Not useful? not implemented in any case.
@; (defctype* 'longdouble "long double" ...???...)