1#lang racket/base
2(require "../common/class.rkt"
3         "../host/thread.rkt"
4         "../host/pthread.rkt"
5         "evt.rkt")
6
7(provide (struct-out core-port)
8         (struct-out direct)
9         (struct-out location)
10         get-core-port-offset)
11
12;; Port class hierarchy
13;;    - with "virtual" in square brackets
14;;    - with per-instance in curly braces
15;;
16;;                         [core]
17;;                           |
18;;            ,------------------------------,
19;;         [input]                        [output]
20;;            |                              |
21;;       ,---------,             ,---------------------------------,
22;;       |         |             |       |       |     |           |
23;;    [commit]  {custom}      {custom}  pipe   bytes  fd   max   nowhere
24;;       |     (when peek                              |
25;;       |       provided)                            tcp
26;;    -------------------------,
27;;   '             |           |
28;;  bytes   [peek-via-read]  pipe
29;;                 |
30;;             ,-------,
31;;             |       |
32;;            fd    {custom}
33;;             |    (when no peek provided)
34;;            tcp
35
36(class core-port
37  #:field
38  [name 'port #:immutable] ; anything, reported as `object-name` for the port
39
40  ;; When `(direct-bstr buffer)` is not #f, it enables a shortcut for
41  ;; reading and writing, where `(direct-pos buffer)` must also be
42  ;; less than `(direct-end buffer)` for the shortcut to apply. The
43  ;; shortcut is not necessarily always taken, but if it is used, the
44  ;; `(direct-pos buffer)` position can be adjusted and the port's
45  ;; methods must adapt accordingly. The `(direct-bstr buffer)` and
46  ;; `(direct-end buffer)` fields are modified only by the port's
47  ;; methods, however.
48  ;;
49  ;; Shortcut mode implies that the port is still open, so no checking
50  ;; is needed for whether the port is closed.
51  ;;
52  ;; For an input port, shortcut mode implies that `prepare-change`
53  ;; does not need to be called.
54  ;;
55  ;; A non-#f `(direct-bstr buffer)` further implies that
56  ;; `(direct-pos buffer)` should be added to `offset` to get the
57  ;; true offset.
58  [buffer (direct #f 0 0)]
59
60  [closed? #f]
61  [closed-sema #f] ; created on demand
62
63  [offset 0]   ; count plain bytes; add `(- buffer-pos buffer-start)`
64  [count #f]   ; #f or a `location`
65
66  ;; Various methods below are called in atomic mode. The intent of
67  ;; atomic mode is to ensure that the completion and return of the
68  ;; function is atomic with respect to some further activity, such
69  ;; as position and line counting. Also, a guard against operations
70  ;; on a closed port precedes most operations. Any of the functions
71  ;; is free to exit and re-enter atomic mode, but they may take on
72  ;; the burden of re-checking for a closed port. Leave atomic mode
73  ;; explicitly before raising an exception.
74
75  #:public
76  ;; -*> (void)
77  ;; Called in atomic mode.
78  ;; Reqeusts a close, and the port is closed if/when
79  ;; the method returns.
80  [close (lambda () (void))]
81
82  ;; #f or (-*> (void))
83  ;; Called in atomic mode.
84  ;; Notifies the port that line counting is enabled, and
85  ;; `get-location` can be called afterward (if it is defined)
86  [count-lines! #f]
87
88  ;; #f or (-*> (values line-or-#f column-or-#f position-or-#f))
89  ;; Called in atomic mode.
90  ;; Returns the location of the next character. If #f, this method
91  ;; is implemented externally.
92  [get-location #f]  ; #f or method called in atomic mode
93
94  ;; #f or (U (-*> position-k) (position-k -*> (void))
95  ;; Called in atomic mode.
96  ;; If not #f, the port implements `file-position`.
97  [file-position #f]
98
99  ;; #f or (U (-*> mode-sym) (mode-sym -*> (void))
100  ;; Called in atomic mode.
101  ;; If not #f, the port implements buffer-mode selection.
102  [buffer-mode #f]
103
104  #:property
105  [prop:unsafe-authentic-override #t] ; allow evt chaperone
106  [prop:object-name (struct-field-index name)]
107  [prop:secondary-evt port->evt])
108
109(struct direct ([bstr #:mutable]
110                [pos #:mutable]
111                [end #:mutable])
112  #:authentic)
113
114(struct location ([state #:mutable]      ; state of UTF-8 decoding
115                  [cr-state #:mutable]   ; state of CRLF counting as a single LF
116                  [line #:mutable]       ; count newlines
117                  [column #:mutable]     ; count UTF-8 characters in line
118                  [position #:mutable])  ; count UTF-8 characters
119  #:authentic)
120
121(define (get-core-port-offset p)
122  (define offset (core-port-offset p))
123  (define buffer (core-port-buffer p))
124  (and offset
125       (if (direct-bstr buffer)
126           (+ offset (direct-pos buffer))
127           offset)))
128