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

racket/src/io/port/bytes-input.rkt

@@ -49,8 +49,7 @@
 ;; ----------------------------------------
 
 (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)))
 
 (define (do-read-byte/core-port who in)

racket/src/io/port/input-port.rkt

@@ -34,22 +34,18 @@
 
 ;; This function should not be called in atomic mode,
 ;; since it can invoke an artitrary function
-(define (->core-input-port v)
+(define (->core-input-port v [who #f])
   (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)
+          (cond
-                              v)]
+            [(struct-accessor-procedure? p)
-    [(input-port? v)
+             (->core-input-port (p v))]
-     (let ([p (input-port-ref v)])
+            [else
-       (cond
+             (->core-input-port p)]))]
-         [(struct-accessor-procedure? p)
+    [who (raise-argument-error who "input-port?" v)]
-          (->core-input-port (p v))]
+    [else empty-input-port]))
-         [else
-          (->core-input-port p)]))]
-    [else
-     empty-input-port]))
 
 (struct core-input-port core-port
   (

racket/src/io/port/output-port.rkt

@@ -34,22 +34,18 @@
 
 ;; This function should not be called in atomic mode,
 ;; since it can invoke an arbitrary function
-(define (->core-output-port v)
+(define (->core-output-port v [who #f])
   (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)
+          (cond
-                               v)]
+            [(struct-accessor-procedure? p)
-    [(output-port? v)
+             (->core-output-port (p v))]
-     (let ([p (output-port-ref v)])
+            [else
-       (cond
+             (->core-output-port p)]))]
-         [(struct-accessor-procedure? p)
+    [who (raise-argument-error who "output-port?" v)]
-          (->core-output-port (p v))]
+    [else empty-output-port]))
-         [else
-          (->core-output-port p)]))]
-    [else
-     empty-output-port]))
 
 (struct core-output-port core-port
   (

racket/src/io/port/special-input.rkt

@@ -52,11 +52,11 @@
 (define/who (read-char-or-special [in (current-input-port)]
                                   [special-wrap #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)]
                                   [skip-k 0]

racket/src/io/port/string-input.rkt

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

racket/src/io/string/utf-8-decode.rkt

@@ -138,26 +138,26 @@
             (encoding-failure)]
            [else
             (define next (fxand b #b00111111))
-            (define next-accum (bitwise-ior (arithmetic-shift accum 6) next))
+            (define next-accum (fxior (fxlshift accum 6) next))
             (cond
-              [(= 1 remaining)
+              [(fx= 1 remaining)
                (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)))
                   (continue)]
                  [else
                   ;; Not a valid character
                   (encoding-failure)])]
               [(and (fx= 2 remaining)
-                    (next-accum . <= . #b11111))
+                    (next-accum . fx<= . #b11111))
                ;; A shorter byte sequence would work, so this is an
                ;; encoding mistae.
                (encoding-failure)]
               [(and (fx= 3 remaining)
-                    (next-accum . <= . #b1111))
+                    (next-accum . fx<= . #b1111))
                ;; A shorter byte sequence would work
                (encoding-failure)]
               [else