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

ffi/unsafe: add _wchar

Browse Source 
Closes #1843
This commit is contained in:
Matthew Flatt 2018-06-19 21:30:06 -06:00
parent 76c30df8e6
commit 8fb8d3c936
7 changed files with 42 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -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]))

11
pkgs/racket-doc/scribblings/foreign/types.scrbl
View File

@ -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?]

9
racket/collects/ffi/unsafe.rkt
View File

@ -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)

9
racket/src/cs/rumble/foreign.ss
View File

@ -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

9
racket/src/foreign/foreign.c
View File

@ -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);

9
racket/src/foreign/foreign.rktc
View File

@ -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);

4
racket/src/racket/src/schvers.h
View File

@ -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)