Hi all, I noticed two problems after looking over the file-modification-time patches I recently submitted. The first is that on 32-bit systems, the mtime or atime that the user passes in would get truncated to 32 bits on a 32-bit platform (and presumably also on a 64-bit LLP platform, ie 64-bit Windows) due to using C_int_to_num instead of C_int_to_num64.
The other problem is related; size_t is an unsigned type, not a signed type, and it can be 64-bit even on 32-bit systems, so we should better use C_int_to_num64 for that type as well. Attached are patches for this. Strictly speaking, I suppose we should really add a new C_num_to_size_t or such, but if we do that, we will need to add it for every stupid opaque type that C might offer. In practice, size_t is at most 64 bits so let's just keep that assumption (for now?). Cheers, Peter
From 44a187085319c440d28402914ad8ba4ac7b62578 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Tue, 6 Jun 2017 21:06:57 +0200
Subject: [PATCH 1/2] Do not truncate file times to 32 bits on 32-bit or LLP
platforms in setter
---
posixunix.scm | 4 ++--
posixwin.scm | 4 ++--
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/posixunix.scm b/posixunix.scm
index 54bfe7e..f20623e 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -370,12 +370,12 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
if (atime == C_SCHEME_FALSE) {
tb.actime = sb.st_atime;
} else {
- tb.actime = C_num_to_int(atime);
+ tb.actime = C_num_to_int64(atime);
}
if (mtime == C_SCHEME_FALSE) {
tb.modtime = sb.st_mtime;
} else {
- tb.modtime = C_num_to_int(mtime);
+ tb.modtime = C_num_to_int64(mtime);
}
return utime(filename, &tb);
}
diff --git a/posixwin.scm b/posixwin.scm
index 735504c..c0a2cf8 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -648,12 +648,12 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
if (atime == C_SCHEME_FALSE) {
tb.actime = sb.st_atime;
} else {
- tb.actime = C_num_to_int(atime);
+ tb.actime = C_num_to_int64(atime);
}
if (mtime == C_SCHEME_FALSE) {
tb.modtime = sb.st_mtime;
} else {
- tb.modtime = C_num_to_int(mtime);
+ tb.modtime = C_num_to_int64(mtime);
}
return _utime(filename, &tb);
}
--
2.1.4
From 95e19db09f94c222e97fb50e0e0e687a2f5a4cee Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
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
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
