suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

io: make fd-output-port use the fast path

Browse Source
This commit is contained in:
Matthew Flatt 2019-02-12 18:26:42 -07:00
parent 45347465df
commit 6fb4097fef
2 changed files with 48 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
racket/src/io/common/class.rkt
View File

@ -115,28 +115,30 @@
[() (values new-fields new-methods override-methods locals statics properties)]
[((field fld ...) . rest)
(loop #'rest
(add-procs id (syntax->list #'(fld ...)) "field" #:can-immutable? #t)
new-methods
override-methods
locals
statics
properties)]
(append new-fields
(add-procs id (syntax->list #'(fld ...)) "field" #:can-immutable? #t))
new-methods override-methods locals statics properties)]
[((public method ...) . rest)
(loop #'rest
new-fields
(add-procs methods-id (syntax->list #'(method ...)) "public")
override-methods
locals
statics
properties)]
(loop #'rest new-fields
(append new-methods
(add-procs methods-id (syntax->list #'(method ...)) "public"))
override-methods locals statics properties)]
[((override method ...) . rest)
(loop #'rest new-fields new-methods (syntax->list #'(method ...)) locals statics properties)]
(loop #'rest new-fields new-methods
(append override-methods (syntax->list #'(method ...)))
locals statics properties)]
[((private method ...) . rest)
(loop #'rest new-fields new-methods override-methods (syntax->list #'(method ...)) statics properties)]
(loop #'rest new-fields
new-methods override-methods
(append locals (syntax->list #'(method ...)))
statics properties)]
[((static method ...) . rest)
(loop #'rest new-fields new-methods override-methods locals (syntax->list #'(method ...)) properties)]
(loop #'rest new-fields new-methods override-methods locals
(append statics (syntax->list #'(method ...)))
properties)]
[((property prop ...) . rest)
(loop #'rest new-fields new-methods override-methods locals statics (syntax->list #'((#:property . prop) ...)))]
(loop #'rest new-fields new-methods override-methods locals statics
(append properties (syntax->list #'((#:property . prop) ...))))]
[(other . _)
(raise-syntax-error #f "unrecognized" stx #'other)]))))
(define all-fields (if super-ci

33
racket/src/io/port/fd-port.rkt
View File

@ -120,6 +120,29 @@
[buffer-mode 'block]
[custodian-reference #f])
(static
[fast-mode!
(lambda (amt) ; amt = not yet added to `offset`
(when (eq? buffer-mode 'block)
(define e end-pos)
(set! buffer bstr)
(set! buffer-pos e)
(set! buffer-end (bytes-length bstr))
(define o offset)
(when o
(set! offset (- (+ o amt) e)))))]
[slow-mode!
(lambda ()
(when buffer
(set! buffer #f)
(define pos buffer-pos)
(set! end-pos pos)
(define o offset)
(when o
(set! offset (+ o pos)))
(set! buffer-pos buffer-end)))])
(public
[on-close (lambda () (void))]
[raise-write-error
@ -131,6 +154,7 @@
;; Returns `#t` if the buffer is already or successfully flushed
[flush-buffer
(lambda ()
(slow-mode!)
(cond
[(not (fx= start-pos end-pos))
(define n (rktio_write_in rktio fd bstr start-pos end-pos))
@ -184,6 +208,7 @@
;; in atomic mode
[write-out
(lambda (src-bstr src-start src-end nonbuffer/nonblock? enable-break? copy?)
(slow-mode!)
(cond
[(fx= src-start src-end)
;; Flush request
@ -194,10 +219,10 @@
(define amt (fxmin (fx- src-end src-start) (fx- (bytes-length bstr) end-pos)))
(bytes-copy! bstr end-pos src-bstr src-start (fx+ src-start amt))
(set! end-pos (fx+ end-pos amt))
(unless nonbuffer/nonblock?
(when (eq? buffer-mode 'line)
;; can temporarily leave atomic mode:
(flush-buffer-fully-if-newline src-bstr src-start src-end enable-break?)))
(when (eq? buffer-mode 'line)
;; can temporarily leave atomic mode:
(flush-buffer-fully-if-newline src-bstr src-start src-end enable-break?))
(fast-mode! amt)
amt]
[(not (flush-buffer)) ; <- can temporarily leave atomic mode
#f]