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

restore old behavior of _fixint' and _ufixint'

Browse Source 
Closes PR 11492
This commit is contained in:
Matthew Flatt 2010-12-03 14:15:21 -07:00
parent 7ec0731cda
commit 116d88577e
4 changed files with 52 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scribblings/foreign/types.scrbl
View File

@ -131,8 +131,10 @@ quantities fit in Racket's immediate integers (i.e., not bignums).}
@defthing*[([_fixint ctype?]
[_ufixint ctype?])]{
Like @scheme[_fixnum] and @scheme[_ufixnum], but coercions from C are
checked to be in range.}
Similar to @scheme[_fixnum]/@scheme[_ufixnum], but based on
@racket[_int]/@racket[_uint] instead of
@racket[_intptr]/@racket[_uintptr], and coercions from C are checked
to be in range.}
@defthing*[([_float ctype?]
[_double ctype?]

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

@ -70,6 +70,8 @@
(t 2 'add1_byte_int (_fun _byte -> _int ) 1)
(t 2 'add1_int_byte (_fun _int -> _byte) 1)
(t 2 'add1_byte_byte (_fun _byte -> _byte) 1)
(t -1 'add1_int_int (_fun _int -> _int ) -2)
(t -1 'add1_int_int (_fun _int -> _fixint ) -2)
;; ---
(t 12 'decimal_int_int_int (_fun _int _int -> _int ) 1 2)
(t 12 'decimal_byte_int_int (_fun _byte _int -> _int ) 1 2)

80
src/foreign/foreign.c
View File

@ -612,6 +612,28 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
* C->Scheme: scheme_make_integer_value_from_unsigned_long_long(<C>)
*/
/* This is like int32, but always assumes fixnum: */
#define FOREIGN_fixint (10)
/* Type Name: fixint
* LibFfi type: ffi_type_sint32
* C type: Tsint32
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_INT_VAL(<Scheme>)
* S->C offset: 0
* C->Scheme: scheme_make_integer(<C>)
*/
/* This is like uint32, but always assumes fixnum: */
#define FOREIGN_ufixint (11)
/* Type Name: ufixint
* LibFfi type: ffi_type_uint32
* C type: Tuint32
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_UINT_VAL(<Scheme>)
* S->C offset: 0
* C->Scheme: scheme_make_integer_from_unsigned(<C>)
*/
#ifndef SIXTY_FOUR_BIT_LONGS
#define ffi_type_smzlong ffi_type_sint32
#define ffi_type_umzlong ffi_type_uint32
@ -628,28 +650,6 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
#define ffi_type_umzintptr ffi_type_uint64
#endif /* SIXTY_FOUR_BIT_INTEGERS */
/* This is like intptr, but always assumes fixnum: */
#define FOREIGN_fixint (10)
/* Type Name: fixint
* LibFfi type: ffi_type_smzintptr
* C type: intptr_t
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_INT_VAL(<Scheme>)
* S->C offset: 0
* C->Scheme: scheme_make_integer(<C>)
*/
/* This is like uint32, but always assumes fixnum: */
#define FOREIGN_ufixint (11)
/* Type Name: ufixint
* LibFfi type: ffi_type_umzintptr
* C type: uintptr_t
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_UINT_VAL(<Scheme>)
* S->C offset: 0
* C->Scheme: scheme_make_integer_from_unsigned(<C>)
*/
/* This is what mzscheme defines as intptr, assuming fixnums: */
#define FOREIGN_fixnum (12)
/* Type Name: fixnum
@ -828,8 +828,8 @@ typedef union _ForeignAny {
Tuint32 x_uint32;
Tsint64 x_int64;
Tuint64 x_uint64;
intptr_t x_fixint;
uintptr_t x_ufixint;
Tsint32 x_fixint;
Tuint32 x_ufixint;
intptr_t x_fixnum;
uintptr_t x_ufixnum;
float x_float;
@ -970,8 +970,8 @@ static int ctype_sizeof(Scheme_Object *type)
case FOREIGN_uint32: return sizeof(Tuint32);
case FOREIGN_int64: return sizeof(Tsint64);
case FOREIGN_uint64: return sizeof(Tuint64);
case FOREIGN_fixint: return sizeof(intptr_t);
case FOREIGN_ufixint: return sizeof(uintptr_t);
case FOREIGN_fixint: return sizeof(Tsint32);
case FOREIGN_ufixint: return sizeof(Tuint32);
case FOREIGN_fixnum: return sizeof(intptr_t);
case FOREIGN_ufixnum: return sizeof(uintptr_t);
case FOREIGN_float: return sizeof(float);
@ -1306,8 +1306,8 @@ static Scheme_Object *C2SCHEME(Scheme_Object *type, void *src,
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(intptr_t));
case FOREIGN_ufixint: return scheme_make_integer_from_unsigned(REF_CTYPE(uintptr_t));
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(intptr_t));
case FOREIGN_ufixnum: return scheme_make_integer_from_unsigned(REF_CTYPE(uintptr_t));
case FOREIGN_float: return scheme_make_float(REF_CTYPE(float));
@ -1446,30 +1446,30 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
return NULL;
case FOREIGN_fixint:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(intptr_t)<sizeof(int) && ret_loc) {
if (sizeof(Tsint32)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(intptr_t));
delta += (sizeof(int)-sizeof(Tsint32));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_INTP(val)) {
intptr_t tmp;
tmp = (intptr_t)(SCHEME_INT_VAL(val));
(((intptr_t*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
Tsint32 tmp;
tmp = (Tsint32)(SCHEME_INT_VAL(val));
(((Tsint32*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","fixint",0,1,&(val));
return NULL; /* hush the compiler */
}
case FOREIGN_ufixint:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(uintptr_t)<sizeof(int) && ret_loc) {
if (sizeof(Tuint32)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(uintptr_t));
delta += (sizeof(int)-sizeof(Tuint32));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_INTP(val)) {
uintptr_t tmp;
tmp = (uintptr_t)(SCHEME_UINT_VAL(val));
(((uintptr_t*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
Tuint32 tmp;
tmp = (Tuint32)(SCHEME_UINT_VAL(val));
(((Tuint32*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","ufixint",0,1,&(val));
return NULL; /* hush the compiler */
@ -3344,14 +3344,14 @@ void scheme_init_foreign(Scheme_Env *env)
t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
t->so.type = ctype_tag;
t->basetype = (s);
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_smzintptr));
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_sint32));
t->c_to_scheme = ((Scheme_Object*)FOREIGN_fixint);
scheme_add_global("_fixint", (Scheme_Object*)t, menv);
s = scheme_intern_symbol("ufixint");
t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct));
t->so.type = ctype_tag;
t->basetype = (s);
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_umzintptr));
t->scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_uint32));
t->c_to_scheme = ((Scheme_Object*)FOREIGN_ufixint);
scheme_add_global("_ufixint", (Scheme_Object*)t, menv);
s = scheme_intern_symbol("fixnum");

12
src/foreign/foreign.rktc
View File

@ -606,6 +606,12 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
(lambda (x aux) @list{scheme_get_unsigned_long_long_val(@x,&@aux)}) #f
"integer_value_from_unsigned_long_long")
/* This is like int32, but always assumes fixnum: */
@(defctype* '(fixint "int32") "Tsint32" "INT" "INT" "integer")
/* This is like uint32, but always assumes fixnum: */
@(defctype* '(ufixint "uint32") "Tuint32" "INT" "UINT" "integer_from_unsigned")
@@@IFNDEF{SIXTY_FOUR_BIT_LONGS}{
#define ffi_type_smzlong ffi_type_sint32
#define ffi_type_umzlong ffi_type_uint32
@ -622,12 +628,6 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
#define ffi_type_umzintptr ffi_type_uint64
}
/* This is like intptr, but always assumes fixnum: */
@(defctype* '(fixint "smzintptr") "intptr_t" "INT" "INT" "integer")
/* This is like uint32, but always assumes fixnum: */
@(defctype* '(ufixint "umzintptr") "uintptr_t" "INT" "UINT" "integer_from_unsigned")
/* This is what mzscheme defines as intptr, assuming fixnums: */
@(defctype* '(fixnum "smzintptr")
"intptr_t" "INT" "INT" "integer")