Clarifications and fixes for set-port-buffering.

This commit is contained in:
mainzelm 2003-01-07 13:35:54 +00:00
parent 5cd0763723
commit 2a352215df
2 changed files with 49 additions and 26 deletions

View File

@ -957,6 +957,12 @@ this reason, all shells, including sh, csh, and scsh, read stdin unbuffered.
Applications that can tolerate buffered input on stdin can reset
\ex{(current-input-port)} to block buffering for higher performance.
\note{So support \texttt{peek-char} a Scheme implementation has to
maintain a buffer for all input ports. In scsh, for ``unbuffered''
input ports the buffer size is one. As you cannot request less then
one character there is no unrequested reading so this can still be
called ``unbuffered input''.}
\begin{defundesc}{set-port-buffering}{port policy [size]}\undefined
This procedure allows the programmer to assign a particular I/O buffering
policy to a port, and to choose the size of the associated buffer.
@ -966,7 +972,7 @@ There are three buffering policies that may be chosen:
\begin{tabular}{l@{\qquad}l}
\ex{bufpol/block} & General block buffering (general default) \\
\ex{bufpol/line} & Line buffering (tty default) \\
\ex{bufpol/none} & Direct I/O---no buffering
\ex{bufpol/none} & Direct I/O---no buffering\footnote{But see the note above}
\end{tabular}
\end{inset}
The line buffering policy flushes output whenever a newline is output;
@ -975,10 +981,13 @@ Line buffering is the default for ports open on terminal devices.
\oops{The current implementation doesn't support \ex{bufpol/line}.}
The \var{size} argument requests an I/O buffer of \var{size} bytes.
If not given, a reasonable default is used; if given and zero,
buffering is turned off
(\ie, $\var{size} = 0$ for any policy is equivalent to
$\var{policy} = \ex{bufpol/none}$).
For output ports, \var{size} must be non-negative, for input ports
\var{size} must be positve. If not given, a reasonable default is
used. For output ports, if given and zero, buffering is turned off
(\ie, $\var{size} = 0$ for any policy is equivalent to $\var{policy} =
\ex{bufpol/none}$). For input ports, setting the size to one
corresponds to unbuffered input as defined above. If given, \var{size}
must be zero respectively one for \ex{bufpol/none}.
\end{defundesc}
\begin{defundesc}{force-output} {[fd/port]}{\undefined}

View File

@ -176,35 +176,47 @@
(define (set-port-buffering port policy . maybe-size)
(cond ((and (fdport? port) (open-input-port? port))
(let ((size (if (pair? maybe-size) (car maybe-size) 255)))
(let ((size (if (pair? maybe-size) (car maybe-size)
(if (= policy bufpol/none) 1 255))))
(if (<= size 0)
(error "buffer size must be at least 1 for input ports"
port policy size))
(set-input-port-buffering port policy size)))
((and (fdport? port) (open-output-port? port))
(let ((size (if (pair? maybe-size) (car maybe-size) 255)))
(if (<= size 0) (error "size must be at least 1"))
(let ((size (if (pair? maybe-size) (car maybe-size)
(if (= policy bufpol/none) 0 255))))
(if (< size 0)
(error "buffer size must be at least 0 for output ports"
port policy size))
(set-output-port-buffering port policy size)))
(else
(warn "port-type not supported" port))))
(error "Not a port" port))))
(define (set-output-port-buffering port policy size)
(define (set-output-port-buffering port policy size)
(cond ((eq? policy bufpol/none)
(if (not (= size 0))
(error "buffer size must be 0 for bufpol/none on output ports"
port policy size))
(install-nullbuffer port unbuffered-output-fdport-handler))
((eq? policy bufpol/block)
(let ((old-size (byte-vector-length (port-buffer port)))
(new-buffer (make-byte-vector size 0)))
(if (< size old-size)
(begin
(really-force-output port)
(obtain-port-lock port)
(set-port-index! port 0))
(begin
(obtain-port-lock port)
(copy-bytes! (port-buffer port) 0 new-buffer 0 old-size)))
(install-buffer port new-buffer size)
(release-port-lock port)))
((eq? policy bufpol/line)
(if (= size 0)
(install-nullbuffer port unbuffered-output-fdport-handler)
(let ((old-size (byte-vector-length (port-buffer port)))
(new-buffer (make-byte-vector size 0)))
(if (< size old-size)
(begin
(really-force-output port)
(obtain-port-lock port)
(set-port-index! port 0))
(begin
(obtain-port-lock port)
(copy-bytes! (port-buffer port) 0 new-buffer 0 old-size)))
(install-buffer port new-buffer size)
(release-port-lock port))))
((eq? policy bufpol/line)
;(install-nullbuffer port (make-line-output-proc size)))
(error "bufpol/line is currently not supported"))
(else (warn "policy not supported " policy))))
(else (error "policy not supported " policy))))
(define (install-nullbuffer port handler)
(really-force-output port)
@ -253,13 +265,15 @@
(define (set-input-port-buffering port policy size)
(cond ((eq? policy bufpol/none)
(if (not (= size 1))
(error "buffer size must be 1 for bufpol/none on input ports"
port policy size))
(set-input-port-buffering port bufpol/block 1))
((eq? policy bufpol/block)
(if (<= size 0) (error "size must be at least 1"))
(install-input-handler port input-fdport-handler size #t))
((eq? policy bufpol/line)
(error "bufpol/line not allowed on input"))
(else (warn "policy not supported " policy))))
(else (error "policy not supported " policy))))
(define (install-input-handler port new-handler size gentle?)
(obtain-port-lock port)