From 95e19db09f94c222e97fb50e0e0e687a2f5a4cee Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Tue, 6 Jun 2017 21:28:21 +0200 Subject: [PATCH 2/2] Fix size_t to map to unsigned 64-bit integers, add signed ssize_t Add a test case to ensure they can represent the proper range. --- NEWS | 5 +++++ c-backend.scm | 14 ++++++++------ support.scm | 17 ++++++++--------- tests/compiler-tests.scm | 6 ++++++ 4 files changed, 27 insertions(+), 15 deletions(-) diff --git a/NEWS b/NEWS index d179db0..f4b0e04 100644 --- a/NEWS +++ b/NEWS @@ -82,6 +82,11 @@ - Static compilation of eggs is now fully supported and static versions of compiled eggs are available by default. +- Foreign function interface + - The foreign type specifier "ssize_t" is now accepted, and "size_t" + arguments now only accept positive integers. Return values of + type size_t are no longer truncated on 32-bit platforms. + 4.12.1 diff --git a/c-backend.scm b/c-backend.scm index 1c0f8f2..6be88ab 100644 --- a/c-backend.scm +++ b/c-backend.scm @@ -1129,9 +1129,10 @@ c-string-list c-string-list*) (string-append ns "+3") ) ((unsigned-integer unsigned-integer32 long integer integer32 - unsigned-long size_t number) + unsigned-long number) (string-append ns "+C_SIZEOF_FIX_BIGNUM")) - ((unsigned-integer64 integer64) ; On 32-bit systems, needs 2 digits + ((unsigned-integer64 integer64 size_t ssize_t) + ;; On 32-bit systems, needs 2 digits (string-append ns "+C_SIZEOF_BIGNUM(2)")) ((c-string c-string* unsigned-c-string unsigned-c-string unsigned-c-string*) (string-append ns "+2+(" var "==NULL?1:C_bytestowords(C_strlen(" var ")))") ) @@ -1203,6 +1204,7 @@ ((unsigned-int32 unsigned-integer32) (str "C_u32")) ((int integer bool) (str "int")) ((size_t) (str "size_t")) + ((ssize_t) (str "ssize_t")) ((int32 integer32) (str "C_s32")) ((integer64) (str "C_s64")) ((unsigned-integer64) (str "C_u64")) @@ -1303,7 +1305,8 @@ ((double number float) "C_c_double(") ((integer integer32) "C_num_to_int(") ((integer64) "C_num_to_int64(") - ((size_t) "(size_t)C_num_to_int(") + ((size_t) "(size_t)C_num_to_uint64(") + ((ssize_t) "(ssize_t)C_num_to_int64(") ((unsigned-integer64) "C_num_to_uint64(") ((long) "C_num_to_long(") ((unsigned-integer unsigned-integer32) "C_num_to_unsigned_int(") @@ -1384,9 +1387,8 @@ (sprintf "C_mpointer(&~a,(void*)" dest) ) ((c-pointer) (sprintf "C_mpointer_or_false(&~a,(void*)" dest)) ((integer integer32) (sprintf "C_int_to_num(&~a," dest)) - ((integer64) (sprintf "C_int64_to_num(&~a," dest)) - ((size_t) (sprintf "C_int_to_num(&~a,(int)" dest)) ; XXX 64 bits? - ((unsigned-integer64) (sprintf "C_uint64_to_num(&~a," dest)) + ((integer64 ssize_t) (sprintf "C_int64_to_num(&~a," dest)) + ((unsigned-integer64 size_t) (sprintf "C_uint64_to_num(&~a," dest)) ((unsigned-integer unsigned-integer32) (sprintf "C_unsigned_int_to_num(&~a," dest)) ((long) (sprintf "C_long_to_num(&~a," dest)) ((unsigned-long) (sprintf "C_unsigned_long_to_num(&~a," dest)) diff --git a/support.scm b/support.scm index 2c04d2e..233ad96 100644 --- a/support.scm +++ b/support.scm @@ -975,7 +975,7 @@ (integer64 . "C_s64") (unsigned-integer64 . "C_u64") (short . "short") (unsigned-short . "unsigned short") (long . "long") (unsigned-long . "unsigned long") - (size_t . "size_t")))) + (ssize_t . "ssize_t") (size_t . "size_t")))) (lambda (param type) (follow-without-loop type @@ -1030,14 +1030,14 @@ `(##sys#foreign-struct-wrapper-argument ',(##sys#slot (assq t tmap) 1) ,param) ) ) - ((integer32 integer64 integer short long size_t) + ((integer32 integer64 integer short long ssize_t) (let* ((foreign-type (##sys#slot (assq t ftmap) 1)) (size-expr (sprintf "sizeof(~A) * CHAR_BIT" foreign-type))) (if unsafe param `(##sys#foreign-ranged-integer-argument ,param (foreign-value ,size-expr int))))) - ((unsigned-short unsigned-long unsigned-integer + ((unsigned-short unsigned-long unsigned-integer size_t unsigned-integer32 unsigned-integer64) (let* ((foreign-type (##sys#slot (assq t ftmap) 1)) (size-expr (sprintf "sizeof(~A) * CHAR_BIT" foreign-type))) @@ -1155,11 +1155,11 @@ unsigned-c-string unsigned-c-string* nonnull-unsigned-c-string* c-string-list c-string-list*) (words->bytes 3) ) - ((unsigned-integer long integer size_t unsigned-long integer32 unsigned-integer32) + ((unsigned-integer long integer unsigned-long integer32 unsigned-integer32) (words->bytes 6) ) ; 1 bignum digit on 32-bit (overallocs on 64-bit) ((float double number) (words->bytes 4) ) ; possibly 8-byte aligned 64-bit double - ((integer64 unsigned-integer64) + ((integer64 unsigned-integer64 size_t ssize_t) (words->bytes 7)) ; 2 bignum digits on 32-bit (overallocs on 64-bit) (else (cond ((and (symbol? t) (lookup-foreign-type t)) @@ -1182,11 +1182,10 @@ ((char int short bool unsigned-short unsigned-char unsigned-int long unsigned-long byte unsigned-byte c-pointer nonnull-c-pointer unsigned-integer integer float c-string symbol scheme-pointer nonnull-scheme-pointer int32 unsigned-int32 integer32 unsigned-integer32 - unsigned-c-string unsigned-c-string* nonnull-unsigned-c-string* size_t + unsigned-c-string unsigned-c-string* nonnull-unsigned-c-string* nonnull-c-string c-string* nonnull-c-string* c-string-list c-string-list*) (words->bytes 1) ) - ;; XXX TODO FIXME: What is "number" doing here? - ((double number integer64 unsigned-integer64) + ((double integer64 unsigned-integer64 size_t ssize_t) (words->bytes 2) ) (else (cond ((and (symbol? t) (lookup-foreign-type t)) @@ -1276,7 +1275,7 @@ ((nonnull-s64vector) '(struct s64vector)) ((nonnull-f32vector) '(struct f32vector)) ((nonnull-f64vector) '(struct f64vector)) - ((integer long size_t integer32 unsigned-integer32 integer64 unsigned-integer64 + ((integer long size_t ssize_t integer32 unsigned-integer32 integer64 unsigned-integer64 unsigned-long) 'integer) ((c-pointer) diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm index 9d92afc..d753bee 100644 --- a/tests/compiler-tests.scm +++ b/tests/compiler-tests.scm @@ -357,6 +357,12 @@ (test-ffi-type-limits long signed (foreign-value "sizeof(long) * CHAR_BIT" int)) +(test-ffi-type-limits + ssize_t signed (foreign-value "sizeof(ssize_t) * CHAR_BIT" int)) + +(test-ffi-type-limits + size_t unsigned (foreign-value "sizeof(size_t) * CHAR_BIT" int)) + ;; #1059: foreign vector types use wrong lolevel accessors, causing ;; paranoid DEBUGBUILD assertions to fail. -- 2.1.4