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