| 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) )
|
|---|
