| 1 | Index: library.scm |
|---|
| 2 | =================================================================== |
|---|
| 3 | --- library.scm (revision 14448) |
|---|
| 4 | +++ library.scm (working copy) |
|---|
| 5 | @@ -1736,19 +1736,16 @@ |
|---|
| 6 | (##core#inline "C_flush_output" p) ) |
|---|
| 7 | (lambda (p) ; char-ready? |
|---|
| 8 | (##core#inline "C_char_ready_p" p) ) |
|---|
| 9 | - #f ; read-string! |
|---|
| 10 | - #; ;UNUSED |
|---|
| 11 | - (lambda (p n dest start) ; read-string! |
|---|
| 12 | + (lambda (p n dest start) ; read-string! |
|---|
| 13 | (let loop ([rem (or n (fx- (##sys#size dest) start))] [act 0] [start start]) |
|---|
| 14 | (let ([len (##core#inline "fast_read_string_from_file" dest p rem start)]) |
|---|
| 15 | - (cond [(eof-object? len) |
|---|
| 16 | - (if (eq? 0 act) #!eof act)] |
|---|
| 17 | - [(not len) |
|---|
| 18 | - act] |
|---|
| 19 | + (cond [(or (not len) ; error returns EOF |
|---|
| 20 | + (eof-object? len)) ; EOF returns 0 bytes read |
|---|
| 21 | + act] |
|---|
| 22 | [(fx< len rem) |
|---|
| 23 | - (loop (fx- rem len) (fx+ act len) (fx+ start len))] |
|---|
| 24 | + (loop (fx- rem len) (fx+ act len) (fx+ start len))] |
|---|
| 25 | [else |
|---|
| 26 | - act ] ) ) ) ) |
|---|
| 27 | + (fx+ act len) ] ) ))) |
|---|
| 28 | (lambda (p limit) ; read-line |
|---|
| 29 | (if limit (##sys#check-exact limit 'read-line)) |
|---|
| 30 | (let ((sblen read-line-buffer-initial-size)) |
|---|
| 31 | Index: extras.scm |
|---|
| 32 | =================================================================== |
|---|
| 33 | --- extras.scm (revision 14448) |
|---|
| 34 | +++ extras.scm (working copy) |
|---|
| 35 | @@ -204,19 +204,26 @@ |
|---|
| 36 | (##core#inline "C_setsubchar" dest start (##sys#read-char-0 port)) |
|---|
| 37 | (set! start (fx+ start 1)) ) |
|---|
| 38 | (let ((rdstring (##sys#slot (##sys#slot port 2) 7))) |
|---|
| 39 | - (let loop ((start start) (n n) (m 0)) |
|---|
| 40 | - (let ((n2 (if rdstring |
|---|
| 41 | - (rdstring port n dest start) ; *** doesn't update port-position! |
|---|
| 42 | - (let ((c (##sys#read-char-0 port))) |
|---|
| 43 | + (if rdstring |
|---|
| 44 | + (let loop ((start start) (n n) (m 0)) |
|---|
| 45 | + (let ((n2 (rdstring port n dest start))) |
|---|
| 46 | + (##sys#setislot port 5 ; update port-position |
|---|
| 47 | + (fx+ (##sys#slot port 5) n2)) |
|---|
| 48 | + (cond ((eq? n2 0) m) |
|---|
| 49 | + ((or (not n) (fx< n2 n)) |
|---|
| 50 | + (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2))) |
|---|
| 51 | + (else (fx+ n2 m))))) |
|---|
| 52 | + (let loop ((start start) (n n) (m 0)) |
|---|
| 53 | + (let ((n2 (let ((c (##sys#read-char-0 port))) |
|---|
| 54 | (if (eof-object? c) |
|---|
| 55 | 0 |
|---|
| 56 | (begin |
|---|
| 57 | (##core#inline "C_setsubchar" dest start c) |
|---|
| 58 | - 1) ) ) ) ) ) |
|---|
| 59 | - (cond ((eq? n2 0) m) |
|---|
| 60 | - ((or (not n) (fx< n2 n)) |
|---|
| 61 | - (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)) ) |
|---|
| 62 | - (else (fx+ n2 m))) ) ) )))) |
|---|
| 63 | + 1) ) ) ) ) |
|---|
| 64 | + (cond ((eq? n2 0) m) |
|---|
| 65 | + ((or (not n) (fx< n2 n)) |
|---|
| 66 | + (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)) ) |
|---|
| 67 | + (else (fx+ n2 m))) ))))))) |
|---|
| 68 | |
|---|
| 69 | (define (read-string! n dest #!optional (port ##sys#standard-input) (start 0)) |
|---|
| 70 | (##sys#check-port port 'read-string!) |
|---|
| 71 | @@ -228,6 +235,7 @@ |
|---|
| 72 | (##sys#check-exact start 'read-string!) |
|---|
| 73 | (##sys#read-string! n dest port start) ) |
|---|
| 74 | |
|---|
| 75 | +(define-constant read-string-buffer-size 2048) |
|---|
| 76 | (define ##sys#read-string/port |
|---|
| 77 | (let ((open-output-string open-output-string) |
|---|
| 78 | (get-output-string get-output-string) ) |
|---|
| 79 | @@ -240,15 +248,16 @@ |
|---|
| 80 | str |
|---|
| 81 | (##sys#substring str 0 n2)))) |
|---|
| 82 | (else |
|---|
| 83 | - (let ([str (open-output-string)]) |
|---|
| 84 | - (let loop ([n n]) |
|---|
| 85 | - (or (and (eq? n 0) (get-output-string str)) |
|---|
| 86 | - (let ([c (##sys#read-char-0 p)]) |
|---|
| 87 | - (if (eof-object? c) |
|---|
| 88 | - (get-output-string str) |
|---|
| 89 | - (begin |
|---|
| 90 | - (##sys#write-char/port c str) |
|---|
| 91 | - (loop (and n (fx- n 1))) ) ) ) ) ) ) ) ) ) ) ) |
|---|
| 92 | + (let ([out (open-output-string)] |
|---|
| 93 | + (buf (make-string read-string-buffer-size))) |
|---|
| 94 | + (let loop () |
|---|
| 95 | + (let ((n (##sys#read-string! read-string-buffer-size |
|---|
| 96 | + buf p 0))) |
|---|
| 97 | + (cond ((eq? n 0) |
|---|
| 98 | + (get-output-string out)) |
|---|
| 99 | + (else |
|---|
| 100 | + (write-string buf n out) |
|---|
| 101 | + (loop))))))))))) |
|---|
| 102 | |
|---|
| 103 | (define (read-string #!optional n (port ##sys#standard-input)) |
|---|
| 104 | (##sys#read-string/port n port) ) |
|---|
