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

enforce ranges on all integer types

Browse Source 
DO NOT merge to 5.3
This commit is contained in:
Matthew Flatt 2012-04-14 20:40:03 -06:00
parent 57f101c74c
commit 4179cbfa63
6 changed files with 176 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/ffi/unsafe.rkt
View File

@ -38,13 +38,23 @@
;; _byte etc is a convenient name for _uint8 & _sint8
;; (_byte is unsigned)
(define* _byte _uint8)
(define* _byte (make-ctype _uint8
(lambda (i) (if (and (exact-integer? i)
(<= -128 i -1))
(+ i 256)
i))
(lambda (v) v)))
(define* _ubyte _uint8)
(define* _sbyte _int8)
;; _word etc is a convenient name for _uint16 & _sint16
;; (_word is unsigned)
(define* _word _uint16)
(define* _word (make-ctype _uint16
(lambda (i) (if (and (exact-integer? i)
(<= (- (expt 2 15)) i -1))
(+ i (expt 2 16))
i))
(lambda (v) v)))
(define* _uword _uint16)
(define* _sword _int16)

31
collects/scribblings/foreign/types.scrbl
View File

@ -105,18 +105,35 @@ The basic integer types at various sizes. The @racketidfont{s} or
@racketidfont{u} prefix specifies a signed or an unsigned integer,
respectively; the ones with no prefix are signed.}
@defthing*[([_byte ctype?]
[_sbyte ctype?]
[_ubyte ctype?]
[_short ctype?]
[_ubyte ctype?])]{
The @racket[_sbyte] and @racket[_ubyte] types are aliases
for @racket[_sint8] and @racket[_uint8], respectively.
The @racket[_byte] type is like @racket[_ubyte], but adds
256 to a negative Racket value that would work as a @racket[_sbyte]
(i.e., it casts signed bytes to unsigned bytes).}
@defthing*[([_word ctype?]
[_sword ctype?]
[_uword ctype?]
)]{
The @racket[_sword] and @racket[_uword] types are aliases
for @racket[_sint16] and @racket[_uint16], respectively.
The @racket[_word] type is like @racket[_uword], but coerces
negative values in the same way as @racket[_byte].}
@defthing*[([_short ctype?]
[_sshort ctype?]
[_ushort ctype?]
[_int ctype?]
[_sint ctype?]
[_uint ctype?]
[_word ctype?]
[_sword ctype?]
[_uword ctype?]
[_long ctype?]
[_slong ctype?]
[_ulong ctype?]
@ -127,14 +144,14 @@ respectively; the ones with no prefix are signed.}
[_sintptr ctype?]
[_uintptr ctype?])]{
Aliases for basic integer types. The @racket[_byte] aliases correspond
to @racket[_int8]. The @racket[_short] and @racket[_word] aliases
Aliases for basic integer types. The @racket[_short] aliases
correspond to @racket[_int16]. The @racket[_int] aliases correspond to
@racket[_int32]. The @racket[_long] aliases correspond to either
@racket[_int32] or @racket[_int64], depending on the platform. Similarly,
the @racket[_intptr] aliases correspond to either
@racket[_int32] or @racket[_int64], depending on the platform.}
@defthing*[([_fixnum ctype?]
[_ufixnum ctype?])]{

11
collects/tests/racket/foreign-test.rktl
View File

@ -10,6 +10,7 @@
(test #f malloc 0 _int)
(test #f malloc _int 0)
;; Check integer-range checking:
(let ()
(define (try-int-boundary N _int _uint)
(test (- (expt 2 N)) cast (- (expt 2 N)) _int _int)
@ -20,8 +21,14 @@
(err/rt-test (cast (sub1 (- (expt 2 N))) _int _int))
(err/rt-test (cast -1 _uint _uint))
(err/rt-test (cast (- (expt 2 N)) _uint _uint)))
;(try-int-boundary 7 _int8 _uint8)
;(try-int-boundary 15 _int16 _uint16)
(try-int-boundary 7 _int8 _uint8)
(try-int-boundary 7 _sbyte _ubyte)
(test 128 cast -128 _byte _byte)
(test 239 cast -17 _byte _byte)
(try-int-boundary 15 _int16 _uint16)
(try-int-boundary 15 _sword _uword)
(try-int-boundary 15 _short _ushort)
(test (expt 2 15) cast (- (expt 2 15)) _word _word)
(try-int-boundary 31 _int32 _uint32)
(try-int-boundary 63 _int64 _uint64))

3
doc/release-notes/racket/HISTORY.txt
View File

@ -1,3 +1,6 @@
Version 5.3.0.1
ffi/unsafe: integer-type bounds consistently checked
Version 5.2.900.1
Add submodules, including module*, module-compiled-submodules
Change resolver protocol so that declaration notify is always issued

136
src/foreign/foreign.c
View File

@ -472,6 +472,54 @@ MZ_INLINE int scheme_get_unsigned_realint_val(Scheme_Object *o, unsigned int *v)
#endif /* SIXTY_FOUR_BIT_INTEGERS */
MZ_INLINE static int get_byte_val(Scheme_Object *o, Tsint8 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= -128) && (v <= 127)) {
*_v = v;
return 1;
}
}
return 0;
}
MZ_INLINE static int get_ubyte_val(Scheme_Object *o, Tuint8 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= 0) && (v <= 255)) {
*_v = v;
return 1;
}
}
return 0;
}
MZ_INLINE static int get_short_val(Scheme_Object *o, Tsint16 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= -32768) && (v <= 32767)) {
*_v = v;
return 1;
}
}
return 0;
}
MZ_INLINE static int get_ushort_val(Scheme_Object *o, Tuint16 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= 0) && (v <= 65536)) {
*_v = v;
return 1;
}
}
return 0;
}
/* This is related to the section of scheme.h that defines mzlonglong. */
#ifndef INT64_AS_LONG_LONG
#ifdef NO_LONG_LONG_TYPE
@ -545,8 +593,8 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* Type Name: int8
* LibFfi type: ffi_type_sint8
* C type: Tsint8
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_INT_VAL(<Scheme>)
* Predicate: get_byte_val(<Scheme>,&aux)
* Scheme->C: -none- (set by the predicate)
* S->C offset: 0
* C->Scheme: scheme_make_integer(<C>)
*/
@ -555,18 +603,18 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* Type Name: uint8
* LibFfi type: ffi_type_uint8
* C type: Tuint8
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_UINT_VAL(<Scheme>)
* Predicate: get_ubyte_val(<Scheme>,&aux)
* Scheme->C: -none- (set by the predicate)
* S->C offset: 0
* C->Scheme: scheme_make_integer_from_unsigned(<C>)
* C->Scheme: scheme_make_integer(<C>)
*/
#define FOREIGN_int16 (4)
/* Type Name: int16
* LibFfi type: ffi_type_sint16
* C type: Tsint16
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_INT_VAL(<Scheme>)
* Predicate: get_short_val(<Scheme>,&aux)
* Scheme->C: -none- (set by the predicate)
* S->C offset: 0
* C->Scheme: scheme_make_integer(<C>)
*/
@ -575,10 +623,10 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
/* Type Name: uint16
* LibFfi type: ffi_type_uint16
* C type: Tuint16
* Predicate: SCHEME_INTP(<Scheme>)
* Scheme->C: SCHEME_UINT_VAL(<Scheme>)
* Predicate: get_ushort_val(<Scheme>,&aux)
* Scheme->C: -none- (set by the predicate)
* S->C offset: 0
* C->Scheme: scheme_make_integer_from_unsigned(<C>)
* C->Scheme: scheme_make_integer(<C>)
*/
/* Treats integers properly: */
@ -1496,9 +1544,9 @@ static Scheme_Object *C2SCHEME(Scheme_Object *type, void *src,
} else switch (CTYPE_PRIMLABEL(type)) {
case FOREIGN_void: return scheme_void;
case FOREIGN_int8: return scheme_make_integer(REF_CTYPE(Tsint8));
case FOREIGN_uint8: return scheme_make_integer_from_unsigned(REF_CTYPE(Tuint8));
case FOREIGN_uint8: return scheme_make_integer(REF_CTYPE(Tuint8));
case FOREIGN_int16: return scheme_make_integer(REF_CTYPE(Tsint16));
case FOREIGN_uint16: return scheme_make_integer_from_unsigned(REF_CTYPE(Tuint16));
case FOREIGN_uint16: return scheme_make_integer(REF_CTYPE(Tuint16));
case FOREIGN_int32: return scheme_make_realinteger_value(REF_CTYPE(Tsint32));
case FOREIGN_uint32: return scheme_make_realinteger_value_from_unsigned(REF_CTYPE(Tuint32));
case FOREIGN_int64: return scheme_make_integer_value_from_long_long(REF_CTYPE(Tsint64));
@ -1573,65 +1621,17 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, intptr_t delta,
if (!ret_loc) scheme_wrong_type("Scheme->C","non-void-C-type",0,1,&(type));
break;
case FOREIGN_int8:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tsint8)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tsint8));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_INTP(val)) {
Tsint8 tmp;
tmp = (Tsint8)(SCHEME_INT_VAL(val));
(((Tsint8*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","int8",0,1,&(val));
return NULL; /* hush the compiler */
}
if (!(get_byte_val(val,&(((Tsint8*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","int8",0,1,&(val));
return NULL;
case FOREIGN_uint8:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tuint8)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tuint8));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_INTP(val)) {
Tuint8 tmp;
tmp = (Tuint8)(SCHEME_UINT_VAL(val));
(((Tuint8*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","uint8",0,1,&(val));
return NULL; /* hush the compiler */
}
if (!(get_ubyte_val(val,&(((Tuint8*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","uint8",0,1,&(val));
return NULL;
case FOREIGN_int16:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tsint16)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tsint16));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_INTP(val)) {
Tsint16 tmp;
tmp = (Tsint16)(SCHEME_INT_VAL(val));
(((Tsint16*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","int16",0,1,&(val));
return NULL; /* hush the compiler */
}
if (!(get_short_val(val,&(((Tsint16*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","int16",0,1,&(val));
return NULL;
case FOREIGN_uint16:
# ifdef SCHEME_BIG_ENDIAN
if (sizeof(Tuint16)<sizeof(int) && ret_loc) {
((int*)W_OFFSET(dst,delta))[0] = 0;
delta += (sizeof(int)-sizeof(Tuint16));
}
# endif /* SCHEME_BIG_ENDIAN */
if (SCHEME_INTP(val)) {
Tuint16 tmp;
tmp = (Tuint16)(SCHEME_UINT_VAL(val));
(((Tuint16*)W_OFFSET(dst,delta))[0]) = tmp; return NULL;
} else {
scheme_wrong_type("Scheme->C","uint16",0,1,&(val));
return NULL; /* hush the compiler */
}
if (!(get_ushort_val(val,&(((Tuint16*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","uint16",0,1,&(val));
return NULL;
case FOREIGN_int32:
if (!(scheme_get_realint_val(val,&(((Tsint32*)W_OFFSET(dst,delta))[0])))) scheme_wrong_type("Scheme->C","int32",0,1,&(val));
return NULL;

66
src/foreign/foreign.rktc
View File

@ -391,6 +391,54 @@ MZ_INLINE int scheme_get_unsigned_realint_val(Scheme_Object *o, unsigned int *v)
}
MZ_INLINE static int get_byte_val(Scheme_Object *o, Tsint8 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= -128) && (v <= 127)) {
*_v = v;
return 1;
}
}
return 0;
}
MZ_INLINE static int get_ubyte_val(Scheme_Object *o, Tuint8 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= 0) && (v <= 255)) {
*_v = v;
return 1;
}
}
return 0;
}
MZ_INLINE static int get_short_val(Scheme_Object *o, Tsint16 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= -32768) && (v <= 32767)) {
*_v = v;
return 1;
}
}
return 0;
}
MZ_INLINE static int get_ushort_val(Scheme_Object *o, Tuint16 *_v)
{
if (SCHEME_INTP(o)) {
intptr_t v = SCHEME_INT_VAL(o);
if ((v >= 0) && (v <= 65536)) {
*_v = v;
return 1;
}
}
return 0;
}
/* This is related to the section of scheme.h that defines mzlonglong. */
#ifndef INT64_AS_LONG_LONG
#ifdef NO_LONG_LONG_TYPE
@ -593,15 +641,21 @@ Scheme_Object *utf16_pointer_to_ucs4_string(unsigned short *utf)
@(defctype 'void
'ctype #f 'pred #f 's->c #f 'c->s (lambda (x) "scheme_void"))
@; libffi primitive types
@; scheme-name c-type SCHEME_?P SCHEME_?_VAL scheme_make_
@(defctype* 'int8 "Tsint8" "INT" "INT" "integer")
@(defctype* 'int8 "Tsint8"
(lambda (x aux) @list{get_byte_val(@x,&@aux)}) #f
"integer")
@(defctype* 'uint8 "Tuint8" "INT" "UINT" "integer_from_unsigned")
@(defctype* 'uint8 "Tuint8"
(lambda (x aux) @list{get_ubyte_val(@x,&@aux)}) #f
"integer")
@(defctype* 'int16 "Tsint16" "INT" "INT" "integer")
@(defctype* 'int16 "Tsint16"
(lambda (x aux) @list{get_short_val(@x,&@aux)}) #f
"integer")
@(defctype* 'uint16 "Tuint16" "INT" "UINT" "integer_from_unsigned")
@(defctype* 'uint16 "Tuint16"
(lambda (x aux) @list{get_ushort_val(@x,&@aux)}) #f
"integer")
/* Treats integers properly: */
@(defctype* 'int32 "Tsint32"