#|

In order to be thread safe, size must be zero and the handler procedures

must obtain the tc-mutex or use some other mechanism to guarantee mutual

exclusion while manipulating the buffer.

The built-in handlers for binary file output ports are thread-safe iff

the buffer mode is none. The handlers for input ports are not thread-safe,

since the buffer size may be non-zero to handle lookahead and ungetting.

In order to be safe for continuation-based multitasking, the buffer must

be manipulated only by inline code (which runs between interrupt traps) or

within a critical section. The built-in file handlers are task-safe, but

the handlers for custom ports and for bytevector ports are not.

In general caller will check immutable properties of inputs but the

handler must check mutable properties of inputs because other threads may

change those properties. For example, handlers need not check the types

of most input values (e.g., ports, octets, bytevectors) but do have to

check for closed ports. (Position and length arguments are an exception,

since they may vary by kind of port.) Furthermore, handlers, including put

and get, should not expect the buffer to be full or empty when they are

called, since in general this cannot be guaranteed if multiple tasks or

threads are running. On the other hand, handlers generally won't be

called for every operation on a port, since data is usually inserted into

or taken from the buffer when appropriate.

To indicate an input buffer containing an #!eof object, handlers should

set the input size empty and set the port-eof-flag.

Handler fields for unsupported operations should be set to #f. The others

must be procedures. All port handlers must supply a procedure for

close-port. Input port handlers must supply procedures for ready?,

lookahead, unget, get, and get-some. Output port handlers must supply

procedures for put, put-some, and flush.

For port-position, set-port-position!, port-nonblocking?,

set-port-nonblocking!, port-length, and set-port-length!, the

corresponding "port-has" predicate will return true iff a procedure is

supplied. These procedures must take into account input and output

buffers as appropriate. Positions must be byte counts for binary ports

(see R6RS). For output ports handler must flush the port on "set" (see

R6RS), and for input port handler must clear the buffer on "set" if

needed.

The get-some and put-some procedures should not block on nonblocking

ports, but should instead return 0 to indicate that no data was written or

read. Exception: if a textual output port is line-buffered and the

string passed to put-some contains an eol character, put-some must

flush at least to the last eol character.

The close-port procedure must flush the output buffer as appropriate, set

the buffer size(s) to zero, clear the port-eof flag, and mark the port

closed.

|#

(define-syntax define-port-handler

(lambda (x)

(syntax-case x (->)

[(_ (?record-name ?constructor-name ?pred-name) uid

(?field ?param ... -> ?result) ...)

(or (not (datum uid)) (identifier? #'uid))

#`(begin

(define-record-type (?record-name mph ?pred-name)

#,(if (datum uid) #'(nongenerative uid) #'(nongenerative))

(opaque #t)

(sealed #t)

(fields (immutable ?field) ...))

(define-syntax ?constructor-name

(lambda (x)

(syntax-case x ()

[(_ [?name ?expr] (... ...))

(begin

(let loop ([field* '(?field ...)] [name* #'(?name (... ...))])

(if (null? field*)

(unless (null? name*)

(syntax-error (car name*) "unexpected"))

(if (null? name*)

(syntax-error x (format "missing ~s" (car field*)))

(if (eq? (syntax->datum (car name*)) (car field*))

(loop (cdr field*) (cdr name*))

(syntax-error (car name*) "unexpected")))))

(for-each

(lambda (name p expr)

(unless (p expr)

(syntax-error expr (format "invalid ~s ~s rhs syntax" (datum ?constructor-name) (syntax->datum name)))))

#'(?name (... ...))

(list

(lambda (expr)

(syntax-case expr (lambda)

[(lambda (?param ...) . body) #t]

[(lambda . rest) #f]

[_ #t]))

...)

#'(?expr (... ...)))

#'(mph ?expr (... ...)))]))))])))

(module (make-port-handler port-handler? port-handler-ready?

port-handler-lookahead port-handler-unget

port-handler-get port-handler-get-some

port-handler-clear-input port-handler-put

port-handler-put-some port-handler-flush

port-handler-clear-output port-handler-close-port

port-handler-port-position

port-handler-set-port-position!

port-handler-port-length

port-handler-set-port-length!

port-handler-port-nonblocking?

port-handler-set-port-nonblocking!)

(define-port-handler (port-handler make-port-handler port-handler?) #{port-handler cx3umjhy9nkkuqku-a}

; input:

(ready? who p -> bool)

(lookahead who p -> elt/eof)

(unget who p elt/eof -> void)

(get who p -> elt/eof)

(get-some who p bv start count -> count/eof)

(clear-input who p -> void)

; output:

(put who p elt -> void)

(put-some who p bv start count -> count)

(flush who p -> void)

(clear-output who p -> void)

; all:

(close-port who p -> void)

; optional:

(port-position who p -> pos)

(set-port-position! who p pos -> void)

(port-length who p -> len)

(set-port-length! who p len -> void)

(port-nonblocking? who p -> bool)

(set-port-nonblocking! who p bool -> void)))

(define max-put-copy 256)

(define max-get-copy 256)