From 116d88577e6d299edca60b28431f866b1e6830d1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 3 Dec 2010 14:15:21 -0700 Subject: [PATCH] restore old behavior of `_fixint' and `_ufixint' Closes PR 11492 --- collects/scribblings/foreign/types.scrbl | 6 +- collects/tests/racket/foreign-test.rktl | 2 + src/foreign/foreign.c | 80 ++++++++++++------------ src/foreign/foreign.rktc | 12 ++-- 4 files changed, 52 insertions(+), 48 deletions(-) diff --git a/collects/scribblings/foreign/types.scrbl b/collects/scribblings/foreign/types.scrbl index 1ebcf3cbcc..6d6400d685 100644 --- a/collects/scribblings/foreign/types.scrbl +++ b/collects/scribblings/foreign/types.scrbl @@ -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?] diff --git a/collects/tests/racket/foreign-test.rktl b/collects/tests/racket/foreign-test.rktl index 182edfdea5..da6a5f3e6a 100644 --- a/collects/tests/racket/foreign-test.rktl +++ b/collects/tests/racket/foreign-test.rktl @@ -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) diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c index 24409898a1..a432f21a12 100644 --- a/src/foreign/foreign.c +++ b/src/foreign/foreign.c @@ -612,6 +612,28 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf) * C->Scheme: scheme_make_integer_value_from_unsigned_long_long() */ +/* 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->C: SCHEME_INT_VAL() + * S->C offset: 0 + * C->Scheme: scheme_make_integer() + */ + +/* 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->C: SCHEME_UINT_VAL() + * S->C offset: 0 + * C->Scheme: scheme_make_integer_from_unsigned() + */ + #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->C: SCHEME_INT_VAL() - * S->C offset: 0 - * C->Scheme: scheme_make_integer() - */ - -/* 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->C: SCHEME_UINT_VAL() - * S->C offset: 0 - * C->Scheme: scheme_make_integer_from_unsigned() - */ - /* 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)C","fixint",0,1,&(val)); return NULL; /* hush the compiler */ } case FOREIGN_ufixint: # ifdef SCHEME_BIG_ENDIAN - if (sizeof(uintptr_t)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"); diff --git a/src/foreign/foreign.rktc b/src/foreign/foreign.rktc index 1a830cc7de..e1698c1f21 100755 --- a/src/foreign/foreign.rktc +++ b/src/foreign/foreign.rktc @@ -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")