~ chicken-core (chicken-5) f3aa0f2d861cbafb0c7455da3de219a5be27a280
commit f3aa0f2d861cbafb0c7455da3de219a5be27a280
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri Oct 5 20:20:31 2012 +0200
Commit: Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Mon Oct 15 22:11:15 2012 +0200
Convert (errno == EINTR && !feof(fp)) checks into ferror(fp) checks, and put the errno dispatching code into Scheme, raising an exception on anything but EINTR
Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>
diff --git a/library.scm b/library.scm
index 8ea65ca6..bd30e624 100644
--- a/library.scm
+++ b/library.scm
@@ -77,7 +77,12 @@ fast_read_line_from_file(C_word str, C_word port, C_word size) {
C_FILEPTR fp = C_port_file(port);
if ((c = C_getc(fp)) == EOF) {
- return (errno == EINTR && !feof(fp)) ? C_fix(-1) : C_SCHEME_END_OF_FILE;
+ if (ferror(fp)) {
+ clearerr(fp);
+ return C_fix(-1);
+ } else { /* feof (fp) */
+ return C_SCHEME_END_OF_FILE;
+ }
}
C_ungetc(c, fp);
@@ -85,7 +90,7 @@ fast_read_line_from_file(C_word str, C_word port, C_word size) {
for (i = 0; i < n; i++) {
c = C_getc(fp);
- if(c == EOF && errno == EINTR && !feof(fp)) {
+ if(c == EOF && ferror(fp)) {
clearerr(fp);
return C_fix(-(i + 1));
}
@@ -111,11 +116,7 @@ fast_read_string_from_file(C_word dest, C_word port, C_word len, C_word pos)
size_t m = fread (buf, sizeof (char), n, fp);
- if(m == EOF && errno == EINTR && !feof(fp)) {
- clearerr(fp);
- return C_fix(-1);
- }
- else if (m < n) {
+ if (m < n) {
if (feof (fp)) {
if (0 == m)
return C_SCHEME_END_OF_FILE;
@@ -1751,15 +1752,29 @@ EOF
(vector (lambda (p) ; read-char
(let loop ()
(let ((c (##core#inline "C_read_char" p)))
- (if (eq? -1 c) ; EINTR
- (##sys#dispatch-interrupt loop)
- c))))
+ (cond
+ ((eq? -1 c)
+ (##sys#update-errno)
+ (if (eq? (errno) (foreign-value "EINTR" int))
+ (##sys#dispatch-interrupt loop)
+ (##sys#signal-hook
+ #:file-error 'read-char
+ (##sys#string-append "cannot read from port - " strerror)
+ p)))
+ (else c)))))
(lambda (p) ; peek-char
(let loop ()
(let ((c (##core#inline "C_peek_char" p)))
- (if (eq? -1 c) ; EINTR
- (##sys#dispatch-interrupt loop)
- c))))
+ (cond
+ ((eq? -1 c)
+ (##sys#update-errno)
+ (if (eq? (errno) (foreign-value "EINTR" int))
+ (##sys#dispatch-interrupt loop)
+ (##sys#signal-hook
+ #:file-error 'peek-char
+ (##sys#string-append "cannot read from port - " strerror)
+ p)))
+ (else c)))))
(lambda (p c) ; write-char
(##core#inline "C_display_char" p c) )
(lambda (p s) ; write-string
@@ -1777,22 +1792,28 @@ EOF
(cond [(or (not len) ; error returns EOF
(eof-object? len)) ; EOF returns 0 bytes read
act]
- ((fx< len 0) ; EINTR
- (let ((len (fx< (fxneg len) 1)))
- (##sys#dispatch-interrupt
- (lambda ()
- (loop (fx- rem len) (fx+ act len) (fx+ start len))))))
+ ((fx< len 0)
+ (##sys#update-errno)
+ (if (eq? (errno) (foreign-value "EINTR" int))
+ (let ((len (fx< (fxneg len) 1)))
+ (##sys#dispatch-interrupt
+ (lambda ()
+ (loop (fx- rem len) (fx+ act len) (fx+ start len)))))
+ (##sys#signal-hook
+ #:file-error 'read-string!
+ (##sys#string-append "cannot read from port - " strerror)
+ p n dest start)))
[(fx< len rem)
(loop (fx- rem len) (fx+ act len) (fx+ start len))]
[else
(fx+ act len) ] ) )))
- (lambda (p limit) ; read-line
- (if limit (##sys#check-exact limit 'read-line))
+ (lambda (p rlimit) ; read-line
+ (if rlimit (##sys#check-exact rlimit 'read-line))
(let ((sblen read-line-buffer-initial-size))
(unless (##sys#slot p 12)
(##sys#setslot p 12 (##sys#make-string sblen)))
(let loop ([len sblen]
- [limit (or limit maximal-string-length)] ; guaranteed fixnum?
+ [limit (or rlimit maximal-string-length)] ; guaranteed fixnum?
[buffer (##sys#slot p 12)]
[result ""]
[f #f])
@@ -1807,14 +1828,20 @@ EOF
(##sys#make-string (fx* len 2))
(##sys#string-append result buffer)
#t)) ]
- ((fx< n 0) ; EINTR
- (let ((n (fx- (fxneg n) 1)))
- (##sys#dispatch-interrupt
- (lambda ()
- (loop len limit buffer
- (##sys#string-append
- result (##sys#substring buffer 0 n))
- #t)))))
+ ((fx< n 0)
+ (##sys#update-errno)
+ (if (eq? (errno) (foreign-value "EINTR" int))
+ (let ((n (fx- (fxneg n) 1)))
+ (##sys#dispatch-interrupt
+ (lambda ()
+ (loop len limit buffer
+ (##sys#string-append
+ result (##sys#substring buffer 0 n))
+ #t))))
+ (##sys#signal-hook
+ #:file-error 'read-line
+ (##sys#string-append "cannot read from port - " strerror)
+ p rlimit)))
[f (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
(##sys#string-append result (##sys#substring buffer 0 n))]
[else
diff --git a/runtime.c b/runtime.c
index 4aefeb5e..d8f94ed5 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3959,10 +3959,14 @@ C_regparm C_word C_fcall C_display_flonum(C_word port, C_word n)
C_regparm C_word C_fcall C_read_char(C_word port)
{
- int c = C_getc(C_port_file(port));
+ C_FILEPTR fp = C_port_file(port);
+ int c = C_getc(fp);
if(c == EOF) {
- if(errno == EINTR && !feof(C_port_file(port))) return C_fix(-1);
+ if(ferror(fp)) {
+ clearerr(fp);
+ return C_fix(-1);
+ }
/* Found here:
http://mail.python.org/pipermail/python-bugs-list/2002-July/012579.html */
#if defined(_WIN32) && !defined(__CYGWIN__)
@@ -3981,7 +3985,10 @@ C_regparm C_word C_fcall C_peek_char(C_word port)
int c = C_getc(fp);
if(c == EOF) {
- if(errno == EINTR && !feof(C_port_file(port))) return C_fix(-1);
+ if(ferror(fp)) {
+ clearerr(fp);
+ return C_fix(-1);
+ }
/* see above */
#if defined(_WIN32) && !defined(__CYGWIN__)
else if(GetLastError() == ERROR_OPERATION_ABORTED) return C_fix(-1);
Trap