1;;; io-types.ss
2;;; Copyright 1984-2017 Cisco Systems, Inc.
3;;;
4;;; Licensed under the Apache License, Version 2.0 (the "License");
5;;; you may not use this file except in compliance with the License.
6;;; You may obtain a copy of the License at
7;;;
8;;; http://www.apache.org/licenses/LICENSE-2.0
9;;;
10;;; Unless required by applicable law or agreed to in writing, software
11;;; distributed under the License is distributed on an "AS IS" BASIS,
12;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13;;; See the License for the specific language governing permissions and
14;;; limitations under the License.
15
16#|
17In order to be thread safe, size must be zero and the handler procedures
18must obtain the tc-mutex or use some other mechanism to guarantee mutual
19exclusion while manipulating the buffer.
20
21The built-in handlers for binary file output ports are thread-safe iff
22the buffer mode is none.  The handlers for input ports are not thread-safe,
23since the buffer size may be non-zero to handle lookahead and ungetting.
24
25In order to be safe for continuation-based multitasking, the buffer must
26be manipulated only by inline code (which runs between interrupt traps) or
27within a critical section.  The built-in file handlers are task-safe, but
28the handlers for custom ports and for bytevector ports are not.
29
30In general caller will check immutable properties of inputs but the
31handler must check mutable properties of inputs because other threads may
32change those properties.  For example, handlers need not check the types
33of most input values (e.g., ports, octets, bytevectors) but do have to
34check for closed ports.  (Position and length arguments are an exception,
35since they may vary by kind of port.) Furthermore, handlers, including put
36and get, should not expect the buffer to be full or empty when they are
37called, since in general this cannot be guaranteed if multiple tasks or
38threads are running.  On the other hand, handlers generally won't be
39called for every operation on a port, since data is usually inserted into
40or taken from the buffer when appropriate.
41
42To indicate an input buffer containing an #!eof object, handlers should
43set the input size empty and set the port-eof-flag.
44
45Handler fields for unsupported operations should be set to #f.  The others
46must be procedures.  All port handlers must supply a procedure for
47close-port.  Input port handlers must supply procedures for ready?,
48lookahead, unget, get, and get-some.  Output port handlers must supply
49procedures for put, put-some, and flush.
50
51For port-position, set-port-position!, port-nonblocking?,
52set-port-nonblocking!, port-length, and set-port-length!, the
53corresponding "port-has" predicate will return true iff a procedure is
54supplied.  These procedures must take into account input and output
55buffers as appropriate.  Positions must be byte counts for binary ports
56(see R6RS).  For output ports handler must flush the port on "set" (see
57R6RS), and for input port handler must clear the buffer on "set" if
58needed.
59
60The get-some and put-some procedures should not block on nonblocking
61ports, but should instead return 0 to indicate that no data was written or
62read.  Exception: if a textual output port is line-buffered and the
63string passed to put-some contains an eol character, put-some must
64flush at least to the last eol character.
65
66The close-port procedure must flush the output buffer as appropriate, set
67the buffer size(s) to zero, clear the port-eof flag, and mark the port
68closed.
69|#
70
71(define-syntax define-port-handler
72  (lambda (x)
73    (syntax-case x (->)
74      [(_ (?record-name ?constructor-name ?pred-name) uid
75            (?field ?param ... -> ?result) ...)
76       (or (not (datum uid)) (identifier? #'uid))
77       #`(begin
78           (define-record-type (?record-name mph ?pred-name)
79             #,(if (datum uid) #'(nongenerative uid) #'(nongenerative))
80             (opaque #t)
81             (sealed #t)
82             (fields (immutable ?field) ...))
83           (define-syntax ?constructor-name
84             (lambda (x)
85               (syntax-case x ()
86                 [(_ [?name ?expr] (... ...))
87                  (begin
88                    (let loop ([field* '(?field ...)] [name* #'(?name (... ...))])
89                      (if (null? field*)
90                          (unless (null? name*)
91                            (syntax-error (car name*) "unexpected"))
92                          (if (null? name*)
93                              (syntax-error x (format "missing ~s" (car field*)))
94                              (if (eq? (syntax->datum (car name*)) (car field*))
95                                  (loop (cdr field*) (cdr name*))
96                                  (syntax-error (car name*) "unexpected")))))
97                    (for-each
98                      (lambda (name p expr)
99                        (unless (p expr)
100                          (syntax-error expr (format "invalid ~s ~s rhs syntax" (datum ?constructor-name) (syntax->datum name)))))
101                      #'(?name (... ...))
102                      (list
103                        (lambda (expr)
104                          (syntax-case expr (lambda)
105                            [(lambda (?param ...) . body) #t]
106                            [(lambda . rest) #f]
107                            [_ #t]))
108                        ...)
109                      #'(?expr (... ...)))
110                    #'(mph ?expr (... ...)))]))))])))
111
112;; The following input types are guaranteed upon reaching a handler:
113;;   who: symbol
114;;   bool: any object
115;;   p: input, output, or input/output port as appropriate
116;;   elt (binary port): exact nonnegative integer <= 255
117;;   elt (textual port): character
118;;   elt/eof: elt or #!eof
119;;   bv: bytevector
120;;   start, count: exact nonnegative integer
121;;
122;; Also: start + count <= length(bv).
123;;
124;; The types of pos and len are port-specific and must be checked by
125;; the handler
126
127;; Handlers are responsible for returning appropriate values:
128;;   bool: any object
129;;   elt (binary port): exact nonnegative integer <= 255
130;;   elt (textual port): character
131;;   elt/eof: elt or eof
132;;   count: exact nonnegative integer
133;;   count/eof: count or eof
134;;   pos (binary port): exact nonnegative integer
135;;   pos (textual port): any object
136;;   len (binary port): exact nonnegative integer
137;;   len (textual port): any object
138;;
139;; Also: output count must be less than or equal to input count.
140
141; exporting all but port-handler, since it conflicts with the
142; primtiive named port-handler
143(module (make-port-handler port-handler? port-handler-ready?
144         port-handler-lookahead port-handler-unget
145         port-handler-get port-handler-get-some
146         port-handler-clear-input port-handler-put
147         port-handler-put-some port-handler-flush
148         port-handler-clear-output port-handler-close-port
149         port-handler-port-position
150         port-handler-set-port-position!
151         port-handler-port-length
152         port-handler-set-port-length!
153         port-handler-port-nonblocking?
154         port-handler-set-port-nonblocking!)
155  (define-port-handler (port-handler make-port-handler port-handler?) #{port-handler cx3umjhy9nkkuqku-a}
156   ; input:
157    (ready? who p -> bool)
158    (lookahead who p -> elt/eof)
159    (unget who p elt/eof -> void)
160    (get who p -> elt/eof)
161    (get-some who p bv start count -> count/eof)
162    (clear-input who p -> void)
163
164   ; output:
165    (put who p elt -> void)
166    (put-some who p bv start count -> count)
167    (flush who p -> void)
168    (clear-output who p -> void)
169
170   ; all:
171    (close-port who p -> void)
172
173   ; optional:
174    (port-position who p -> pos)
175    (set-port-position! who p pos -> void)
176    (port-length who p -> len)
177    (set-port-length! who p len -> void)
178    (port-nonblocking? who p -> bool)
179    (set-port-nonblocking! who p bool -> void)))
180
181;;; max-*-copy is the maximum amount a bytevector put operation will copy
182;;; from the supplied bytevector to the port's buffer.  beyond this amount
183;;; it will get/send contents directly from/to the underlying source/sink.
184(define max-put-copy 256)
185(define max-get-copy 256)
186