From 615d8f13294b9da7463d8aa3c9bce78a37a4f58f Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Tue, 12 Oct 2010 15:56:49 -0400
Subject: [PATCH] Add _intptr etc; closes PR11311.

---
 collects/ffi/unsafe.rkt                  | 46 ++++++++++++------------
 collects/scribblings/foreign/types.scrbl |  8 ++++-
 2 files changed, 29 insertions(+), 25 deletions(-)

diff --git a/collects/ffi/unsafe.rkt b/collects/ffi/unsafe.rkt
index abda3034a5..76ebe5993c 100644
--- a/collects/ffi/unsafe.rkt
+++ b/collects/ffi/unsafe.rkt
@@ -45,42 +45,40 @@
 (define* _uword _uint16)
 (define* _sword _int16)
 
-;; _short etc is a convenient name for whatever is the compiler's `short'
-;; (_short is signed)
-(provide _short _ushort _sshort)
-(define-values (_short _ushort _sshort)
-  (case (compiler-sizeof 'short)
-    [(2) (values _int16 _uint16 _int16)]
-    [(4) (values _int32 _uint32 _int32)]
-    [else (error 'foreign "internal error: bad compiler size for `short'")]))
-
-;; _int etc is a convenient name for whatever is the compiler's `int'
-;; (_int is signed)
-(provide _int _uint _sint)
-(define-values (_int _uint _sint)
+;; utility for the next few definitions
+(define (sizeof->3ints c-type)
   (case (compiler-sizeof 'int)
     [(2) (values _int16 _uint16 _int16)]
     [(4) (values _int32 _uint32 _int32)]
     [(8) (values _int64 _uint64 _int64)]
-    [else (error 'foreign "internal error: bad compiler size for `int'")]))
+    [else (error 'foreign "internal error: bad compiler size for `~s'"
+                 c-type)]))
+
+;; _short etc is a convenient name for whatever is the compiler's `short'
+;; (_short is signed)
+(provide _short _ushort _sshort)
+(define-values (_short _ushort _sshort) (sizeof->3ints 'short))
+
+;; _int etc is a convenient name for whatever is the compiler's `int'
+;; (_int is signed)
+(provide _int _uint _sint)
+(define-values (_int _uint _sint) (sizeof->3ints 'int))
 
 ;; _long etc is a convenient name for whatever is the compiler's `long'
 ;; (_long is signed)
 (provide _long _ulong _slong)
-(define-values (_long _ulong _slong)
-  (case (compiler-sizeof 'long)
-    [(4) (values _int32 _uint32 _int32)]
-    [(8) (values _int64 _uint64 _int64)]
-    [else (error 'foreign "internal error: bad compiler size for `long'")]))
+(define-values (_long _ulong _slong) (sizeof->3ints 'long))
 
 ;; _llong etc is a convenient name for whatever is the compiler's `long long'
 ;; (_llong is signed)
 (provide _llong _ullong _sllong)
-(define-values (_llong _ullong _sllong)
-  (case (compiler-sizeof '(long long))
-    [(4) (values _int32 _uint32 _int32)]
-    [(8) (values _int64 _uint64 _int64)]
-    [else (error 'foreign "internal error: bad compiler size for `llong'")]))
+(define-values (_llong _ullong _sllong) (sizeof->3ints '(long long)))
+
+;; _intptr etc is a convenient name for whatever is the integer
+;; equivalent of the compiler's pointer (see `intptr_t') (_intptr is
+;; signed)
+(provide _intptr _uintptr _sintptr)
+(define-values (_intptr _uintptr _sintptr) (sizeof->3ints '(void *)))
 
 ;; ----------------------------------------------------------------------------
 ;; Getting and setting library objects
diff --git a/collects/scribblings/foreign/types.scrbl b/collects/scribblings/foreign/types.scrbl
index 58df957a94..dd6691d986 100644
--- a/collects/scribblings/foreign/types.scrbl
+++ b/collects/scribblings/foreign/types.scrbl
@@ -104,7 +104,13 @@ respectively; the ones with no prefix are signed.}
             [_uword ctype?]
             [_long ctype?]
             [_slong ctype?]
-            [_ulong ctype?])]{
+            [_ulong ctype?]
+            [_llong ctype?]
+            [_sllong ctype?]
+            [_ullong ctype?]
+            [_intptr ctype?]
+            [_sintptr ctype?]
+            [_uintptr ctype?])]{
 
 Aliases for basic integer types. The @scheme[_byte] aliases correspond
 to @scheme[_int8]. The @scheme[_short] and @scheme[_word] aliases