ffi/unsafe: add _wchar

Closes #1843

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

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

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)

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)
+         [(or (not size)
-              (eq? base-type 'int))
+              (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

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

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

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)