Removed call to C code since it doesn't cooperate with non-blocking
fd's.
This commit is contained in:
parent
45f0550f79
commit
5fc995e50f
|
@ -1,13 +1,13 @@
|
|||
;;; Delimited readers
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; These procedures run their inner I/O loop in a C primitive, so they
|
||||
;;; should be quite fast.
|
||||
;;; These procedures ran their inner I/O loop in a C primitive in
|
||||
;;; earlier versions of scsh. In a multi-threaded environment this
|
||||
;;; causes lots of trouble in case the operation would
|
||||
;;; block. Therefore the current implementation runs in Scheme but
|
||||
;;; operates directly on the buffer of the port for speed. This also
|
||||
;;; allows us to implement the push-back behaviour without a peek/read
|
||||
;;; pair.
|
||||
;;;
|
||||
;;; N.B.:
|
||||
;;; The C primitive %READ-DELIMITED-FDPORT!/ERRNO relies on knowing the
|
||||
;;; representation of character sets. If these are changed from their
|
||||
;;; current representation as 256-element strings, this code must be changed
|
||||
;;; as well.
|
||||
|
||||
;;; (read-delimited delims [port delim-action])
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -192,12 +192,6 @@
|
|||
(start 0)
|
||||
(end (string-length buf)))
|
||||
|
||||
(check-arg input-port? port %read-delimited!) ; Arg checking.
|
||||
(check-arg char-set? delims %read-delimited!) ; Required, since
|
||||
(if (bogus-substring-spec? buf start end) ; we're calling C.
|
||||
(error "Illegal START/END substring indices"
|
||||
buf start end %read-delimited!))
|
||||
|
||||
(let* ((delims (->char-set delims))
|
||||
(sdelims (char-set:s delims)))
|
||||
(let lp ((start start) (total 0))
|
||||
|
@ -216,66 +210,17 @@
|
|||
(set-port-limit! port (+ (port-limit port) 1)))
|
||||
|
||||
|
||||
(foreign-init-name "rdelim")
|
||||
|
||||
(foreign-source
|
||||
"#include <sys/types.h>"
|
||||
""
|
||||
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
|
||||
"#include \"fdports1.h\""
|
||||
"" "")
|
||||
|
||||
(define-foreign %read-delimited-fd!/errno (read_delim (string delims)
|
||||
(var-string buf)
|
||||
(fixnum fd)
|
||||
(fixnum start)
|
||||
(fixnum end))
|
||||
desc ; int => errno; char => terminating char; eof-object; #f => buf ovflow
|
||||
fixnum) ; number of chars read into BUF.
|
||||
|
||||
|
||||
(define-foreign %skip-char-set-fd/errno (skip_chars (string skip-set)
|
||||
(fixnum fd))
|
||||
desc ; int => errno; char => win, pushback; #f => win w/eof.
|
||||
fixnum) ; number of chars skipped.
|
||||
|
||||
|
||||
|
||||
(define (skip-char-set skip-chars . maybe-port)
|
||||
(let* ((port (:optional maybe-port (current-input-port)))
|
||||
(cset (->char-set skip-chars))
|
||||
(scset (char-set:s cset)))
|
||||
|
||||
(cond ((not (input-port? port))
|
||||
(error "Illegal value -- not an input port." port))
|
||||
|
||||
;; Direct C support for Unix file ports -- zippy quick.
|
||||
((fdport? port)
|
||||
(let lp ((total 0))
|
||||
(receive (succ num-read) (buffer-skip-char-set cset port)
|
||||
(if (not succ)
|
||||
num-read
|
||||
(let lp ((total num-read))
|
||||
(receive (err num-read) (%skip-char-set-fd/errno
|
||||
scset (fdport-data:fd (fdport-data port)))
|
||||
(let ((total (+ total num-read)))
|
||||
(cond ((not err)
|
||||
(set-port-pending-eof?! port #t)
|
||||
total)
|
||||
((char? err)
|
||||
(push-back port err)
|
||||
total)
|
||||
((= errno/intr err) (lp total))
|
||||
(errno-error err skip-char-set cset port total))))))))
|
||||
|
||||
;; This is the code for other kinds of ports.
|
||||
;; Mighty slow -- we read each char twice (peek first, then read).
|
||||
(else (let lp ((i 0))
|
||||
(let ((c (peek-char port)))
|
||||
(cond ((and (char? c) (char-set-contains? cset c))
|
||||
(read-char port)
|
||||
(lp (+ i 1)))
|
||||
(else i))))))))
|
||||
|
||||
(+ total num-read) ; eof
|
||||
(begin (peek-char port); kludge to fill the buffer
|
||||
(lp (+ total num-read))))))))
|
||||
|
||||
(define (buffer-skip-char-set cset port)
|
||||
(let ((the-port-limit (port-limit port)))
|
||||
|
|
Loading…
Reference in New Issue