diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl index 4250f72063..1198a8da78 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl @@ -229,10 +229,20 @@ values.} @section{Other Atomic Types} +@defthing[_stdbool ctype?]{ + +The @racket[_stdbool] type represents the C99 @cpp{bool} type from +@cpp{}. It translates @racket[#f] to a @racket[0] +@cpp{bool} and any other value to a @racket[1] @cpp{bool}. + +@history[#:added "6.0.0.6"]} + @defthing[_bool ctype?]{ -Translates @racket[#f] to a @racket[0] @racket[_int], and any other -value to @racket[1].} +Translates @racket[#f] to a @racket[0] @cpp{int} and any other +value to a @racket[1] @cpp{int}, reflecting one of many +traditional (i.e., pre-C99) encodings of booleans. See also +@racket[_stdbool].} @defthing[_void ctype?]{ diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index 9f90126829..780a2d4550 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -16,7 +16,7 @@ _void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64 _fixint _ufixint _fixnum _ufixnum _float _double _longdouble _double* - _bool _pointer _gcpointer _scheme (rename-out [_scheme _racket]) _fpointer function-ptr + _bool _stdbool _pointer _gcpointer _scheme (rename-out [_scheme _racket]) _fpointer function-ptr memcpy memmove memset malloc-immobile-cell free-immobile-cell make-late-weak-box make-late-weak-hasheq) diff --git a/racket/src/configure b/racket/src/configure index 24ceb17957..a263b15947 100755 --- a/racket/src/configure +++ b/racket/src/configure @@ -5718,6 +5718,40 @@ cat >>confdefs.h <<_ACEOF _ACEOF +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of bool" >&5 +$as_echo_n "checking size of bool... " >&6; } +if ${ac_cv_sizeof_bool+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (bool))" "ac_cv_sizeof_bool" "#include +"; then : + +else + if test "$ac_cv_type_bool" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (bool) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_bool=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_bool" >&5 +$as_echo "$ac_cv_sizeof_bool" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_BOOL $ac_cv_sizeof_bool +_ACEOF + + ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default" diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c index 53be0119b9..2145b5884d 100644 --- a/racket/src/foreign/foreign.c +++ b/racket/src/foreign/foreign.c @@ -12,6 +12,13 @@ #include +#ifndef SIZEOF_BOOL +# define SIZEOF_BOOL 0 +#endif /* SIZEOF_BOOL */ +#if SIZEOF_BOOL != 0 +# include +#endif /* SIZEOF_BOOL != 0 */ + #ifndef WINDOWS_DYNAMIC_LOAD # include #else /* WINDOWS_DYNAMIC_LOAD defined */ @@ -868,11 +875,47 @@ static Scheme_Object *unsupported_make_long_double() { * C->Racket: (?scheme_true:scheme_false) */ +#if SIZEOF_BOOL == 0 +typedef signed char stdbool; +# define ffi_type_stdbool ffi_type_sint8 +#else /* SIZEOF_BOOL == 0 */ +typedef bool stdbool; +#if SIZEOF_BOOL == 1 +# define ffi_type_stdbool ffi_type_sint8 +#else /* SIZEOF_BOOL == 1 */ +#if SIZEOF_BOOL == 2 +# define ffi_type_stdbool ffi_type_sint16 +#else /* SIZEOF_BOOL == 2 */ +#if SIZEOF_BOOL == 4 +# define ffi_type_stdbool ffi_type_sint32 +#else /* SIZEOF_BOOL == 4 */ +#if SIZEOF_BOOL == 8 +# define ffi_type_stdbool ffi_type_sint64 +#else /* SIZEOF_BOOL == 8 */ +/* ??? Pick something */ +# define ffi_type_stdbool ffi_type_int +#endif /* SIZEOF_BOOL == 8 */ +#endif /* SIZEOF_BOOL == 4 */ +#endif /* SIZEOF_BOOL == 2 */ +#endif /* SIZEOF_BOOL == 1 */ +#endif /* SIZEOF_BOOL == 0 */ + +/* Booleans -- implemented as an int which is 1 or 0: */ +#define FOREIGN_stdbool (19) +/* Type Name: stdbool + * LibFfi type: ffi_type_stdbool + * C type: stdbool + * Predicate: 1 + * Racket->C: SCHEME_TRUEP() + * S->C offset: 0 + * C->Racket: (?scheme_true:scheme_false) + */ + /* Strings -- no copying is done (when possible). * #f is not NULL only for byte-strings, for other strings it is * meaningless to use NULL. */ -#define FOREIGN_string_ucs_4 (19) +#define FOREIGN_string_ucs_4 (20) /* Type Name: string/ucs-4 (string_ucs_4) * LibFfi type: ffi_type_gcpointer * C type: mzchar* @@ -882,7 +925,7 @@ static Scheme_Object *unsupported_make_long_double() { * C->Racket: scheme_make_char_string_without_copying() */ -#define FOREIGN_string_utf_16 (20) +#define FOREIGN_string_utf_16 (21) /* Type Name: string/utf-16 (string_utf_16) * LibFfi type: ffi_type_gcpointer * C type: unsigned short* @@ -895,7 +938,7 @@ static Scheme_Object *unsupported_make_long_double() { /* Byte strings -- not copying C strings, #f is NULL. * (note: these are not like char* which is just a pointer) */ -#define FOREIGN_bytes (21) +#define FOREIGN_bytes (22) /* Type Name: bytes * LibFfi type: ffi_type_gcpointer * C type: char* @@ -905,7 +948,7 @@ static Scheme_Object *unsupported_make_long_double() { * C->Racket: (==NULL)?scheme_false:scheme_make_byte_string_without_copying() */ -#define FOREIGN_path (22) +#define FOREIGN_path (23) /* Type Name: path * LibFfi type: ffi_type_gcpointer * C type: char* @@ -915,7 +958,7 @@ static Scheme_Object *unsupported_make_long_double() { * C->Racket: (==NULL)?scheme_false:scheme_make_path_without_copying() */ -#define FOREIGN_symbol (23) +#define FOREIGN_symbol (24) /* Type Name: symbol * LibFfi type: ffi_type_pointer * C type: char* @@ -928,7 +971,7 @@ static Scheme_Object *unsupported_make_long_double() { /* This is for any C pointer: #f is NULL, cpointer values as well as * ffi-obj and string values pass their pointer. When used as a return * value, either a cpointer object or #f is returned. */ -#define FOREIGN_pointer (24) +#define FOREIGN_pointer (25) /* Type Name: pointer * LibFfi type: ffi_type_pointer * C type: void* @@ -938,7 +981,7 @@ static Scheme_Object *unsupported_make_long_double() { * C->Racket: scheme_make_foreign_external_cpointer() */ -#define FOREIGN_gcpointer (25) +#define FOREIGN_gcpointer (26) /* Type Name: gcpointer * LibFfi type: ffi_type_gcpointer * C type: void* @@ -950,7 +993,7 @@ static Scheme_Object *unsupported_make_long_double() { /* This is used for passing and Scheme_Object* value as is. Useful for * functions that know about Scheme_Object*s, like Racket's. */ -#define FOREIGN_scheme (26) +#define FOREIGN_scheme (27) /* Type Name: scheme * LibFfi type: ffi_type_gcpointer * C type: Scheme_Object* @@ -963,7 +1006,7 @@ static Scheme_Object *unsupported_make_long_double() { /* Special type, not actually used for anything except to mark values * that are treated like pointers but not referenced. Used for * creating function types. */ -#define FOREIGN_fpointer (27) +#define FOREIGN_fpointer (28) /* Type Name: fpointer * LibFfi type: ffi_type_pointer * C type: void* @@ -991,6 +1034,7 @@ typedef union _ForeignAny { mz_long_double x_longdouble; double x_doubleS; int x_bool; + stdbool x_stdbool; mzchar* x_string_ucs_4; unsigned short* x_string_utf_16; char* x_bytes; @@ -1003,9 +1047,9 @@ typedef union _ForeignAny { } ForeignAny; /* This is a tag that is used to identify user-made struct types. */ -#define FOREIGN_struct (28) -#define FOREIGN_array (29) -#define FOREIGN_union (30) +#define FOREIGN_struct (29) +#define FOREIGN_array (30) +#define FOREIGN_union (31) XFORM_NONGCING static int is_gcable_pointer(Scheme_Object *o) { if (SCHEME_FFIOBJP(o)) return 0; @@ -1139,6 +1183,7 @@ XFORM_NONGCING static intptr_t ctype_sizeof(Scheme_Object *type) case FOREIGN_longdouble: return sizeof(mz_long_double); case FOREIGN_doubleS: return sizeof(double); case FOREIGN_bool: return sizeof(int); + case FOREIGN_stdbool: return sizeof(stdbool); case FOREIGN_string_ucs_4: return sizeof(mzchar*); case FOREIGN_string_utf_16: return sizeof(unsigned short*); case FOREIGN_bytes: return sizeof(char*); @@ -1746,6 +1791,7 @@ static Scheme_Object *C2SCHEME(Scheme_Object *already_ptr, Scheme_Object *type, case FOREIGN_longdouble: return scheme_make_maybe_long_double(REF_CTYPE(mz_long_double)); case FOREIGN_doubleS: return scheme_make_double(REF_CTYPE(double)); case FOREIGN_bool: return (REF_CTYPE(int)?scheme_true:scheme_false); + case FOREIGN_stdbool: return (REF_CTYPE(stdbool)?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*)); @@ -2118,6 +2164,27 @@ static void* SCHEME2C(const char *who, wrong_value(who, "_bool", val);; return NULL; /* hush the compiler */ } + case FOREIGN_stdbool: +# ifdef SCHEME_BIG_ENDIAN + if (sizeof(stdbool)scheme_to_c = ((Scheme_Object*)(void*)(&ffi_type_sint)); t->c_to_scheme = ((Scheme_Object*)FOREIGN_bool); scheme_add_global_constant("_bool", (Scheme_Object*)t, menv); + s = scheme_intern_symbol("stdbool"); + 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_stdbool)); + t->c_to_scheme = ((Scheme_Object*)FOREIGN_stdbool); + scheme_add_global_constant("_stdbool", (Scheme_Object*)t, menv); s = scheme_intern_symbol("string/ucs-4"); t = (ctype_struct*)scheme_malloc_tagged(sizeof(ctype_struct)); t->so.type = ctype_tag; @@ -4603,6 +4677,7 @@ void scheme_init_foreign(Scheme_Env *env) scheme_add_global_constant("_longdouble", scheme_false, menv); scheme_add_global_constant("_double*", scheme_false, menv); scheme_add_global_constant("_bool", scheme_false, menv); + scheme_add_global_constant("_stdbool", scheme_false, menv); scheme_add_global_constant("_string/ucs-4", scheme_false, menv); scheme_add_global_constant("_string/utf-16", scheme_false, menv); scheme_add_global_constant("_bytes", scheme_false, menv); diff --git a/racket/src/foreign/foreign.rktc b/racket/src/foreign/foreign.rktc index 4e547856eb..5b6f16c03f 100755 --- a/racket/src/foreign/foreign.rktc +++ b/racket/src/foreign/foreign.rktc @@ -15,6 +15,13 @@ exec racket "$0" > `echo "$0" | sed 's/rktc$/c/'` "$0" #include +@@IFNDEF{SIZEOF_BOOL}{ +# define SIZEOF_BOOL 0 +} +@@IF{SIZEOF_BOOL != 0}{ +# include +} + @@@IFNDEF{WINDOWS_DYNAMIC_LOAD}{ # include }{ @@ -816,6 +823,34 @@ static Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf) 's->c "SCHEME_TRUEP" 'c->s (lambda (x) @list{(@|x|?scheme_true:scheme_false)})) +@@@IF{SIZEOF_BOOL == 0}{ +typedef signed char stdbool; +# define ffi_type_stdbool ffi_type_sint8 +}{ +typedef bool stdbool; +@@@IF{SIZEOF_BOOL == 1}{ +# define ffi_type_stdbool ffi_type_sint8 +}{ +@@@IF{SIZEOF_BOOL == 2}{ +# define ffi_type_stdbool ffi_type_sint16 +}{ +@@@IF{SIZEOF_BOOL == 4}{ +# define ffi_type_stdbool ffi_type_sint32 +}{ +@@@IF{SIZEOF_BOOL == 8}{ +# define ffi_type_stdbool ffi_type_sint64 +}{ +/* ??? Pick something */ +# define ffi_type_stdbool ffi_type_int +}}}}} + +/* Booleans -- implemented as an int which is 1 or 0: */ +@(defctype 'stdbool + 'ftype "stdbool" + 'pred (lambda (x aux) "1") + 's->c "SCHEME_TRUEP" + 'c->s (lambda (x) @list{(@|x|?scheme_true:scheme_false)})) + /* Strings -- no copying is done (when possible). * #f is not NULL only for byte-strings, for other strings it is * meaningless to use NULL. */ diff --git a/racket/src/racket/configure.ac b/racket/src/racket/configure.ac index 5829735c47..7fec2ed60e 100644 --- a/racket/src/racket/configure.ac +++ b/racket/src/racket/configure.ac @@ -1115,6 +1115,7 @@ AC_CHECK_SIZEOF(int) AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(long long) AC_CHECK_SIZEOF([void *]) +AC_CHECK_SIZEOF(bool, unused, [#include ]) AC_TYPE_INTPTR_T AC_TYPE_UINTPTR_T diff --git a/racket/src/racket/mzconfig.h.in b/racket/src/racket/mzconfig.h.in index 990c269a91..70496d7ee3 100644 --- a/racket/src/racket/mzconfig.h.in +++ b/racket/src/racket/mzconfig.h.in @@ -22,6 +22,9 @@ /* The size of a `void *', as computed by sizeof. */ #undef SIZEOF_VOID_P +/* The size of a `bool' with , as computed by sizeof. */ +#undef SIZEOF_BOOL + /* Whether `intptr_t' is available. */ #undef HAVE_INTPTR_T diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 5489f53fce..033df58612 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -19,7 +19,7 @@ #define EXPECTED_FLFXNUM_COUNT 69 #define EXPECTED_EXTFL_COUNT 45 #define EXPECTED_FUTURES_COUNT 15 -#define EXPECTED_FOREIGN_COUNT 78 +#define EXPECTED_FOREIGN_COUNT 79 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index f21403bf3f..aae898fbd9 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.0.0.5" +#define MZSCHEME_VERSION "6.0.0.6" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 5 +#define MZSCHEME_VERSION_W 6 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)