Ticket #21: read-string2.diff.txt

File read-string2.diff.txt, 3.7 KB (added by Jim Ursetto, 13 years ago)

read-string patch

Line 
1Index: 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))
31Index: 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) )