Clarifications and fixes for set-port-buffering.
This commit is contained in:
parent
5cd0763723
commit
2a352215df
|
@ -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}
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue