Changeset 14507 in project


Ignore:
Timestamp:
04/29/09 16:10:26 (10 years ago)
Author:
felix winkelmann
Message:

applied read-string patch by zb

Location:
chicken/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/extras.scm

    r13831 r14507  
    205205           (set! start (fx+ start 1)) )
    206206         (let ((rdstring (##sys#slot (##sys#slot port 2) 7)))
    207            (let loop ((start start) (n n) (m 0))
    208              (let ((n2 (if rdstring
    209                            (rdstring port n dest start) ; *** doesn't update port-position!
    210                            (let ((c (##sys#read-char-0 port)))
     207           (if rdstring
     208               (let loop ((start start) (n n) (m 0))
     209                 (let ((n2 (rdstring port n dest start)))
     210                   (##sys#setislot port 5 ; update port-position
     211                                   (fx+ (##sys#slot port 5) n2))
     212                   (cond ((eq? n2 0) m)
     213                         ((or (not n) (fx< n2 n))
     214                          (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)))
     215                         (else (fx+ n2 m)))))
     216               (let loop ((start start) (n n) (m 0))
     217                 (let ((n2 (let ((c (##sys#read-char-0 port)))
    211218                             (if (eof-object? c)
    212219                                 0
    213220                                 (begin
    214221                                   (##core#inline "C_setsubchar" dest start c)
    215                                    1) ) ) ) ) )
    216                (cond ((eq? n2 0) m)
    217                     ((or (not n) (fx< n2 n))
    218                       (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)) )
    219                      (else (fx+ n2 m))) ) ) ))))
     222                                   1) ) ) ) )
     223                   (cond ((eq? n2 0) m)
     224                        ((or (not n) (fx< n2 n))
     225                          (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)) )
     226                         (else (fx+ n2 m))) )))))))
    220227
    221228(define (read-string! n dest #!optional (port ##sys#standard-input) (start 0))
     
    229236  (##sys#read-string! n dest port start) )
    230237
     238(define-constant read-string-buffer-size 2048)
    231239(define ##sys#read-string/port
    232240  (let ((open-output-string open-output-string)
     
    241249                     (##sys#substring str 0 n2))))
    242250            (else
    243              (let ([str (open-output-string)])
    244                (let loop ([n n])
    245                  (or (and (eq? n 0) (get-output-string str))
    246                      (let ([c (##sys#read-char-0 p)])
    247                        (if (eof-object? c)
    248                            (get-output-string str)
    249                            (begin
    250                              (##sys#write-char/port c str)
    251                              (loop (and n (fx- n 1))) ) ) ) ) ) ) ) ) ) ) )
     251             (let ([out (open-output-string)]
     252                   (buf (make-string read-string-buffer-size)))
     253               (let loop ()
     254                 (let ((n (##sys#read-string! read-string-buffer-size
     255                                              buf p 0)))
     256                   (cond ((eq? n 0)
     257                          (get-output-string out))
     258                         (else
     259                          (write-string buf n out)
     260                          (loop)))))))))))
    252261
    253262(define (read-string #!optional n (port ##sys#standard-input))
  • chicken/trunk/library.scm

    r14237 r14507  
    17371737          (lambda (p)                   ; char-ready?
    17381738            (##core#inline "C_char_ready_p" p) )
    1739           #f                            ; read-string!
    1740           #; ;UNUSED
    1741           (lambda (p n dest start)      ; read-string!
     1739          (lambda (p n dest start)              ; read-string!
    17421740            (let loop ([rem (or n (fx- (##sys#size dest) start))] [act 0] [start start])
    17431741              (let ([len (##core#inline "fast_read_string_from_file" dest p rem start)])
    1744                 (cond [(eof-object? len)
    1745                         (if (eq? 0 act) #!eof act)]
    1746                       [(not len)
    1747                         act]
     1742                (cond [(or (not len)          ; error returns EOF
     1743                           (eof-object? len)) ; EOF returns 0 bytes read
     1744                       act]
    17481745                      [(fx< len rem)
    1749                         (loop (fx- rem len) (fx+ act len) (fx+ start len))]
     1746                       (loop (fx- rem len) (fx+ act len) (fx+ start len))]
    17501747                      [else
    1751                         act ] ) ) ) )
     1748                       (fx+ act len) ] ) )))
    17521749          (lambda (p limit)             ; read-line
    17531750            (if limit (##sys#check-exact limit 'read-line))
Note: See TracChangeset for help on using the changeset viewer.