cs: faster write-char on ASCII

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

@@ -21,25 +21,28 @@
          unsafe-write-bytes)
 
 (module+ internal
-  (provide do-write-bytes))
+  (provide do-write-byte
+           do-write-bytes))
 
 (define/who (write-byte b [out (current-output-port)])
   (check who byte? b)
-  (check who output-port? out)
+  (do-write-byte b (->core-output-port out who)))
-  (let ([out (->core-output-port out)])
+
-    (start-atomic)
+;; `out` must be a core output port
-    (define buffer (core-port-buffer out))
+(define (do-write-byte b out)
-    (define pos (direct-pos buffer))
+  (start-atomic)
-    (cond
+  (define buffer (core-port-buffer out))
-      [(pos . fx< . (direct-end buffer))
+  (define pos (direct-pos buffer))
-       (bytes-set! (direct-bstr buffer) pos b)
+  (cond
-       (set-direct-pos! buffer (fx+ pos 1))
+    [(pos . fx< . (direct-end buffer))
-       (when (core-port-count out)
+     (bytes-set! (direct-bstr buffer) pos b)
-         (port-count-byte! out b))
+     (set-direct-pos! buffer (fx+ pos 1))
-       (end-atomic)]
+     (when (core-port-count out)
-      [else
+       (port-count-byte! out b))
-       (end-atomic)
+     (end-atomic)]
-       (write-some-bytes 'write-byte out (bytes b) 0 1 #:buffer-ok? #t #:copy-bstr? #f)]))
+    [else
+     (end-atomic)
+     (write-some-bytes 'write-byte out (bytes b) 0 1 #:buffer-ok? #t #:copy-bstr? #f)])
   (void))
 
 (define (do-write-bytes who out bstr start end)

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

@@ -10,23 +10,29 @@
 
 (define/who (write-char ch [out (current-output-port)])
   (check who char? ch)
-  (check who output-port? out)
+  (let ([out (->core-output-port out who)])
-  (write-string (string ch) out 0 1)
+    (define v (char->integer ch))
+    (if (v . < . 128)
+        (do-write-byte v out)
+        (do-write-string who (string ch) out 0 1)))
   (void))
 
 (define/who (write-string str [out (current-output-port)] [start 0] [end (and (string? str)
                                                                               (string-length str))])
   (check who string? str)
-  (check who output-port? out)
+  (let ([out (->core-output-port out who)])
-  (check who exact-nonnegative-integer? start)
+    (check who exact-nonnegative-integer? start)
-  (check who exact-nonnegative-integer? end)
+    (check who exact-nonnegative-integer? end)
-  (check-range who start end (string-length str) str)
+    (check-range who start end (string-length str) str)
-  (let ([out (->core-output-port out)])
+    (do-write-string who str out start end)))
-    (let loop ([i start])
+
-      (cond
+;; `out` must be a core output port
-        [(= i end) (- i start)]
+(define (do-write-string who str out start end)
-        [else
+  (let loop ([i start])
-         (define next-i (min end (+ i 4096)))
+    (cond
-         (define bstr (string->bytes/utf-8 str 0 i next-i))
+      [(= i end) (- i start)]
-         (do-write-bytes who out bstr 0 (bytes-length bstr))
+      [else
-         (loop next-i)]))))
+       (define next-i (min end (+ i 4096)))
+       (define bstr (string->bytes/utf-8 str 0 i next-i))
+       (do-write-bytes who out bstr 0 (bytes-length bstr))
+       (loop next-i)])))