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

io: reduce overhead on read-byte and read-char

Browse Source
This commit is contained in:
Matthew Flatt 2019-02-03 13:24:09 -07:00
parent 5ffb96e62d
commit 9823cbba4d
6 changed files with 52 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
racket/src/io/port/bytes-input.rkt
View File

@ -49,8 +49,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(define/who (read-byte [orig-in (current-input-port)]) (define/who (read-byte [orig-in (current-input-port)])
(check who input-port? orig-in) (let ([in (->core-input-port orig-in who)])
(let ([in (->core-input-port orig-in)])
(do-read-byte/core-port who in))) (do-read-byte/core-port who in)))
(define (do-read-byte/core-port who in) (define (do-read-byte/core-port who in)

16
racket/src/io/port/input-port.rkt
View File

@ -34,22 +34,18 @@
;; This function should not be called in atomic mode, ;; This function should not be called in atomic mode,
;; since it can invoke an artitrary function ;; since it can invoke an artitrary function
(define (->core-input-port v) (define (->core-input-port v [who #f])
(cond (cond
[(core-input-port? v) (if (impersonator? v) [(core-input-port? v) v]
;; If there's an impersonator, it's only [(input-port-ref v #f)
;; an evt impersonator => (lambda (p)
(unsafe-strip-impersonator v)
v)]
[(input-port? v)
(let ([p (input-port-ref v)])
(cond (cond
[(struct-accessor-procedure? p) [(struct-accessor-procedure? p)
(->core-input-port (p v))] (->core-input-port (p v))]
[else [else
(->core-input-port p)]))] (->core-input-port p)]))]
[else [who (raise-argument-error who "input-port?" v)]
empty-input-port])) [else empty-input-port]))
(struct core-input-port core-port (struct core-input-port core-port
( (

16
racket/src/io/port/output-port.rkt
View File

@ -34,22 +34,18 @@
;; This function should not be called in atomic mode, ;; This function should not be called in atomic mode,
;; since it can invoke an arbitrary function ;; since it can invoke an arbitrary function
(define (->core-output-port v) (define (->core-output-port v [who #f])
(cond (cond
[(core-output-port? v) (if (impersonator? v) [(core-output-port? v) v]
;; If there's an impersonator, it's only [(output-port-ref v #f)
;; an evt impersonator => (lambda (p)
(unsafe-strip-impersonator v)
v)]
[(output-port? v)
(let ([p (output-port-ref v)])
(cond (cond
[(struct-accessor-procedure? p) [(struct-accessor-procedure? p)
(->core-output-port (p v))] (->core-output-port (p v))]
[else [else
(->core-output-port p)]))] (->core-output-port p)]))]
[else [who (raise-argument-error who "output-port?" v)]
empty-output-port])) [else empty-output-port]))
(struct core-output-port core-port (struct core-output-port core-port
( (

6
racket/src/io/port/special-input.rkt
View File

@ -52,11 +52,11 @@
(define/who (read-char-or-special [in (current-input-port)] (define/who (read-char-or-special [in (current-input-port)]
[special-wrap #f] [special-wrap #f]
[source-name #f]) [source-name #f])
(check who input-port? in) (let ([in (->core-input-port in who)])
(check who #:or-false (procedure-arity-includes/c 1) special-wrap) (check who #:or-false (procedure-arity-includes/c 1) special-wrap)
(extract-special-value (do-read-char who in #:special-ok? #t) (extract-special-value (do-read-char/core-port who in #:special-ok? #t)
in source-name -1 in source-name -1
special-wrap)) special-wrap)))
(define/who (peek-char-or-special [in (current-input-port)] (define/who (peek-char-or-special [in (current-input-port)]
[skip-k 0] [skip-k 0]

29
racket/src/io/port/string-input.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require "../common/check.rkt" (require racket/fixnum
"../common/check.rkt"
"../host/thread.rkt" "../host/thread.rkt"
"parameter.rkt" "parameter.rkt"
"read-and-peek.rkt" "read-and-peek.rkt"
@ -20,7 +21,6 @@
peek-string peek-string
peek-string! peek-string!
do-read-char
do-read-char/core-port do-read-char/core-port
do-peek-char) do-peek-char)
@ -219,7 +219,7 @@
[(eof-object? b) b] [(eof-object? b) b]
[else [else
(cond (cond
[(b . < . 128) (integer->char b)] [(b . fx< . 128) (integer->char b)]
[else [else
;; UTF-8 decoding... May need to peek bytes to discover ;; UTF-8 decoding... May need to peek bytes to discover
;; whether the decoding will work (in which case this wasn't ;; whether the decoding will work (in which case this wasn't
@ -251,24 +251,23 @@
#:error-char #\uFFFD #:error-char #\uFFFD
#:abort-mode 'state)) #:abort-mode 'state))
(cond (cond
[(= got-chars 1) [(fx= got-chars 1)
(define actually-used-bytes (+ skip-k used-bytes)) (define actually-used-bytes (fx+ skip-k used-bytes))
(unless (zero? actually-used-bytes) (cond
(define finish-bstr (if (actually-used-bytes . <= . (bytes-length bstr)) [(fx= actually-used-bytes 0) (void)]
[(fx= actually-used-bytes 1) (do-read-byte who read-byte in)]
[else
(define finish-bstr (if (actually-used-bytes . fx<= . (bytes-length bstr))
bstr bstr
(make-bytes actually-used-bytes))) (make-bytes actually-used-bytes)))
(do-read-bytes! who in finish-bstr 0 actually-used-bytes)) (do-read-bytes! who in finish-bstr 0 actually-used-bytes)])
(string-ref str 0)] (string-ref str 0)]
[else [else
(loop (add1 skip-k) new-state)])]))])])])) (loop (fx+ skip-k 1) new-state)])]))])])]))
;; ---------------------------------------- ;; ----------------------------------------
;; If `special-ok?`, can return a special-value procedure ;; If `special-ok?`, can return a special-value procedure
(define (do-read-char who in #:special-ok? [special-ok? #f])
(let ([in (->core-input-port in)])
(do-read-char/core-port who in #:special-ok? special-ok?)))
(define (do-read-char/core-port who in #:special-ok? [special-ok? #f]) (define (do-read-char/core-port who in #:special-ok? [special-ok? #f])
(define read-byte (core-input-port-read-byte in)) (define read-byte (core-input-port-read-byte in))
(cond (cond
@ -283,8 +282,8 @@
(read-char-via-read-byte who in read-byte #:special-ok? special-ok?)])) (read-char-via-read-byte who in read-byte #:special-ok? special-ok?)]))
(define/who (read-char [in (current-input-port)]) (define/who (read-char [in (current-input-port)])
(check who input-port? in) (let ([in (->core-input-port in who)])
(do-read-char who in)) (do-read-char/core-port who in)))
(define/who (read-string amt [in (current-input-port)]) (define/who (read-string amt [in (current-input-port)])
(check who exact-nonnegative-integer? amt) (check who exact-nonnegative-integer? amt)

16
racket/src/io/string/utf-8-decode.rkt
View File

@ -138,26 +138,26 @@
(encoding-failure)] (encoding-failure)]
[else [else
(define next (fxand b #b00111111)) (define next (fxand b #b00111111))
(define next-accum (bitwise-ior (arithmetic-shift accum 6) next)) (define next-accum (fxior (fxlshift accum 6) next))
(cond (cond
[(= 1 remaining) [(fx= 1 remaining)
(cond (cond
[(and (next-accum . > . 127) [(and (next-accum . fx> . 127)
(next-accum . <= . #x10FFFF) (next-accum . fx<= . #x10FFFF)
(not (and (next-accum . >= . #xD800) (not (and (next-accum . fx>= . #xD800)
(next-accum . <= . #xDFFF)))) (next-accum . fx<= . #xDFFF))))
(when out-str (string-set! out-str j (integer->char next-accum))) (when out-str (string-set! out-str j (integer->char next-accum)))
(continue)] (continue)]
[else [else
;; Not a valid character ;; Not a valid character
(encoding-failure)])] (encoding-failure)])]
[(and (fx= 2 remaining) [(and (fx= 2 remaining)
(next-accum . <= . #b11111)) (next-accum . fx<= . #b11111))
;; A shorter byte sequence would work, so this is an ;; A shorter byte sequence would work, so this is an
;; encoding mistae. ;; encoding mistae.
(encoding-failure)] (encoding-failure)]
[(and (fx= 3 remaining) [(and (fx= 3 remaining)
(next-accum . <= . #b1111)) (next-accum . fx<= . #b1111))
;; A shorter byte sequence would work ;; A shorter byte sequence would work
(encoding-failure)] (encoding-failure)]
[else [else