Removed call to C code since it doesn't cooperate with non-blocking

fd's.
This commit is contained in:
mainzelm 2000-09-20 10:12:31 +00:00
parent 45f0550f79
commit 5fc995e50f
1 changed files with 13 additions and 68 deletions

View File

@ -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)
(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))))))))
(let lp ((total 0))
(receive (succ num-read) (buffer-skip-char-set cset port)
(if (not succ)
(+ 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)))