io: streamline read-char and read-byte

racket/src/cs/demo/io.rkt

@@ -20,7 +20,7 @@
        (define p (open-input-file "compiled/io.scm"))
        (port-count-lines! p)
        (let loop ()
-         (unless (eof-object? (read-byte p))
+         (unless (eof-object? (read-char p))
            (loop)))
        (close-input-port p)
        (loop (sub1 j))))))

racket/src/cs/demo/io.ss

@@ -49,7 +49,7 @@
        (define p (open-input-file "compiled/io.scm"))
        (port-count-lines! p)
        (let loop ()
-         (unless (eof-object? (read-byte p))
+         (unless (eof-object? (read-char p))
            (loop)))
        (close-input-port p)
        (loop (sub1 j))))))

racket/src/io/common/fixnum.rkt

@@ -0,0 +1,25 @@
+#lang racket/base
+(require (for-syntax racket/base)
+         racket/fixnum)
+
+(provide define-fixnum)
+
+;; Representing a mutable, fixnum-valued variable with an fxvector can
+;; avoid a write barrier on assignment
+
+#;
+(define-syntax-rule (define-fixnum id v)
+  (begin
+    (define cell (fxvector v))
+    (define-syntax id
+      (make-set!-transformer
+       (lambda (stx)
+         (syntax-case stx (set!)
+           [(set! _ r) #'(fxvector-set! cell 0 r)]
+           [(... (_ ...)) (raise-syntax-error stx "bad use" stx)]
+           [_ #'(fxvector-ref cell 0)]))))))
+
+;; ... but, for now, something seems to go wrong with whole-program
+;; optimization
+(define-syntax-rule (define-fixnum id v)
+  (define id v))

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

@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/fixnum.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -18,7 +19,7 @@
 
 (define/who (open-input-bytes bstr [name 'string])
   (check who bytes? bstr)
-  (define i 0)
+  (define-fixnum i 0)
   (define alt-pos #f)
   (define len (bytes-length bstr))
 

racket/src/io/port/peek-via-read-port.rkt

@@ -74,7 +74,7 @@
   (define (read-byte)
     (define b ((core-input-port-read-byte peek-pipe-i)))
     (cond
-      [(not (evt? b))
+      [(or (fixnum? b) (eof-object? b))
        b]
       [peeked-eof?
        (set! peeked-eof? #f)

racket/src/io/port/pipe.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/fixnum.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -49,9 +50,9 @@
   (check who #:or-false exact-positive-integer? limit)
   (define bstr (make-bytes (min+1 limit 16)))
   (define len (bytes-length bstr))
-  (define peeked-amt 0) ; peeked but not yet read effectively extends `limit`
-  (define start 0)
-  (define end 0)
+  (define-fixnum peeked-amt 0) ; peeked but not yet read effectively extends `limit`
+  (define-fixnum start 0)
+  (define-fixnum end 0)
   (define write-pos #f) ; to adjust the write position via `file-position` on a string port
   (define input-closed? #f)
   (define output-closed? #f)
@@ -168,10 +169,12 @@
          [else
           (define pos start)
           (check-output-unblocking)
-          (set! start (add1 pos))
-          (set! peeked-amt (max 0 (sub1 peeked-amt)))
-          (when (= start len)
-            (set! start 0))
+          (unless (eqv? 0 peeked-amt)
+            (set! peeked-amt (max 0 (sub1 peeked-amt))))
+          (define new-pos (add1 pos))
+          (if (= new-pos len)
+              (set! start 0)
+              (set! start new-pos))
           (check-input-blocking)
           (progress!)
           (bytes-ref bstr pos)]))

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

@@ -202,15 +202,17 @@
       (check-not-closed who in)
       (define b (read-byte))
       (cond
-        [(evt? b)
+        [(fixnum? b)
+         (port-count-byte! in b)
+         (end-atomic)
+         b]
+        [(eof-object? b)
+         (end-atomic)
+         eof]
+        [else
          (end-atomic)
          (sync b)
-         (loop)]
-        [else
-         (unless (eof-object? b)
-           (port-count-byte! in b))
-         (end-atomic)
-         b])))
+         (loop)])))
   (cond
     [(eof-object? b) b]
     [else