12.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.

The arguments implement the port as follows:

• name – the name for the input port.

• read-in – 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) and optionally of arity zero, 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 (see pipe-content-length) or until read-in or peek 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 one of the above three results or another event like itself; in the last case, a reading process loops with sync 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 return 0 (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, the exn: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 previous get-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 or peek-in procedure is called again (instead of using the pipe, for whatever reason). If read-in or peek-in is called, any previously associated pipe (as returned by a previous call) will have been 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, and commit 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.

• peek – either #f or a procedure that takes three arguments:

  • a mutable byte string to receive peeked bytes;

  • a non-negative number of bytes (or specials) to skip before peeking; and

  • either #f or a progress event produced by get-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.

  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. Like read-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.

  The skip count provided to peek is a number of bytes (or specials) that must remain present in the port – in addition to the peek results – when the peek results are reported. 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.

  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 handle special results (non-byte and non-eof), so read-in cannot return a procedure for a special when peek is #f. Finally, the automatic peek implementation is incompatible with progress events, so if peek is #f, then progress-evt and commit must be #f. See also make-input-port/peek-to-read, which implements peeking in terms of read-in without these constraints.

• 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. After the event becomes ready, it must remain so. See the description of read-in for information about the allowed results of this function when read-in returns a pipe input port. See also semaphore-peek-evt, which is sometimes useful for implementing get-progress-evt.

  If get-progress-evt is #f, then port-provides-progress-evts? applied to the port will produce #f, and the port will not be a valid argument to port-progress-evt.

• 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 done has been synchronized once.

  • It must not treat any data as read from the port unless done 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 is 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 is committed, #f otherwise. When it returns a value, the given progress event must be ready (perhaps because data was just committed).

  • It must raise an exception if no data (including eof) 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 via port-count-lines! (in which case count-lines! is called). The read, read-syntax, read-honu, and read-honu-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 – an exact, positive integer that determines the position of the port’s first item, used when line counting is not enabled for the port. The default is 1.

• buffer-mode – either #f (the default) or a procedure that accepts zero or one arguments. If buffer-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.

“Special” results: When read-in or peek (or an event produced by one of these) returns a procedure, and 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, and it can optionally accept zero arguments:

• When the special read is triggered by read-syntax, read-honu-syntax, or read-syntax/recursive, the procedure is passed four arguments that represent a source location.

• When the special read is triggered by read, read-honu, read-byte-or-special, read-char-or-special, peek-byte-or-special, or peek-char-or-special, the procedure is passed no arguments if it accepts zero arguments, otherwise it is passed four arguments that are all #f.

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 than read, read-syntax, read-honu, read-honu-syntax, read-char-or-special, peek-char-or-special, read-byte-or-special, or peek-byte-or-special, then the exn:fail:contract exception is raised.

Examples:

; A port with no input...

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

; Hard:

> (define /dev/null-in       (make-input-port 'null                        (lambda (s) eof)                        (lambda (skip s progress-evt) eof)                        void                        (lambda () never-evt)                        (lambda (k progress-evt done-evt)                          (error "no successful peeks!"))))

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

#<eof>

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

#<eof>

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

#<eof>

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

#<eof>

; A port that produces a stream of 1s:

> (define infinite-ones       (make-input-port        'ones        (lambda (s)          (bytes-set! s 0 (char->integer #\1)) 1)        #f        void))

> (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:

> (define infinite-ones       (let ([one! (lambda (s)                     (bytes-set! s 0 (char->integer #\1)) 1)])         (make-input-port          'ones          one!          (lambda (s skip progress-evt) (one! s))          void)))

> (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:

#<input-port:ones>

; Non-byte port results:

> (define infinite-voids       (make-input-port        'voids        (lambda (s) (lambda args 'void))        (lambda (skip s evt) (lambda args 'void))        void))

> (read-char infinite-voids)

read-char: non-character in an unsupported context, from

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)))

"12012,00120"

> (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"

> (port-commit-peeked 1 progress-evt (make-semaphore 1)                         mod3-cycle)

#t

> (sync/timeout 0 progress-evt)

#<progress-evt>

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

0

> (port-commit-peeked 1 progress-evt (make-semaphore 1)                         mod3-cycle)

#f

> (close-input-port mod3-cycle)

• 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 of sync will be broken for the output port. Use always-evt if writes to the port always succeed without blocking.

• write-out – 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 or write-out-special is called; or

  • a synchronizable event (see Events) other than a pipe output port that acts like the result of write-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 provide get-write-evt (perhaps because writes cannot be made atomic), or may implement write-proc 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-out returns 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 by write-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-out will be #t, which indicates that write-out should re-enable breaks while blocking.

  If the writing procedure raises an exception, due either 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), 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 of get-write-special-evt is acceptable as an write-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. The write-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, then port-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 either 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-evt calls for the port. This argument must be #f if either write-out-special or get-write-evt is #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 either 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 also Counting Positions, Lines, and Columns.

  This procedure is called to implement port-next-location for the port, but only if line counting is enabled for the port via port-count-lines! (in which case count-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 – an exact, positive integer that determines the position of the port’s first output item, used when line counting is not enabled for the port. The default is 1.

• buffer-mode – either #f (the default) or a procedure that accepts zero or one arguments. If buffer-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 Positions for more information on buffer modes.

Examples:

; A port that writes anything to nowhere:

> (define /dev/null-out       (make-output-port        'null        always-evt        (lambda (s start end non-block? breakable?) (- end start))        void        (lambda (special non-block? breakable?) #t)        (lambda (s start end) (wrap-evt                               always-evt                               (lambda (x)                                 (- end start))))        (lambda (special) always-evt)))

> (display "hello" /dev/null-out)

> (write-bytes-avail #"hello" /dev/null-out)

5

> (write-special 'hello /dev/null-out)

#t

> (sync (write-bytes-avail-evt #"hello" /dev/null-out))

5

; A port that accumulates bytes as characters in a list,

;  but not in a thread-safe way:

> (define accum-list null)

> (define accumulator/not-thread-safe       (make-output-port        'accum/not-thread-safe        always-evt        (lambda (s start end non-block? breakable?)          (set! accum-list                (append accum-list                        (map integer->char                             (bytes->list (subbytes s start end)))))          (- end start))        void))

> (display "hello" accumulator/not-thread-safe)

> accum-list

'(#\h #\e #\l #\l #\o)

; Same as before, but with simple thread-safety:

> (define accum-list null)

> (define accumulator       (let* ([lock (make-semaphore 1)]              [lock-peek-evt (semaphore-peek-evt lock)])         (make-output-port          'accum          lock-peek-evt          (lambda (s start end non-block? breakable?)            (if (semaphore-try-wait? lock)                (begin                  (set! accum-list                        (append accum-list                                (map integer->char                                     (bytes->list                                      (subbytes s start end)))))                  (semaphore-post lock)                  (- end start))                ; Cheap strategy: block until the list is unlocked,                ;   then return 0, so we get called again                (wrap-evt                 lock-peek                 (lambda (x) 0))))          void)))

> (display "hello" accumulator)

> accum-list

'(#\h #\e #\l #\l #\o)

; A port that transforms data before sending it on

;  to another port. Atomic writes exploit the

;  underlying port's ability for atomic writes.

> (define (make-latin-1-capitalize port)       (define (byte-upcase s start end)         (list->bytes          (map (lambda (b) (char->integer                            (char-upcase                             (integer->char b))))               (bytes->list (subbytes s start end)))))       (make-output-port        'byte-upcase        ; This port is ready when the original is ready:        port        ; Writing procedure:        (lambda (s start end non-block? breakable?)          (let ([s (byte-upcase s start end)])            (if non-block?                (write-bytes-avail* s port)                (begin                  (display s port)                  (bytes-length s)))))        ; Close procedure – close original port:        (lambda () (close-output-port port))        #f        ; Write event:        (and (port-writes-atomic? port)             (lambda (s start end)               (write-bytes-avail-evt                (byte-upcase s start end)                port)))))

> (define orig-port (open-output-string))

> (define cap-port (make-latin-1-capitalize orig-port))

> (display "Hello" cap-port)

> (get-output-string orig-port)

"HELLO"

> (sync (write-bytes-avail-evt #"Bye" cap-port))

3

> (get-output-string orig-port)

"HELLOBYE"