Deleted call to C in %read_delimited since it cannot cope non-blocking
file and socket descriptors.
This commit is contained in:
parent
52291acc0e
commit
8c7c9c2006
|
@ -155,13 +155,16 @@
|
||||||
|
|
||||||
|
|
||||||
(define (port-buffer-read-delimited delims buf gobble? port start end)
|
(define (port-buffer-read-delimited delims buf gobble? port start end)
|
||||||
|
(obtain-port-lock port)
|
||||||
(let ((the-port-limit (port-limit port)))
|
(let ((the-port-limit (port-limit port)))
|
||||||
(let lp ((i start) (lp-port-index (port-index port)))
|
(let lp ((i start) (lp-port-index (port-index port)))
|
||||||
(cond ((port-pending-eof? port)
|
(cond ((port-pending-eof? port)
|
||||||
(set-port-index! port lp-port-index)
|
(set-port-index! port lp-port-index)
|
||||||
(values (eof-object) i))
|
(release-port-lock port)
|
||||||
|
(values (eof-object) (- i start)))
|
||||||
((>= i end)
|
((>= i end)
|
||||||
(set-port-index! port lp-port-index)
|
(set-port-index! port lp-port-index)
|
||||||
|
(release-port-lock port)
|
||||||
(values #f (- i start)))
|
(values #f (- i start)))
|
||||||
((< lp-port-index the-port-limit)
|
((< lp-port-index the-port-limit)
|
||||||
(let ((the-read-char
|
(let ((the-read-char
|
||||||
|
@ -172,13 +175,15 @@
|
||||||
(if gobble?
|
(if gobble?
|
||||||
(set-port-index! port (+ lp-port-index 1))
|
(set-port-index! port (+ lp-port-index 1))
|
||||||
(set-port-index! port lp-port-index))
|
(set-port-index! port lp-port-index))
|
||||||
|
(release-port-lock port)
|
||||||
(values the-read-char (- i start)))
|
(values the-read-char (- i start)))
|
||||||
(begin
|
(begin
|
||||||
(string-set! buf i the-read-char)
|
(string-set! buf i the-read-char)
|
||||||
(lp (+ i 1) (+ lp-port-index 1))))))
|
(lp (+ i 1) (+ lp-port-index 1))))))
|
||||||
(else (set-port-index! port 0)
|
(else (set-port-index! port 0)
|
||||||
(set-port-limit! port 0)
|
(set-port-limit! port 0)
|
||||||
(values 'port-buffer-exhausted i))))))
|
(release-port-lock port)
|
||||||
|
(values 'port-buffer-exhausted (- i start)))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -195,44 +200,15 @@
|
||||||
|
|
||||||
(let* ((delims (->char-set delims))
|
(let* ((delims (->char-set delims))
|
||||||
(sdelims (char-set:s delims)))
|
(sdelims (char-set:s delims)))
|
||||||
|
(let lp ((start start) (total 0))
|
||||||
(receive (terminator num-read)
|
(receive (terminator num-read)
|
||||||
(port-buffer-read-delimited delims buf gobble? port start end)
|
(port-buffer-read-delimited delims buf gobble? port start end)
|
||||||
(if (not (eq? terminator 'port-buffer-exhausted))
|
(if (not (eq? terminator 'port-buffer-exhausted))
|
||||||
(values terminator num-read)
|
(values terminator (+ num-read total))
|
||||||
(begin (set! start (+ start num-read))
|
(begin (peek-char port) ; kludge to fill the buffer
|
||||||
(if (fdport? port)
|
(lp (+ start num-read) (+ total num-read)))))))))
|
||||||
;; Direct C support for Unix file ports -- zippy quick.
|
|
||||||
(let lp ((start start) (total num-read))
|
|
||||||
(let ((fd (fdport-data:fd (fdport-data port))))
|
|
||||||
(receive (terminator num-read)
|
|
||||||
(%read-delimited-fd!/errno sdelims buf
|
|
||||||
fd start end)
|
|
||||||
(let ((total (+ num-read total)))
|
|
||||||
(cond ((char? terminator)
|
|
||||||
(if (not gobble?) (push-back port terminator))
|
|
||||||
(values terminator total))
|
|
||||||
((not (integer? terminator)) (values terminator total))
|
|
||||||
((= terminator errno/intr)
|
|
||||||
(lp (+ start num-read) total))
|
|
||||||
(else (errno-error terminator %read-delimited!
|
|
||||||
num-read total
|
|
||||||
delims buf gobble? port start end)))))))
|
|
||||||
|
|
||||||
;; This is the code for other kinds of ports.
|
|
||||||
;; Mighty slow -- we read each char twice (peek first, then read).
|
|
||||||
(let lp ((i start))
|
|
||||||
(let ((c (peek-char port)))
|
|
||||||
(cond ((or (eof-object? c) ; Found terminating char or eof
|
|
||||||
(char-set-contains? delims c))
|
|
||||||
(if gobble? (read-char port))
|
|
||||||
(values c (- i start)))
|
|
||||||
|
|
||||||
((>= i end) ; Filled the buffer.
|
|
||||||
(values #f (- i start)))
|
|
||||||
|
|
||||||
(else (string-set! buf i (read-char port))
|
|
||||||
(lp (+ i 1)))))))))))))
|
|
||||||
|
|
||||||
; overwrites port-index :-(
|
; overwrites port-index :-(
|
||||||
(define (push-back port char)
|
(define (push-back port char)
|
||||||
|
|
Loading…
Reference in New Issue