From 8fb8d3c93677d33e05bd1244c89cacebdf7e5a70 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 19 Jun 2018 21:30:06 -0600 Subject: [PATCH] ffi/unsafe: add `_wchar` Closes #1843 --- pkgs/base/info.rkt | 2 +- pkgs/racket-doc/scribblings/foreign/types.scrbl | 11 ++++++++++- racket/collects/ffi/unsafe.rkt | 9 ++++++++- racket/src/cs/rumble/foreign.ss | 9 +++++---- racket/src/foreign/foreign.c | 9 ++++++++- racket/src/foreign/foreign.rktc | 9 ++++++++- racket/src/racket/src/schvers.h | 4 ++-- 7 files changed, 42 insertions(+), 11 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index e4ca2a288c..a0b8c6852e 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.0.0.2") +(define version "7.0.0.3") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-doc/scribblings/foreign/types.scrbl index 53b488c170..629291c33d 100644 --- a/pkgs/racket-doc/scribblings/foreign/types.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/types.scrbl @@ -106,7 +106,7 @@ element representation followed by an exact-integer count. @defproc[(compiler-sizeof [sym (or/c symbol? (listof symbol?))]) exact-nonnegative-integer?]{ -Possible values for @racket[sym] are @racket['int], @racket['char], +Possible values for @racket[sym] are @racket['int], @racket['char], @racket['wchar], @racket['short], @racket['long], @racket['*], @racket['void], @racket['float], @racket['double], or lists of symbols, such as @racket['(long long)]. The result is the size of the @@ -154,6 +154,15 @@ The @racket[_byte] type is like @racket[_ubyte], but adds (i.e., it casts signed bytes to unsigned bytes).} +@defthing*[([_wchar ctype?])]{ + +The @racket[_wchar] type is an alias for an unsigned integer type, +such as @racket[_uint16] or @racket[_uint32], corresponding to the platform's +@as-index{@tt{wchar_t}} type. + +@history[#:added "7.0.0.3"]} + + @defthing*[([_word ctype?] [_sword ctype?] [_uword ctype?] diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index 18260f5f3e..f6cfe8e28c 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -16,7 +16,7 @@ vector->cpointer flvector->cpointer extflvector->cpointer saved-errno lookup-errno ctype? make-ctype make-cstruct-type make-array-type make-union-type make-sized-byte-string ctype->layout - _void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64 + _void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64 _wchar _fixint _ufixint _fixnum _ufixnum _float _double _longdouble _double* _bool _stdbool _pointer _gcpointer _scheme (rename-out [_scheme _racket]) _fpointer function-ptr @@ -62,6 +62,13 @@ (define* _uword _uint16) (define* _sword _int16) +(define* _wchar (case (compiler-sizeof 'wchar) + [(1) _uint8] + [(2) _uint16] + [(4) _uint32] + [(8) _uint64] + [else (error '_wchar "implausible 'wchar size")])) + ;; utility for the next few definitions (define (sizeof->3ints c-type) (case (compiler-sizeof c-type) diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index 515aa2126d..698500ef98 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/racket/src/cs/rumble/foreign.ss @@ -549,11 +549,12 @@ (if star? (foreign-sizeof 'void*) (raise-arguments-error 'compiler-sizeof "cannot use 'void without a '*"))] - [(or (not base-type) - (eq? base-type 'int)) + [(or (not size) + (eq? base-type 'int) + (not base-type)) (if star? (foreign-sizeof 'void*) - (foreign-sizeof (or size 'int)))] + (foreign-sizeof (or size base-type 'int)))] [(eq? base-type 'double) (case size [(long) @@ -580,7 +581,7 @@ [else (let ([s (if (pair? sl) (car sl) sl)]) (case s - [(int char float double void) + [(int char wchar float double void) (cond [base-type (raise-arguments-error 'compiler-sizeof diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c index 69ce6f2ea8..f8ac77364d 100644 --- a/racket/src/foreign/foreign.c +++ b/racket/src/foreign/foreign.c @@ -2478,7 +2478,7 @@ static Scheme_Object *foreign_ctype_alignof(int argc, Scheme_Object *argv[]) static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[]) { int res=0; - int basetype = 0; /* 1=int, 2=char, 3=void, 4=float, 5=double */ + int basetype = 0; /* 1=int, 2=char, 3=void, 4=float, 5=double, 6=wchar_t */ int intsize = 0; /* "short" => decrement, "long" => increment */ int stars = 0; /* number of "*"s */ int must_list = 0; @@ -2495,6 +2495,9 @@ static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[]) } else if (!strcmp(SCHEME_SYM_VAL(p),"char")) { if (basetype==0) basetype=2; else scheme_signal_error(MYNAME": extraneous type: %V", p); + } else if (!strcmp(SCHEME_SYM_VAL(p),"wchar")) { + if (basetype==0) basetype=6; + else scheme_signal_error(MYNAME": extraneous type: %V", p); } else if (!strcmp(SCHEME_SYM_VAL(p),"void")) { if (basetype==0) basetype=3; else scheme_signal_error(MYNAME": extraneous type: %V", p); @@ -2560,6 +2563,10 @@ static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[]) else if (intsize==1) RETSIZE(mz_long_double); else scheme_signal_error(MYNAME": bad qualifiers for 'double"); break; + case 6: /* wchar_t */ + if (intsize==0) RETSIZE(wchar_t); + else scheme_signal_error(MYNAME": cannot qualify 'wchar"); + break; default: scheme_signal_error(MYNAME": internal error (unexpected type %d)", basetype); diff --git a/racket/src/foreign/foreign.rktc b/racket/src/foreign/foreign.rktc index 15fa556f0b..993f020e56 100755 --- a/racket/src/foreign/foreign.rktc +++ b/racket/src/foreign/foreign.rktc @@ -1728,7 +1728,7 @@ static void* SCHEME2C(const char *who, * (This is about actual C types, not C type objects.) */ @cdefine[compiler-sizeof 1 #:kind immed]{ int res=0; - int basetype = 0; /* 1=int, 2=char, 3=void, 4=float, 5=double */ + int basetype = 0; /* 1=int, 2=char, 3=void, 4=float, 5=double, 6=wchar_t */ int intsize = 0; /* "short" => decrement, "long" => increment */ int stars = 0; /* number of "*"s */ int must_list = 0; @@ -1745,6 +1745,9 @@ static void* SCHEME2C(const char *who, } else if (!strcmp(SCHEME_SYM_VAL(p),"char")) { if (basetype==0) basetype=2; else scheme_signal_error(MYNAME": extraneous type: %V", p); + } else if (!strcmp(SCHEME_SYM_VAL(p),"wchar")) { + if (basetype==0) basetype=6; + else scheme_signal_error(MYNAME": extraneous type: %V", p); } else if (!strcmp(SCHEME_SYM_VAL(p),"void")) { if (basetype==0) basetype=3; else scheme_signal_error(MYNAME": extraneous type: %V", p); @@ -1810,6 +1813,10 @@ static void* SCHEME2C(const char *who, else if (intsize==1) RETSIZE(mz_long_double); else scheme_signal_error(MYNAME": bad qualifiers for 'double"); break; + case 6: /* wchar_t */ + if (intsize==0) RETSIZE(wchar_t); + else scheme_signal_error(MYNAME": cannot qualify 'wchar"); + break; default: scheme_signal_error(MYNAME": internal error (unexpected type %d)", basetype); diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index ce42dbad41..5577e23a83 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "7.0.0.2" +#define MZSCHEME_VERSION "7.0.0.3" #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 2 +#define MZSCHEME_VERSION_W 3 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)