From 01d53378b273eb7c310ab770d499f54a09424f97 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 12 Feb 2019 15:28:38 -0700 Subject: [PATCH] io: partial streamline of fd ports Further improvements to move away from the `data` field. --- racket/src/io/port/fd-port.rkt | 97 ++++++++++++++++------------ racket/src/io/port/file-identity.rkt | 3 +- racket/src/io/port/file-lock.rkt | 6 +- racket/src/io/port/file-stream.rkt | 22 +++---- racket/src/io/port/file-truncate.rkt | 13 ++-- racket/src/io/port/port.rkt | 3 +- 6 files changed, 77 insertions(+), 67 deletions(-) diff --git a/racket/src/io/port/fd-port.rkt b/racket/src/io/port/fd-port.rkt index bbd2f5cd23..7bef379e1d 100644 --- a/racket/src/io/port/fd-port.rkt +++ b/racket/src/io/port/fd-port.rkt @@ -26,22 +26,7 @@ fd-port-fd maybe-fd-data-extra) -(struct fd-data (fd extra input? file-stream?) - #:property prop:file-stream (lambda (fdd) (and (fd-data-file-stream? fdd) - (fd-data-fd fdd))) - #:property prop:data-place-message (lambda (port) - (lambda () - (fd-port->place-message port)))) - -(struct fd-output-data fd-data (flush) - #:property prop:file-truncate (case-lambda - [(fdd pos) - ((fd-output-data-flush fdd)) - (check-rktio-error* - (rktio_set_file_size rktio - (fd-data-fd fdd) - pos) - "error setting file size")])) +(struct fd-data (extra)) (define (maybe-fd-data-extra data) (and (fd-data? data) @@ -64,6 +49,7 @@ [fd-refcount #f] [custodian-reference #f] [on-close void] + [file-stream? #t] [network-error? #f]) (override @@ -95,7 +81,16 @@ (and pos (buffer-adjust-pos pos))] [(pos) (purge-buffer) - (set-file-position fd pos)])])) + (set-file-position fd pos)])]) + + (property + [prop:file-stream (lambda (p [check? #f]) + (if check? + (fd-input-port-file-stream? p) + (fd-input-port-fd p)))] + [prop:data-place-message (lambda (port) + (lambda () + (fd-port->place-message port)))])) ;; ---------------------------------------- @@ -110,10 +105,11 @@ #:network-error? [network-error? #f]) (define p (new fd-input-port [name name] - [data (fd-data fd extra-data #t file-stream?)] + [data (fd-data extra-data)] [fd fd] [fd-refcount fd-refcount] [on-close on-close] + [file-stream? file-stream?] [network-error? network-error?])) (set-fd-input-port-custodian-reference! p (register-fd-close cust fd fd-refcount #f p)) p) @@ -131,6 +127,7 @@ [buffer-mode 'block] [custodian-reference #f] [on-close void] + [file-stream? #t] [network-error? network-error?]) (private @@ -254,7 +251,28 @@ [buffer-mode (case-lambda [(self) buffer-mode] - [(self mode) (set! buffer-mode mode)])])) + [(self mode) (set! buffer-mode mode)])]) + + (property + [prop:file-stream (lambda (p [check? #f]) + (if check? + (fd-output-port-file-stream? p) + (fd-output-port-fd p)))] + [prop:file-truncate (lambda (p pos) + ;; in atomic mode + (send fd-output-port p flush-buffer/external) + (define result + (rktio_set_file_size rktio + (fd-output-port-fd p) + pos)) + (cond + [(rktio-error? result) + (end-atomic) + (raise-rktio-error 'file-truncate result "error setting file size")] + [else result]))] + [prop:data-place-message (lambda (port) + (lambda () + (fd-port->place-message port)))])) ;; ---------------------------------------- @@ -275,20 +293,17 @@ [evt evt] [fd fd] [fd-refcount fd-refcount] + [file-stream? file-stream?] [flush-handle #f] [buffer-mode (if (eq? buffer-mode 'infer) (if (rktio_fd_is_terminal rktio fd) - (set! buffer-mode 'line) - (set! buffer-mode 'block)) + 'line + 'block) buffer-mode)] [on-close on-close] [network-error? network-error?] - [data (fd-output-data fd extra-data #f file-stream? - ;; Flush function needed for `file-truncate`: - (lambda () - (atomically - (send fd-output-port p flush-buffer/external))))])) + [data (fd-data extra-data)])) (define flush-handle (plumber-add-flush! plumber (lambda (h) (atomically @@ -302,24 +317,20 @@ ;; ---------------------------------------- (define (terminal-port? p) - (define data - (core-port-data - (cond - [(input-port? p) (->core-input-port p)] - [(output-port? p) (->core-output-port p)] - [else - (raise-argument-error 'terminal-port? "port?" p)]))) - (and (fd-data? data) - (rktio_fd_is_terminal rktio (fd-data-fd data)))) + (define fd (fd-port-fd p)) + (and fd + (rktio_fd_is_terminal rktio fd))) (define (fd-port-fd p) - (define data - (core-port-data - (cond - [(input-port? p) (->core-input-port p)] - [else (->core-output-port p)]))) - (and (fd-data? data) - (fd-data-fd data))) + (cond + [(input-port? p) + (define cp (->core-input-port p)) + (and (fd-input-port? cp) + (fd-input-port-fd cp))] + [else + (define cp (->core-output-port p)) + (and (fd-output-port? cp) + (fd-output-port-fd cp))])) ;; ---------------------------------------- @@ -428,7 +439,7 @@ ;; in atomic mode (define (dup-port-fd port) - (define fd (fd-data-fd (core-port-data port))) + (define fd (fd-port-fd port)) (define new-fd (rktio_dup rktio fd)) (when (rktio-error? new-fd) (end-atomic) diff --git a/racket/src/io/port/file-identity.rkt b/racket/src/io/port/file-identity.rkt index f1d5ef7a8e..55810d52ac 100644 --- a/racket/src/io/port/file-identity.rkt +++ b/racket/src/io/port/file-identity.rkt @@ -17,6 +17,5 @@ [else (->core-output-port p)])) (start-atomic) (check-not-closed who cp) - (define fd (let ([pd (core-port-data cp)]) - ((file-stream-ref pd) pd))) + (define fd ((file-stream-ref cp) cp #f)) (path-or-fd-identity who #:fd fd #:port p)) diff --git a/racket/src/io/port/file-lock.rkt b/racket/src/io/port/file-lock.rkt index 8c41b7b024..5e69f2a6fd 100644 --- a/racket/src/io/port/file-lock.rkt +++ b/racket/src/io/port/file-lock.rkt @@ -29,8 +29,7 @@ [else (->core-output-port p)])) (start-atomic) (check-not-closed who cp) - (define fd (let ([pd (core-port-data cp)]) - ((file-stream-ref pd) pd))) + (define fd ((file-stream-ref cp) cp)) (define r (rktio_file_lock_try rktio fd exclusive?)) (end-atomic) (when (rktio-error? r) @@ -48,8 +47,7 @@ [else (->core-output-port p)])) (start-atomic) (check-not-closed who cp) - (define fd (let ([pd (core-port-data cp)]) - ((file-stream-ref pd) pd))) + (define fd ((file-stream-ref cp) cp)) (define r (rktio_file_unlock rktio fd)) (end-atomic) (when (rktio-error? r) diff --git a/racket/src/io/port/file-stream.rkt b/racket/src/io/port/file-stream.rkt index 107382b160..f8797e3888 100644 --- a/racket/src/io/port/file-stream.rkt +++ b/racket/src/io/port/file-stream.rkt @@ -12,14 +12,14 @@ (make-struct-type-property 'file-stream)) (define (file-stream-port? p) - (and (file-stream-ref - (core-port-data - (cond - [(input-port? p) (->core-input-port p)] - [(output-port? p) (->core-output-port p)] - [else - (raise-argument-error 'file-stream-port? - "port?" - p)])) - #f) - #t)) + (define accessor (file-stream-ref + (cond + [(input-port? p) (->core-input-port p)] + [(output-port? p) (->core-output-port p)] + [else + (raise-argument-error 'file-stream-port? + "port?" + p)]) + #f)) + (and accessor + (accessor p #t))) diff --git a/racket/src/io/port/file-truncate.rkt b/racket/src/io/port/file-truncate.rkt index 521e0d1910..997f66856c 100644 --- a/racket/src/io/port/file-truncate.rkt +++ b/racket/src/io/port/file-truncate.rkt @@ -1,5 +1,7 @@ #lang racket/base (require "../common/check.rkt" + "../host/thread.rkt" + "check.rkt" "port.rkt" "output-port.rkt" "file-stream.rkt") @@ -10,11 +12,12 @@ (define-values (prop:file-truncate file-truncate? file-truncate-ref) (make-struct-type-property 'file-truncate)) -(define (file-truncate p pos) +(define/who (file-truncate p pos) (unless (and (output-port? p) (file-stream-port? p)) - (raise-argument-error 'file-truncate "(and/c output-port? file-stream-port?)" p)) + (raise-argument-error who "(and/c output-port? file-stream-port?)" p)) (check 'file-truncate exact-nonnegative-integer? pos) - (let ([p (->core-output-port p)]) - (define data (core-port-data p)) - ((file-truncate-ref data) data pos))) + (atomically + (check-not-closed who p) + (let ([p (->core-output-port p)]) + ((file-truncate-ref p) p pos)))) diff --git a/racket/src/io/port/port.rkt b/racket/src/io/port/port.rkt index 12161770a7..62d547edd1 100644 --- a/racket/src/io/port/port.rkt +++ b/racket/src/io/port/port.rkt @@ -2,8 +2,7 @@ (require "../common/class.rkt" "../host/thread.rkt" "../host/pthread.rkt" - "evt.rkt" - "place-message.rkt") + "evt.rkt") (provide (struct-out core-port) (struct-out location)