13.1.9 Custom Ports (original) (raw)

13.1.9 Custom Ports🔗ℹ

The make-input-port and make-output-port procedures create custom ports with arbitrary control procedures (much like implementing a device driver). Custom ports are mainly useful to obtain fine control over the action of committing bytes as read or written.

(make-input-port name read-in peek close [get-progress-evt commit get-location count-lines! init-position buffer-mode]) → input-port?

name : any/c

close : (-> any)

get-progress-evt : (or/c (-> evt?) #f) = #f

count-lines! : (-> any) = void

(make-input-port name read-in peek close [get-progress-evt commit get-location count-lines! init-position buffer-mode]) → input-port?
name : any/c
close : (-> any)
get-progress-evt : (or/c (-> evt?) #f) = #f
count-lines! : (-> any) = void

Creates an input port, which is immediately open for reading. Ifclose procedure has no side effects, then the port need not be explicitly closed. See also make-input-port/read-to-peek.

The arguments implement the port as follows:

name — the name for the input port.

read-in — either an input port, in which case reads are redirected to the given port, or a procedure that takes a single argument: a mutable byte string to receive read bytes. The procedure’s result is one of the following:

the number of bytes read, as an exact, non-negative integer;
eof;
a procedure of arity four (representing a “special” result, as discussed further below), but a procedure result is allowed only when peek is not #f;
a pipe input port that supplies bytes to be used as long as the pipe has content (seepipe-content-length) or until read-in orpeek is called again; or

a synchronizable event (see Events) other than a pipe input port or procedure of arity four; the event becomes ready when the read is complete (roughly): the event’s value can be one of the above four results or another event like itself; in the last case, a reading process loops withsync until it gets a non-event result.
The read-in procedure must not block indefinitely. If no bytes are immediately available for reading, the read-in must return 0 or an event, and preferably an event (to avoid busy waits). The read-in should not return0 (or an event whose value is 0) when data is available in the port, otherwise polling the port will behave incorrectly. An event result from an event can also break polling.
If the result of a read-in call is not one of the above values, the exn:fail:contract exception is raised. If a returned integer is larger than the supplied byte string’s length, theexn:fail:contract exception is raised. If peek is #f and a procedure for a special result is returned, the exn:fail:contract exception is raised.
The read-in procedure can report an error by raising an exception, but only if no bytes are read. Similarly, no bytes should be read if eof, an event, or a procedure is returned. In other words, no bytes should be lost due to spurious exceptions or non-byte data.
A port’s reading procedure may be called in multiple threads simultaneously (if the port is accessible in multiple threads), and the port is responsible for its own internal synchronization. Note that improper implementation of such synchronization mechanisms might cause a non-blocking read procedure to block indefinitely.
If the result is a pipe input port, then previousget-progress-evt calls whose event is not yet ready must have been the pipe input port itself. Furthermore,get-progress-evt must continue to return the pipe as long as it contains data, or until the read-in orpeek-in procedure is called again (instead of using the pipe, for whatever reason). If read-in orpeek-in is called, any previously associated pipe (as returned by a previous call) is disassociated from the port and is not in use by any other thread as a result of the previous association.
If peek, get-progress-evt, andcommit are all provided and non-#f, then the following is an acceptable implementation of read-in:

(lambda (bstr)

(let* ([progress-evt (get-progress-evt)]

[v (peek bstr 0 progress-evt)])

(cond

[(sync/timeout 0 progress-evt) 0] ; try again

[(evt? v) (wrap-evt v (lambda (x) 0))] ; sync, try again

[(and (number? v) (zero? v)) 0] ; try again

[else

(if (commit (if (number? v) v 1)

progress-evt

always-evt)

v ; got a result

0)]))) ; try again

An implementor may choose not to implement the peek,get-progress-evt, and commit procedures, however, and even an implementor who does supply them may provide a different read-in that uses a fast path for non-blocking reads.

In an input port is provided for read-in, then an input port must also be provided for peek.

peek — either #f, an input port (in which case peeks are redirected to the given port), or a procedure that takes three arguments:
- a mutable byte string to receive peeked bytes;
- a non-negative number of bytes (orspecials) to skip before peeking; and
- either #f or a progress event produced byget-progress-evt.
  The results and conventions for peek are mostly the same as for read-in. The main difference is in the handling of the progress event, if it is not #f. If the given progress event becomes ready, the peek must abort any skip attempts and not peek any values. In particular,peek must not peek any values if the progress event is initially ready. If the port has been closed, the progress event should be ready, in which case peek should complete (instead of failing because the port is closed).
  Unlike read-in, peek should produce#f (or an event whose value is #f) if no bytes were peeked because the progress event became ready. Likeread-in, a 0 result indicates that another attempt is likely to succeed, so 0 is inappropriate when the progress event is ready. Also like read-in,peek must not block indefinitely. An event produced bypeek is polled (in the sense of poll-guard-evt) by an option like byte-ready? or peek-bytes-avail*!.
  The skip count provided to peek is a number of bytes (orspecials) that must remain present in the port—in addition to the peek results—when the peek results are reported. If the skip count requests reading data that is past an eof, it should not, and instead produce eof (until the eof is consumed).
  If a progress event is supplied, then the peek is effectively canceled when another process reads data before the given number can be skipped. If a progress event is not supplied and data is read, then the peek must effectively restart with the original skip count.
  The system does not check that multiple peeks return consistent results, or that peeking and reading produce consistent results, although they must.
  If peek is #f, then peeking for the port is implemented automatically in terms of reads, but with several limitations. First, the automatic implementation is not thread-safe. Second, the automatic implementation cannot handlespecial results (non-byte and non-eof), soread-in cannot return a procedure for aspecial when peek is#f. Finally, the automatic peek implementation is incompatible with progress events, so if peek is#f, then get-progress-evt and commit must be #f. See also make-input-port/read-to-peek, which implements peeking in terms of read-in without these constraints.
  In an input port is provided for peek, then an input port must also be provided for read-in.
close — a procedure of zero arguments that is called to close the port. The port is not considered closed until the closing procedure returns. The port’s procedures will never be used again via the port after it is closed. However, the closing procedure can be called simultaneously in multiple threads (if the port is accessible in multiple threads), and it may be called during a call to the other procedures in another thread; in the latter case, any outstanding reads and peeks should be terminated with an error.
get-progress-evt — either #f (the default), or a procedure that takes no arguments and returns an event. The event must become ready only after data is next read from the port or the port is closed. If the port is already closed, the event must be ready. After the event becomes ready, it must remain so. See the description of read-infor information about the allowed results of this function whenread-in returns a pipe input port. See alsosemaphore-peek-evt, which is sometimes useful for implementing get-progress-evt.
If get-progress-evt is #f, thenport-provides-progress-evts? applied to the port will produce #f, and the port will not be a valid argument toport-progress-evt.
The result event will not be exposed directly byport-progress-evt. Instead, it will be wrapped in an event for which progress-evt? returns true.
commit — either #f (the default), or a procedure that takes three arguments:
- an exact, positive integer kr;
- a progress event produced by get-progress-evt;
- an event, done, that is either a channel-put event, channel, semaphore, semaphore-peek event, always event, or never event.
  A commit corresponds to removing data from the stream that was previously peeked, but only if no other process removed data first. (The removed data does not need to be reported, because it has been peeked already.) More precisely, assuming that kp bytes, specials, and mid-stream eofs have been previously peeked or skipped at the start of the port’s stream, commit must satisfy the following constraints:
- It must return only when the commit is complete or when the given progress event becomes ready.
- It must commit only if kp is positive.
- If it commits, then it must do so with either kr items or kp items, whichever is smaller, and only if kp is positive.
- It must never choose done in a synchronization after the given progress event is ready, or after donehas been synchronized once.
- It must not treat any data as read from the port unlessdone is chosen in a synchronization.
- It must not block indefinitely if done is ready; it must return soon after the read completes or soon after the given progress event is ready, whichever is first.
- It can report an error by raising an exception, but only if no data has been committed. In other words, no data should be lost due to an exception, including a break exception.
- It must return a true value if data has been committed,#f otherwise. When it returns a value, the given progress event must be ready (perhaps because data has just been committed).
- It should return a byte string as a true result when line counting is enabled and get-location is #f (so that line counting is implemented the default way); the result byte string represents the data that was committed for the purposes of character and line counting. If any other true result is returned when a byte string is expected, it is treated like a byte string where each byte corresponds to a non-newline character.
- It must raise an exception if no data (includingeof) has been peeked from the beginning of the port’s stream, or if it would have to block indefinitely to wait for the given progress event to become ready.
  A call to commit is parameterize-breaked to disable breaks.
get-location — either #f (the default), or a procedure that takes no arguments and returns three values: the line number for the next item in the port’s stream (a positive number or #f), the column number for the next item in the port’s stream (a non-negative number or #f), and the position for the next item in the port’s stream (a positive number or #f). See also Counting Positions, Lines, and Columns.
This procedure is called to implement port-next-location, but only if line counting is enabled for the port viaport-count-lines! (in which case count-lines! is called). The read and read-syntax procedures assume that reading a non-whitespace character increments the column and position by one.
count-lines! — a procedure of no arguments that is called if and when line counting is enabled for the port. The default procedure is void.
init-position — normally an exact, positive integer that determines the position of the port’s first item, which is used by file-position or when line counting isnot enabled for the port. The default is 1. Ifinit-position is #f, the port is treated as having an unknown position. If init-position is a port, then the given port’s position is always used for the new port’s position. If init-position is a procedure, it is called as needed to obtain the port’s position.
buffer-mode — either #f (the default) or a procedure that accepts zero or one arguments. Ifbuffer-mode is #f, then the resulting port does not support a buffer-mode setting. Otherwise, the procedure is called with one symbol argument ('block or'none) to set the buffer mode, and it is called with zero arguments to get the current buffer mode. In the latter case, the result must be 'block, 'none, or #f(unknown). See Port Buffers and Positions for more information on buffer modes.

(lambda (bstr)
(let* ([progress-evt (get-progress-evt)]
[v (peek bstr 0 progress-evt)])
(cond
[(sync/timeout 0 progress-evt) 0] ; try again
[(evt? v) (wrap-evt v (lambda (x) 0))] ; sync, try again
[(and (number? v) (zero? v)) 0] ; try again
[else
(if (commit (if (number? v) v 1)
progress-evt
always-evt)
v ; got a result
0)]))) ; try again
An implementor may choose not to implement the peek,get-progress-evt, and commit procedures, however, and even an implementor who does supply them may provide a different read-in that uses a fast path for non-blocking reads.
In an input port is provided for read-in, then an input port must also be provided for peek.

“Special” results: Whenread-in or peek (or an event produced by one of these) returns a procedure, the procedure is used to obtain a non-byte result. (This non-byte result is not intended to return a character or eof; in particular, read-char raises an exception if it encounters a special-result procedure, even if the procedure produces a byte.) A special-result procedure must accept four arguments that represent a source location. The first argument is #f when the special read is triggered by read or read/recursive.

The special-value procedure can return an arbitrary value, and it will be called zero or one times (not necessarily before further reads or peeks from the port). See Reader-Extension Procedures for more details on the procedure’s result.

If read-in or peek returns a special procedure when called by any reading procedure other thanread, read-syntax, read-char-or-special,peek-char-or-special, read-byte-or-special, orpeek-byte-or-special, then the exn:fail:contract exception is raised.

Examples:

; A port with no input...

; Easy: (open-input-bytes #"")

; Hard:

> (read-char /dev/null-in)

#

> (peek-char /dev/null-in)

#

> (read-byte-or-special /dev/null-in)

#

> (peek-byte-or-special /dev/null-in 100)

#

; A port that produces a stream of 1s:

> (read-string 5 infinite-ones)

"11111"

; But we can't peek ahead arbitrarily far, because the

; automatic peek must record the skipped bytes, so

; we'd run out of memory.

; An infinite stream of 1s with a specific peek procedure:

> (read-string 5 infinite-ones)

"11111"

; Now we can peek ahead arbitrarily far:

> (peek-string 5 (expt 2 5000) infinite-ones)

"11111"

; The port doesn't supply procedures to implement progress events:

> (port-provides-progress-evts? infinite-ones)

#f

> (port-progress-evt infinite-ones)

port-progress-evt: port does not provide progress evts

port: #input-port:ones

; Non-byte port results:

> (read-char infinite-voids)

read-char: non-character in an unsupported context

port: #input-port:voids

> (read-char-or-special infinite-voids)

'void

; This port produces 0, 1, 2, 0, 1, 2, etc., but it is not

; thread-safe, because multiple threads might read and change n.

> (define mod3-cycle/one-thread (let* ([n 2] [mod! (lambda (s delta) (bytes-set! s 0 (+ 48 (modulo (+ n delta) 3))) 1)]) (make-input-port 'mod3-cycle/not-thread-safe (lambda (s) (set! n (modulo (add1 n) 3)) (mod! s 0)) (lambda (s skip evt) (mod! s skip)) void)))

> (read-string 5 mod3-cycle/one-thread)

"01201"

> (peek-string 5 (expt 2 5000) mod3-cycle/one-thread)

"20120"

; Same thing, but thread-safe and kill-safe, and with progress

; events. Only the server thread touches the stateful part

; directly. (See the output port examples for a simpler thread-safe

; example, but this one is more general.)

> (define (make-mod3-cycle) (define read-req-ch (make-channel)) (define peek-req-ch (make-channel)) (define progress-req-ch (make-channel)) (define commit-req-ch (make-channel)) (define close-req-ch (make-channel)) (define closed? #f) (define n 0) (define progress-sema #f) (define (mod! s delta) (bytes-set! s 0 (+ 48 (modulo (+ n delta) 3))) 1) ; —————————————- ; The server has a list of outstanding commit requests, ; and it also must service each port operation (read, ; progress-evt, etc.) (define (serve commit-reqs response-evts) (apply sync (handle-evt read-req-ch (handle-read commit-reqs response-evts)) (handle-evt progress-req-ch (handle-progress commit-reqs response-evts)) (handle-evt commit-req-ch (add-commit commit-reqs response-evts)) (handle-evt close-req-ch (handle-close commit-reqs response-evts)) (append (map (make-handle-response commit-reqs response-evts) response-evts) (map (make-handle-commit commit-reqs response-evts) commit-reqs)))) ; Read/peek request: fill in the string and commit (define ((handle-read commit-reqs response-evts) r) (let ([s (car r)] [skip (cadr r)] [ch (caddr r)] [nack (cadddr r)] [evt (car (cddddr r))] [peek? (cdr (cddddr r))]) (let ([fail? (and evt (sync/timeout 0 evt))]) (unless (or closed? fail?) (mod! s skip) (unless peek? (commit! 1))) ; Add an event to respond: (serve commit-reqs (cons (choice-evt nack (channel-put-evt ch (if closed? 0 (if fail? #f 1)))) response-evts))))) ; Progress request: send a peek evt for the current ; progress-sema (define ((handle-progress commit-reqs response-evts) r) (let ([ch (car r)] [nack (cdr r)]) (unless progress-sema (set! progress-sema (make-semaphore (if closed? 1 0)))) ; Add an event to respond: (serve commit-reqs (cons (choice-evt nack (channel-put-evt ch (semaphore-peek-evt progress-sema))) response-evts)))) ; Commit request: add the request to the list (define ((add-commit commit-reqs response-evts) r) (serve (cons r commit-reqs) response-evts)) ; Commit handling: watch out for progress, in which case ; the response is a commit failure; otherwise, try ; to sync for a commit. In either event, remove the ; request from the list (define ((make-handle-commit commit-reqs response-evts) r) (let ([k (car r)] [progress-evt (cadr r)] [done-evt (caddr r)] [ch (cadddr r)] [nack (cddddr r)]) ; Note: we don't check that k is <= the sum of ; previous peeks, because the entire stream is actually ; known, but we could send an exception in that case. (choice-evt (handle-evt progress-evt (lambda (x) (sync nack (channel-put-evt ch #f)) (serve (remq r commit-reqs) response-evts))) ; Only create an event to satisfy done-evt if progress-evt ; isn't already ready. ; Afterward, if progress-evt becomes ready, then this ; event-making function will be called again, because ; the server controls all posts to progress-evt. (if (sync/timeout 0 progress-evt) never-evt (handle-evt done-evt (lambda (v) (commit! k) (sync nack (channel-put-evt ch #t)) (serve (remq r commit-reqs) response-evts))))))) ; Response handling: as soon as the respondee listens, ; remove the response (define ((make-handle-response commit-reqs response-evts) evt) (handle-evt evt (lambda (x) (serve commit-reqs (remq evt response-evts))))) ; Close handling: post the progress sema, if any, and set ; the closed? flag (define ((handle-close commit-reqs response-evts) r) (let ([ch (car r)] [nack (cdr r)]) (set! closed? #t) (when progress-sema (semaphore-post progress-sema)) (serve commit-reqs (cons (choice-evt nack (channel-put-evt ch (void))) response-evts)))) ; Helper for reads and post-peek commits: (define (commit! k) (when progress-sema (semaphore-post progress-sema) (set! progress-sema #f)) (set! n (+ n k))) ; Start the server thread: (define server-thread (thread (lambda () (serve null null)))) ; —————————————- ; Client-side helpers: (define (req-evt f) (nack-guard-evt (lambda (nack) ; Be sure that the server thread is running: (thread-resume server-thread (current-thread)) ; Create a channel to hold the reply: (let ([ch (make-channel)]) (f ch nack) ch)))) (define (read-or-peek-evt s skip evt peek?) (req-evt (lambda (ch nack) (channel-put read-req-ch (list* s skip ch nack evt peek?))))) ; Make the port: (make-input-port 'mod3-cycle ; Each handler for the port just sends ; a request to the server (lambda (s) (read-or-peek-evt s 0 #f #f)) (lambda (s skip evt) (read-or-peek-evt s skip evt #t)) (lambda () ; close (sync (req-evt (lambda (ch nack) (channel-put progress-req-ch (list* ch nack)))))) (lambda () ; progress-evt (sync (req-evt (lambda (ch nack) (channel-put progress-req-ch (list* ch nack)))))) (lambda (k progress-evt done-evt) ; commit (sync (req-evt (lambda (ch nack) (channel-put commit-req-ch (list* k progress-evt done-evt ch nack))))))))

> (define mod3-cycle (make-mod3-cycle))

> (let ([result1 #f] [result2 #f]) (let ([t1 (thread (lambda () (set! result1 (read-string 5 mod3-cycle))))] [t2 (thread (lambda () (set! result2 (read-string 5 mod3-cycle))))]) (thread-wait t1) (thread-wait t2) (string-append result1 "," result2)))

"11120,02020"

> (define s (make-bytes 1))

> (define progress-evt (port-progress-evt mod3-cycle))

> (peek-bytes-avail! s 0 progress-evt mod3-cycle)

1

> s

#"1"

#t

> (sync/timeout 0 progress-evt)

#

> (peek-bytes-avail! s 0 progress-evt mod3-cycle)

0

#f

> (close-input-port mod3-cycle)

; A port with no input...
; Easy: (open-input-bytes #"")
; Hard:
> (read-char /dev/null-in)
#
> (peek-char /dev/null-in)
#
> (read-byte-or-special /dev/null-in)
#
> (peek-byte-or-special /dev/null-in 100)
#
; A port that produces a stream of 1s:
> (read-string 5 infinite-ones)
"11111"
; But we can't peek ahead arbitrarily far, because the
; automatic peek must record the skipped bytes, so
; we'd run out of memory.
; An infinite stream of 1s with a specific peek procedure:
> (read-string 5 infinite-ones)
"11111"
; Now we can peek ahead arbitrarily far:
> (peek-string 5 (expt 2 5000) infinite-ones)
"11111"
; The port doesn't supply procedures to implement progress events:
> (port-provides-progress-evts? infinite-ones)
#f
> (port-progress-evt infinite-ones)
port-progress-evt: port does not provide progress evts
port: #input-port:ones
; Non-byte port results:
> (read-char infinite-voids)
read-char: non-character in an unsupported context
port: #input-port:voids
> (read-char-or-special infinite-voids)
'void
; This port produces 0, 1, 2, 0, 1, 2, etc., but it is not
; thread-safe, because multiple threads might read and change n.
> (define mod3-cycle/one-thread (let* ([n 2] [mod! (lambda (s delta) (bytes-set! s 0 (+ 48 (modulo (+ n delta) 3))) 1)]) (make-input-port 'mod3-cycle/not-thread-safe (lambda (s) (set! n (modulo (add1 n) 3)) (mod! s 0)) (lambda (s skip evt) (mod! s skip)) void)))
> (read-string 5 mod3-cycle/one-thread)
"01201"
> (peek-string 5 (expt 2 5000) mod3-cycle/one-thread)
"20120"
; Same thing, but thread-safe and kill-safe, and with progress
; events. Only the server thread touches the stateful part
; directly. (See the output port examples for a simpler thread-safe
; example, but this one is more general.)
> (define (make-mod3-cycle) (define read-req-ch (make-channel)) (define peek-req-ch (make-channel)) (define progress-req-ch (make-channel)) (define commit-req-ch (make-channel)) (define close-req-ch (make-channel)) (define closed? #f) (define n 0) (define progress-sema #f) (define (mod! s delta) (bytes-set! s 0 (+ 48 (modulo (+ n delta) 3))) 1) ; —————————————- ; The server has a list of outstanding commit requests, ; and it also must service each port operation (read, ; progress-evt, etc.) (define (serve commit-reqs response-evts) (apply sync (handle-evt read-req-ch (handle-read commit-reqs response-evts)) (handle-evt progress-req-ch (handle-progress commit-reqs response-evts)) (handle-evt commit-req-ch (add-commit commit-reqs response-evts)) (handle-evt close-req-ch (handle-close commit-reqs response-evts)) (append (map (make-handle-response commit-reqs response-evts) response-evts) (map (make-handle-commit commit-reqs response-evts) commit-reqs)))) ; Read/peek request: fill in the string and commit (define ((handle-read commit-reqs response-evts) r) (let ([s (car r)] [skip (cadr r)] [ch (caddr r)] [nack (cadddr r)] [evt (car (cddddr r))] [peek? (cdr (cddddr r))]) (let ([fail? (and evt (sync/timeout 0 evt))]) (unless (or closed? fail?) (mod! s skip) (unless peek? (commit! 1))) ; Add an event to respond: (serve commit-reqs (cons (choice-evt nack (channel-put-evt ch (if closed? 0 (if fail? #f 1)))) response-evts))))) ; Progress request: send a peek evt for the current ; progress-sema (define ((handle-progress commit-reqs response-evts) r) (let ([ch (car r)] [nack (cdr r)]) (unless progress-sema (set! progress-sema (make-semaphore (if closed? 1 0)))) ; Add an event to respond: (serve commit-reqs (cons (choice-evt nack (channel-put-evt ch (semaphore-peek-evt progress-sema))) response-evts)))) ; Commit request: add the request to the list (define ((add-commit commit-reqs response-evts) r) (serve (cons r commit-reqs) response-evts)) ; Commit handling: watch out for progress, in which case ; the response is a commit failure; otherwise, try ; to sync for a commit. In either event, remove the ; request from the list (define ((make-handle-commit commit-reqs response-evts) r) (let ([k (car r)] [progress-evt (cadr r)] [done-evt (caddr r)] [ch (cadddr r)] [nack (cddddr r)]) ; Note: we don't check that k is <= the sum of ; previous peeks, because the entire stream is actually ; known, but we could send an exception in that case. (choice-evt (handle-evt progress-evt (lambda (x) (sync nack (channel-put-evt ch #f)) (serve (remq r commit-reqs) response-evts))) ; Only create an event to satisfy done-evt if progress-evt ; isn't already ready. ; Afterward, if progress-evt becomes ready, then this ; event-making function will be called again, because ; the server controls all posts to progress-evt. (if (sync/timeout 0 progress-evt) never-evt (handle-evt done-evt (lambda (v) (commit! k) (sync nack (channel-put-evt ch #t)) (serve (remq r commit-reqs) response-evts))))))) ; Response handling: as soon as the respondee listens, ; remove the response (define ((make-handle-response commit-reqs response-evts) evt) (handle-evt evt (lambda (x) (serve commit-reqs (remq evt response-evts))))) ; Close handling: post the progress sema, if any, and set ; the closed? flag (define ((handle-close commit-reqs response-evts) r) (let ([ch (car r)] [nack (cdr r)]) (set! closed? #t) (when progress-sema (semaphore-post progress-sema)) (serve commit-reqs (cons (choice-evt nack (channel-put-evt ch (void))) response-evts)))) ; Helper for reads and post-peek commits: (define (commit! k) (when progress-sema (semaphore-post progress-sema) (set! progress-sema #f)) (set! n (+ n k))) ; Start the server thread: (define server-thread (thread (lambda () (serve null null)))) ; —————————————- ; Client-side helpers: (define (req-evt f) (nack-guard-evt (lambda (nack) ; Be sure that the server thread is running: (thread-resume server-thread (current-thread)) ; Create a channel to hold the reply: (let ([ch (make-channel)]) (f ch nack) ch)))) (define (read-or-peek-evt s skip evt peek?) (req-evt (lambda (ch nack) (channel-put read-req-ch (list* s skip ch nack evt peek?))))) ; Make the port: (make-input-port 'mod3-cycle ; Each handler for the port just sends ; a request to the server (lambda (s) (read-or-peek-evt s 0 #f #f)) (lambda (s skip evt) (read-or-peek-evt s skip evt #t)) (lambda () ; close (sync (req-evt (lambda (ch nack) (channel-put progress-req-ch (list* ch nack)))))) (lambda () ; progress-evt (sync (req-evt (lambda (ch nack) (channel-put progress-req-ch (list* ch nack)))))) (lambda (k progress-evt done-evt) ; commit (sync (req-evt (lambda (ch nack) (channel-put commit-req-ch (list* k progress-evt done-evt ch nack))))))))
> (define mod3-cycle (make-mod3-cycle))
> (let ([result1 #f] [result2 #f]) (let ([t1 (thread (lambda () (set! result1 (read-string 5 mod3-cycle))))] [t2 (thread (lambda () (set! result2 (read-string 5 mod3-cycle))))]) (thread-wait t1) (thread-wait t2) (string-append result1 "," result2)))
"11120,02020"
> (define s (make-bytes 1))
> (define progress-evt (port-progress-evt mod3-cycle))
> (peek-bytes-avail! s 0 progress-evt mod3-cycle)
1
> s
#"1"
#t
> (sync/timeout 0 progress-evt)
#
> (peek-bytes-avail! s 0 progress-evt mod3-cycle)
0
#f
> (close-input-port mod3-cycle)

(make-output-port name evt write-out close [write-out-special get-write-evt get-write-special-evt get-location count-lines! init-position buffer-mode]) → output-port?

name : any/c

evt : evt?

close : (-> any)

get-write-special-evt : = #f

count-lines! : (-> any) = void

(make-output-port name evt write-out close [write-out-special get-write-evt get-write-special-evt get-location count-lines! init-position buffer-mode]) → output-port?
name : any/c
evt : evt?
close : (-> any)
get-write-special-evt : = #f
count-lines! : (-> any) = void

Creates an output port, which is immediately open for writing. If close procedure has no side effects, then the port need not be explicitly closed. The port can buffer data within its write-out and write-out-specialprocedures.

name — the name for the output port.
evt — a synchronization event (see Events; e.g., a semaphore or another port). The event is used in place of the output port when the port is supplied to synchronization procedures like sync. Thus, the event should be unblocked when the port is ready for writing at least one byte without blocking, or ready to make progress in flushing an internal buffer without blocking. The event must not unblock unless the port is ready for writing; otherwise, the guarantees ofsync will be broken for the output port. Usealways-evt if writes to the port always succeed without blocking.
write-out — either an output port, which indicates that writes should be redirected to the given port, or a procedure of five arguments:
- an immutable byte string containing bytes to write;
- a non-negative exact integer for a starting offset (inclusive) into the byte string;
- a non-negative exact integer for an ending offset (exclusive) into the byte string;
- a boolean; #f indicates that the port is allowed to keep the written bytes in a buffer, and that it is allowed to block indefinitely; #t indicates that the write should not block, and that the port should attempt to flush its buffer and completely write new bytes instead of buffering them;
- a boolean; #t indicates that if the port blocks for a write, then it should enable breaks while blocking (e.g., using sync/enable-break); this argument is always#f if the fourth argument is #t.
  The procedure returns one of the following:
- a non-negative exact integer representing the number of bytes written or buffered;
- #f if no bytes could be written, perhaps because the internal buffer could not be completely flushed;
- a pipe output port (when buffering is allowed and not when flushing) for buffering bytes as long as the pipe is not full and until write-out orwrite-out-special is called; or
- a synchronizable event (see Events) other than a pipe output port that acts like the result ofwrite-bytes-avail-evt to complete the write.
  Since write-out can produce an event, an acceptable implementation of write-out is to pass its first three arguments to the port’s get-write-evt. Some port implementors, however, may choose not to provideget-write-evt (perhaps because writes cannot be made atomic), or may implement write-out to enable a fast path for non-blocking writes or to enable buffering.
  From a user’s perspective, the difference between buffered and completely written data is (1) buffered data can be lost in the future due to a failed write, and (2) flush-output forces all buffered data to be completely written. Under no circumstances is buffering required.
  If the start and end indices are the same, then the fourth argument to write-out will be #f, and the write request is actually a flush request for the port’s buffer (if any), and the result should be 0 for a successful flush (or if there is no buffer).
  The result should never be 0 if the start and end indices are different, otherwise the exn:fail:contract exception is raised. Similarly, the exn:fail:contract exception is raised if write-outreturns a pipe output port when buffering is disallowed or when it is called for flushing. If a returned integer is larger than the supplied byte-string range, the exn:fail:contract exception is raised.
  The #f result should be avoided, unless the next write attempt is likely to work. Otherwise, if data cannot be written, return an event instead.
An event returned by write-out can return #f or another event like itself, in contrast to events produced bywrite-bytes-avail-evt or get-write-evt. A writing process loops with sync until it obtains a non-event result.
The write-out procedure is always called with breaks disabled, independent of whether breaks were enabled when the write was requested by a client of the port. If breaks were enabled for a blocking operation, then the fifth argument to write-outwill be #t, which indicates that write-out should re-enable breaks while blocking.
If the writing procedure raises an exception, due to write or commit operations, it must not have committed any bytes (though it may have committed previously buffered bytes).
A port’s writing procedure may be called in multiple threads simultaneously (if the port is accessible in multiple threads). The port is responsible for its own internal synchronization. Note that improper implementation of such synchronization mechanisms might cause a non-blocking write procedure to block.
close — a procedure of zero arguments that is called to close the port. The port is not considered closed until the closing procedure returns. The port’s procedures will never be used again via the port after it is closed. However, the closing procedure can be called simultaneously in multiple threads (if the port is accessible in multiple threads), and it may be called during a call to the other procedures in another thread; in the latter case, any outstanding writes or flushes should be terminated immediately with an error.
write-out-special — either #f (the default), an output port (which indicates that special writes should be redirected to the given port), or a procedure to handle write-special calls for the port. If #f, then the port does not support special output, and port-writes-special? will return#f when applied to the port.
If a procedure is supplied, it takes three arguments: the special value to write, a boolean that is #f if the procedure can buffer the special value and block indefinitely, and a boolean that is #t if the procedure should enable breaks while blocking. The result is one of the following:
- a non-event true value, which indicates that the special is written;
- #f if the special could not be written, perhaps because an internal buffer could not be completely flushed;
- a synchronizable event (see Events) that acts like the result of get-write-special-evt to complete the write.
  Since write-out-special can return an event, passing the first argument to an implementation ofget-write-special-evt is acceptable as awrite-out-special.
  As for write-out, the #f result is discouraged, since it can lead to busy waiting. Also as for write-out, an event produced by write-out-special is allowed to produce #f or another event like itself. Thewrite-out-special procedure is always called with breaks disabled, independent of whether breaks were enabled when the write was requested by a client of the port.
get-write-evt — either #f (the default) or a procedure of three arguments:
- an immutable byte string containing bytes to write;
- a non-negative exact integer for a starting offset (inclusive) into the byte string; and
- a non-negative exact integer for an ending offset (exclusive) into the byte string.
  The result is a synchronizable event (see Events) to act as the result of write-bytes-avail-evt for the port (i.e., to complete a write or flush), which becomes available only as data is committed to the port’s underlying device, and whose result is the number of bytes written.
  If get-write-evt is #f, thenport-writes-atomic? will produce #f when applied to the port, and the port will not be a valid argument to procedures such as write-bytes-avail-evt. Otherwise, an event returned by get-write-evt must not cause data to be written to the port unless the event is chosen in a synchronization, and it must write to the port if the event is chosen (i.e., the write must appear atomic with respect to the synchronization).
  If the event’s result integer is larger than the supplied byte-string range, the exn:fail:contract exception is raised by a wrapper on the event. If the start and end indices are the same (i.e., no bytes are to be written), then the event should produce 0 when the buffer is completely flushed. (If the port has no buffer, then it is effectively always flushed.)
  If the event raises an exception, due to write or commit operations, it must not have committed any new bytes (though it may have committed previously buffered bytes).
  Naturally, a port’s events may be used in multiple threads simultaneously (if the port is accessible in multiple threads). The port is responsible for its own internal synchronization.
get-write-special-evt — either #f(the default), or a procedure to handle write-special-evtcalls for the port. This argument must be #f if eitherwrite-out-special or get-write-evtis #f, and it must be a procedure if both of those arguments are procedures.
If it is a procedure, it takes one argument: the special value to write. The resulting event (with its constraints) is analogous to the result of get-write-evt.
If the event raises an exception, due to write or commit operations, it must not have committed the special value (though it may have committed previously buffered bytes and values).
get-location — either #f (the default), or a procedure that takes no arguments and returns three values: the line number for the next item written to the port’s stream (a positive number or #f), the column number for the next item written to port’s stream (a non-negative number or#f), and the position for the next item written to port’s stream (a positive number or #f). See alsoCounting Positions, Lines, and Columns.
This procedure is called to implement port-next-locationfor the port, but only if line counting is enabled for the port via port-count-lines! (in which casecount-lines! is called).
count-lines! — a procedure of no arguments that is called if and when line counting is enabled for the port. The default procedure is void.
init-position — normally an exact, positive integer that determines the position of the port’s first item, which is used by file-position or when line counting isnot enabled for the port. The default is 1. Ifinit-position is #f, the port is treated as having an unknown position. If init-position is a port, then the given port’s position is always used for the new port’s position. If init-position is a procedure, it is called as needed to obtain the port’s position.
buffer-mode — either #f (the default) or a procedure that accepts zero or one arguments. Ifbuffer-mode is #f, then the resulting port does not support a buffer-mode setting. Otherwise, the procedure is called with one symbol argument ('block,'line, or 'none) to set the buffer mode, and it is called with zero arguments to get the current buffer mode. In the latter case, the result must be 'block, 'line,'none, or #f (unknown). See Port Buffers and Positionsfor more information on buffer modes.

Examples: