diff --git a/racket/src/io/port/bytes-output.rkt b/racket/src/io/port/bytes-output.rkt
index fb21cfd5e1..15c7515a23 100644
--- a/racket/src/io/port/bytes-output.rkt
+++ b/racket/src/io/port/bytes-output.rkt
@@ -26,11 +26,12 @@
   (check who output-port? out)
   (let ([out (->core-output-port out)])
     (start-atomic)
-    (define pos (core-port-buffer-pos out))
+    (define buffer (core-port-buffer out))
+    (define pos (direct-pos buffer))
     (cond
-      [(pos . fx< . (core-port-buffer-end out))
-       (bytes-set! (core-port-buffer out) pos b)
-       (set-core-port-buffer-pos! out (fx+ pos 1))
+      [(pos . fx< . (direct-end buffer))
+       (bytes-set! (direct-bstr buffer) pos b)
+       (set-direct-pos! buffer (fx+ pos 1))
        (when (core-port-count out)
          (port-count-byte! out b))
        (end-atomic)]
diff --git a/racket/src/io/port/bytes-port.rkt b/racket/src/io/port/bytes-port.rkt
index 67a31f79b6..03ec2e8463 100644
--- a/racket/src/io/port/bytes-port.rkt
+++ b/racket/src/io/port/bytes-port.rkt
@@ -33,8 +33,9 @@
     ;; in atomic mode
     [in-buffer-pos
      (lambda ()
-       (if buffer
-           buffer-pos
+       (define b buffer)
+       (if (direct-bstr b)
+           (direct-pos b)
            pos))])
 
   (override
@@ -43,19 +44,21 @@
        (set! commit-manager #f) ; to indicate closed
        (progress!)
        (set! bstr #f)
-       (when buffer
-         (set! offset buffer-pos)
-         (set! buffer #f)))]
+       (define b buffer)
+       (when (direct-bstr b)
+         (set! offset (direct-pos b))
+         (set-direct-bstr! b #f)))]
     [file-position
      (case-lambda
        [() (or alt-pos (in-buffer-pos))]
        [(given-pos)
-        (define len buffer-end)
+        (define b buffer)
+        (define len (direct-end b))
         (define new-pos (if (eof-object? given-pos)
                             len
                             (min len given-pos)))
-        (if buffer
-            (set! buffer-pos new-pos)
+        (if (direct-bstr b)
+            (set-direct-pos! b new-pos)
             (set! pos new-pos))
         (set! alt-pos (and (not (eof-object? given-pos))
                            (given-pos . > . new-pos)
@@ -67,16 +70,17 @@
 
     [read-in
      (lambda (dest-bstr start end copy?)
-       (define len buffer-end)
+       (define b buffer)
+       (define len (direct-end b))
        (define i (in-buffer-pos))
        (cond
          [(i . < . len)
           (define amt (min (- end start) (fx- len i)))
           (define new-pos (fx+ i amt))
           ;; Keep/resume fast mode
-          (set! buffer-pos new-pos)
+          (set-direct-pos! b new-pos)
           (set! offset 0)
-          (set! buffer bstr)
+          (set-direct-bstr! b bstr)
           (bytes-copy! dest-bstr start bstr i new-pos)
           (progress!)
           amt]
@@ -84,8 +88,9 @@
 
     [peek-in
      (lambda (dest-bstr start end skip progress-evt copy?)
+       (define b buffer)
+       (define len (direct-end b))
        (define i (in-buffer-pos))
-       (define len buffer-end)
        (define at-pos (+ i skip))
        (cond
          [(and progress-evt (sync/timeout 0 progress-evt))
@@ -98,19 +103,20 @@
 
     [byte-ready
      (lambda (work-done!)
-       ((in-buffer-pos) . < . buffer-end))]
+       ((in-buffer-pos) . < . (direct-end buffer)))]
    
     [get-progress-evt
      (lambda ()
        (atomically
         (unless progress-sema
           ;; set port to slow mode:
-          (when buffer
-            (define i buffer-pos)
+          (define b buffer)
+          (when (direct-bstr b)
+            (define i (direct-pos b))
             (set! pos i)
             (set! offset i)
-            (set! buffer #f)
-            (set! buffer-pos buffer-end)))
+            (set-direct-bstr! b #f)
+            (set-direct-pos! b (direct-end b))))
         (make-progress-evt)))]
 
     [commit
@@ -119,32 +125,23 @@
         progress-evt ext-evt
         ;; in atomic mode, maybe in a different thread:
         (lambda ()
-          (define len buffer-end)
+          (define b buffer)
+          (define len (direct-end b))
           (define i (in-buffer-pos))
           (let ([amt (min amt (- len i))])
             (define dest-bstr (make-bytes amt))
             (bytes-copy! dest-bstr 0 bstr i (+ i amt))
             ;; Keep/resume fast mode
-            (set! buffer-pos (fx+ i amt))
-            (set! buffer bstr)
+            (set-direct-pos! b (fx+ i amt))
+            (set-direct-bstr! b bstr)
             (set! offset 0)
             (progress!)
-            (finish dest-bstr)))))]
-
-    [count-lines!
-     (lambda ()
-       (when buffer
-         (define i buffer-pos)
-         (set! offset i)
-         (set! pos i)
-         (set! buffer #f)
-         (set! buffer-pos buffer-end)))]))
+            (finish dest-bstr)))))]))
 
 (define (make-input-bytes bstr name)
   (new bytes-input-port
        [name name]
-       [buffer bstr]
-       [buffer-end (bytes-length bstr)]
+       [buffer (direct bstr 0 (bytes-length bstr))]
        [bstr bstr]))
 
 ;; ----------------------------------------
@@ -180,19 +177,21 @@
 
     [slow-mode!
      (lambda ()
-       (when buffer
-         (define s buffer-pos)
+       (define b buffer)
+       (when (direct-bstr b)
+         (define s (direct-pos b))
          (set! pos s)
-         (set! buffer-pos buffer-end)
-         (set! buffer #f)
+         (set-direct-pos! b (direct-end b))
+         (set-direct-bstr! b #f)
          (set! offset s)
          (set! max-pos (fxmax s max-pos))))]
 
     [fast-mode!
      (lambda ()
-       (set! buffer bstr)
-       (set! buffer-pos pos)
-       (set! buffer-end (bytes-length bstr))
+       (define b buffer)
+       (set-direct-bstr! b bstr)
+       (set-direct-pos! b pos)
+       (set-direct-end! b (bytes-length bstr))
        (set! offset 0))])
 
   (override
@@ -214,7 +213,9 @@
                                     (port-count! out v bstr start)))]
     [file-position
      (case-lambda
-       [() (if buffer buffer-pos pos)]
+       [()
+        (define b buffer)
+        (if (direct-bstr b) (direct-pos b) pos)]
        [(new-pos)
         (slow-mode!)
         (define len (bytes-length bstr))
diff --git a/racket/src/io/port/count.rkt b/racket/src/io/port/count.rkt
index 1518a95fd7..85d64f00a6 100644
--- a/racket/src/io/port/count.rkt
+++ b/racket/src/io/port/count.rkt
@@ -207,7 +207,7 @@
 
 ;; in atomic mode
 (define (increment-offset! in amt)
-  (unless (core-port-buffer in)
+  (unless (direct-bstr (core-port-buffer in))
     (define old-offset (core-port-offset in))
     (when old-offset
       (set-core-port-offset! in (+ amt old-offset)))))
diff --git a/racket/src/io/port/fd-port.rkt b/racket/src/io/port/fd-port.rkt
index f0d9692f29..e8b8fb7952 100644
--- a/racket/src/io/port/fd-port.rkt
+++ b/racket/src/io/port/fd-port.rkt
@@ -126,24 +126,26 @@
    [fast-mode!
     (lambda (amt) ; amt = not yet added to `offset`
       (when (eq? buffer-mode 'block)
+        (define b buffer)
         (define e end-pos)
-        (set! buffer bstr)
-        (set! buffer-pos e)
-        (set! buffer-end (bytes-length bstr))
+        (set-direct-bstr! b bstr)
+        (set-direct-pos! b e)
+        (set-direct-end! b (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)
+      (define b buffer)
+      (when (direct-bstr b)
+        (set-direct-bstr! b #f)
+        (define pos (direct-pos b))
         (set! end-pos pos)
         (define o offset)
         (when o
           (set! offset (+ o pos)))
-        (set! buffer-pos buffer-end)))])
+        (set-direct-pos! b (direct-end b))))])
 
   (public
     [on-close (lambda () (void))]
@@ -257,7 +259,8 @@
      (case-lambda
        [()
         (define pos (get-file-position fd))
-        (and pos (+ pos (fx- (if buffer buffer-pos end-pos) start-pos)))]
+        (define b buffer)
+        (and pos (+ pos (fx- (if (direct-bstr b) (direct-pos b) end-pos) start-pos)))]
        [(pos)
         (flush-buffer-fully #f)
         ;; flushing can leave atomic mode, so make sure the
diff --git a/racket/src/io/port/peek-via-read-port.rkt b/racket/src/io/port/peek-via-read-port.rkt
index 478edb295b..9214776c7c 100644
--- a/racket/src/io/port/peek-via-read-port.rkt
+++ b/racket/src/io/port/peek-via-read-port.rkt
@@ -40,7 +40,8 @@
 
    [buffer-adjust-pos
     (lambda (i)
-      (- i (fx- end-pos (if buffer buffer-pos pos))))]
+      (define b buffer)
+      (- i (fx- end-pos (if (direct-bstr b) (direct-pos b) pos))))]
 
    ;; in atomic mode
    [default-buffer-mode
@@ -93,10 +94,11 @@
     ;; in atomic mode
     [fast-mode!
      (lambda (amt) ; amt = not yet added to `offset`
-       (set! buffer bstr)
+       (define b buffer)
+       (set-direct-bstr! b bstr)
        (define s pos)
-       (set! buffer-pos s)
-       (set! buffer-end end-pos)
+       (set-direct-pos! b s)
+       (set-direct-end! b end-pos)
        (define o offset)
        (when o
          (set! offset (- (+ o amt) s))))]
@@ -104,14 +106,15 @@
     ;; in atomic mode
     [slow-mode!
      (lambda ()
-       (when buffer
-         (define s buffer-pos)
+       (define b buffer)
+       (when (direct-bstr b)
+         (define s (direct-pos b))
          (define o offset)
          (when o
            (set! offset (+ o s)))
          (set! pos s)
-         (set! buffer #f)
-         (set! buffer-pos buffer-end)))])
+         (set-direct-bstr! b #f)
+         (set-direct-pos! b (direct-end b))))])
 
   (override
     ;; in atomic mode
@@ -159,7 +162,8 @@
                  (sync/timeout 0 progress-evt))
             #f]
            [else
-            (define s (if buffer buffer-pos pos))
+            (define b buffer)
+            (define s (if (direct-bstr b) (direct-pos b) pos))
             (define peeked-amt (fx- end-pos s))
             (cond
               [(peeked-amt . > . skip)
@@ -180,7 +184,8 @@
     [byte-ready
      (lambda (work-done!)
        (let loop ()
-         (define peeked-amt (fx- end-pos (if buffer buffer-pos pos)))
+         (define b buffer)
+         (define peeked-amt (fx- end-pos (if (direct-bstr b) (direct-pos b) pos)))
          (cond
            [(peeked-amt . fx> . 0) #t]
            [peeked-eof? #t]
diff --git a/racket/src/io/port/pipe.rkt b/racket/src/io/port/pipe.rkt
index 908b1dbeb2..91e7c39dd7 100644
--- a/racket/src/io/port/pipe.rkt
+++ b/racket/src/io/port/pipe.rkt
@@ -47,11 +47,9 @@
       [else
        (raise-argument-error 'pipe-contact-length "(or/c pipe-input-port? pipe-output-port?)" p)]))
   (atomically
-   (let ([input (pipe-data-input d)])
-     (when input (send pipe-input-port input sync-data)))
-   (let ([output (pipe-data-output d)])
-     (when output (send pipe-output-port output sync-data)))
-   (send pipe-data d content-length)))
+   (with-object pipe-data d
+     (sync-both)
+     (content-length))))
 
 ;; ----------------------------------------
 
@@ -63,18 +61,46 @@
    [peeked-amt 0] ; peeked but not yet read, effectively extends `limit`
    [start 0]
    [end 0]
-   [input #f]  ; #f => closed
-   [output #f] ; #f => closed
+   [input-ref #f]     ; #f => closed
+   [output-ref #f]    ; #f => closed
+   [input-buffer #f]
+   [output-buffer #f]
    [read-ready-sema #f]
    [write-ready-sema #f]
    [more-read-ready-sema #f] ; for lookahead peeks
    [read-ready-evt #f]
    [write-ready-evt #f])
 
-  ;; All methods in atomic mode.
-  ;; Beware that the input port must be synced to sure that `start`
-  ;; represents the current position before using these methods.
+  (private)
+
+  ;; All static methods in atomic mode.
   (static
+   ;; sync local fields with input buffer without implying slow mode
+   [sync-input
+    (lambda ()
+      (define b input-buffer)
+      (when (direct-bstr b)
+        (define pos (direct-pos b))
+        (set! start (if (fx= pos len)
+                        0
+                        pos))))]
+   ;; sync local fields with output buffer without implying slow mode
+   [sync-output
+    (lambda ()
+      (define b output-buffer)
+      (when (direct-bstr b)
+        (define pos (direct-pos b))
+        (set! end (if (fx= pos len)
+                      0
+                      pos))))]
+
+
+   [sync-both
+    (lambda ()
+      (sync-input)
+      (sync-output))]
+
+   ;; assumes sync'ed
    [content-length
     (lambda ()
       (define s start)
@@ -83,40 +109,34 @@
           (fx- e s)
           (fx+ e (fx- len s))))]
 
+   ;; assumes sync'ed
    [input-empty?
     (lambda ()
       (fx= start end))]
 
+   ;; assumes sync'ed
    [output-full?
     (lambda ()
       (define l limit)
       (and l
            ((content-length) . >= . (+ l peeked-amt))))]
 
-   ;; Used before/after read:
+   ;; Used before read:
    [check-output-unblocking
     (lambda ()
-      (when (output-full?) (semaphore-post write-ready-sema)))]
-   [check-input-blocking
-    (lambda ()
-      (when (input-empty?)
-        (semaphore-wait read-ready-sema)
-        (when output
-          (send pipe-output-port output on-input-empty))))]
+      (when write-ready-sema
+        (semaphore-post write-ready-sema)
+        (set! write-ready-sema #f)))]
 
-   ;; Used before/after write:
+   ;; Used before write:
    [check-input-unblocking
     (lambda ()
-      (when (and (input-empty?) output) (semaphore-post read-ready-sema))
+      (when read-ready-sema
+        (semaphore-post read-ready-sema)
+        (set! read-ready-sema #f))
       (when more-read-ready-sema
         (semaphore-post more-read-ready-sema)
         (set! more-read-ready-sema #f)))]
-   [check-output-blocking
-    (lambda ()
-      (when (output-full?)
-        (semaphore-wait write-ready-sema)
-        (when input
-          (send pipe-input-port input on-output-full))))]
 
    ;; Used after peeking:
    [peeked!
@@ -125,6 +145,9 @@
         (check-output-unblocking)
         (set! peeked-amt amt)))]))
 
+(define (make-ref v) (make-weak-box v))
+(define (ref-value r) (weak-box-value r))
+
 ;; ----------------------------------------
 
 (class pipe-input-port #:extends commit-input-port
@@ -138,12 +161,10 @@
          (define s start)
          (define e end)
          (unless (fx= s e)
-           (set! buffer bstr)
-           (set! buffer-pos s)
-           ;; don't read last byte, because the output
-           ;; end needs to know about a transition to
-           ;; the empty state
-           (set! buffer-end (fx- (if (s . fx< . e) e len) 1))
+           (define b buffer)
+           (set-direct-bstr! b bstr)
+           (set-direct-pos! b s)
+           (set-direct-end! b (if (s . fx< . e) e len))
            (define o offset)
            (when o
              (set! offset (- (+ o amt) s))))))]
@@ -151,34 +172,18 @@
     [slow-mode!
      (lambda ()
        (with-object pipe-data d
-         (when buffer
-           (define pos buffer-pos)
+         (define b buffer)
+         (when (direct-bstr b)
+           (define pos (direct-pos b))
            (define o offset)
            (when o
              (set! offset (+ o pos)))
            (set! start (if (fx= pos len) 0 pos))
-           (set! buffer #f)
-           (set! buffer-pos buffer-end))
-         (define out output)
-         (when out
-           (send pipe-output-port out sync-data))))])
+           (set-direct-bstr! b #f)
+           (set-direct-pos! b (direct-end b)))
+         (sync-output)))])
 
   (static
-   [sync-data
-    (lambda ()
-      (when buffer
-        (with-object pipe-data d
-          (define pos buffer-pos)
-          (set! start (if (fx= pos len)
-                          0
-                          pos)))))]
-   [sync-data-both
-    (lambda ()
-      (sync-data)
-      (with-object pipe-data d
-        (define out output)
-        (when out
-          (send pipe-output-port out sync-data))))]
    [on-resize
     (lambda ()
       (slow-mode!))]
@@ -199,7 +204,7 @@
        (with-object pipe-data d
          (cond
            [(input-empty?)
-            (if output
+            (if output-ref
                 read-ready-evt
                 eof)]
            [else
@@ -222,7 +227,6 @@
                 (set! start (modulo (fx+ s amt) len))
                 (set! peeked-amt (fxmax 0 (fx- peeked-amt amt)))
                 amt]))
-            (check-input-blocking)
             (progress!)
             (fast-mode! amt)
             amt])))]
@@ -231,7 +235,7 @@
      (lambda (dest-bstr dest-start dest-end skip progress-evt copy?)
        (with-object pipe-data d
          (assert-atomic)
-         (sync-data-both)
+         (sync-both)
          (define content-amt (content-length))
          (cond
            [(and progress-evt
@@ -239,12 +243,13 @@
             #f]
            [(content-amt . <= . skip)
             (cond
-              [(not output) eof]
+              [(not output-ref) eof]
               [else
                (unless (or (zero? skip) more-read-ready-sema)
                  (set! more-read-ready-sema (make-semaphore))
-                 (when output
-                   (send pipe-output-port output on-need-more-ready)))
+                 (define out (ref-value output-ref))
+                 (when out
+                   (send pipe-output-port out on-need-more-ready)))
                (define evt (if (zero? skip)
                                read-ready-evt
                                (wrap-evt (semaphore-peek-evt more-read-ready-sema)
@@ -270,17 +275,17 @@
      (lambda (work-done!)
        (assert-atomic)
        (with-object pipe-data d
-         (or (not output)
+         (or (not output-ref)
              (begin
-               (sync-data-both)
+               (sync-both)
                (not (fx= 0 (content-length)))))))]
 
     [close
      (lambda ()
        (with-object pipe-data d
-         (when input
+         (when input-ref
            (slow-mode!)
-           (set! input #f)
+           (set! input-ref #f)
            (progress!))))]
 
     [get-progress-evt
@@ -288,7 +293,7 @@
        (atomically
         (with-object pipe-data d
           (cond
-            [(not input) always-evt]
+            [(not input-ref) always-evt]
             [else
              (slow-mode!)
              (make-progress-evt)]))))]
@@ -330,7 +335,6 @@
                     (set! start (fxmodulo (fx+ s amt) len))
                     (progress!)
                     (fast-mode! amt)
-                    (check-input-blocking)
                     (finish dest-bstr)])))))]))]
 
     [count-lines!
@@ -348,25 +352,22 @@
      (lambda (amt) ; amt = not yet added to `offset`
        (with-object pipe-data d
          (define lim limit)
-         (define avail (and lim (- lim (content-length)
-                                   ;; don't fill last byte, because the input
-                                   ;; end needs to know about a trasition to the
-                                   ;; full state
-                                   1)))
+         (define avail (and lim (- lim (content-length))))
          (when (or (not avail) (avail . <= . 0))
            (define s start)
-           (define e end)             
-           (set! buffer bstr)
-           (set! buffer-pos e)
-           (set! buffer-end (let ([end (if (s . fx<= . e)
-                                           (if (fx= s 0)
-                                               (fx- len 1)
-                                               len)
-                                           (fx- s 1))])
-                              (if (and avail
-                                       ((fx- end e) . > . avail))
-                                  (fx+ e avail)
-                                  end)))
+           (define e end)
+           (define b buffer)
+           (set-direct-bstr! b bstr)
+           (set-direct-pos! b e)
+           (set-direct-end! b (let ([end (if (s . fx<= . e)
+                                             (if (fx= s 0)
+                                                 (fx- len 1)
+                                                 len)
+                                             (fx- s 1))])
+                                (if (and avail
+                                         ((fx- end e) . > . avail))
+                                    (fx+ e avail)
+                                    end)))
            (define o offset)
            (when o
              (set! offset (- (+ o amt) e))))))]
@@ -374,34 +375,18 @@
     [slow-mode!
      (lambda ()
        (with-object pipe-data d
-         (when buffer
-           (define pos buffer-pos)
+         (define b buffer)
+         (when (direct-bstr b)
+           (define pos (direct-pos b))
            (define o offset)
            (when o
              (set! offset (+ o pos)))
            (set! end (if (fx= pos len) 0 pos))
-           (set! buffer #f)
-           (set! buffer-pos buffer-end))
-         (define in input)
-         (when in
-           (send pipe-input-port in sync-data))))])
+           (set-direct-bstr! b #f)
+           (set-direct-pos! b (direct-end b)))
+         (sync-input)))])
 
   (static
-   [sync-data
-    (lambda ()
-      (when buffer
-        (with-object pipe-data d
-          (define pos buffer-pos)
-          (set! end (if (fx= pos len)
-                        0
-                        pos)))))]
-   [sync-data-both
-    (lambda ()
-      (sync-data)
-      (with-object pipe-data d
-        (define in input)
-        (when in
-          (send pipe-output-port in sync-data #f))))]
    [on-input-empty
     (lambda ()
       (slow-mode!))]
@@ -416,7 +401,6 @@
        (assert-atomic)
        (slow-mode!)
        (with-object pipe-data d
-         (send pipe-input-port input sync-data)
          (let try-again ()
            (define top-pos (if (fx= start 0)
                                (fx- len 1)
@@ -426,7 +410,9 @@
                [(or (not limit)
                     ((+ limit peeked-amt) . > . (fx- len 1)))
                 ;; grow pipe size
-                (send pipe-input-port input on-resize)
+                (define in (ref-value input-ref))
+                (when in
+                  (send pipe-input-port in on-resize))
                 (define new-bstr (make-bytes (min+1 (and limit (+ limit peeked-amt)) (* len 2))))
                 (cond
                   [(fx= 0 start)
@@ -460,7 +446,6 @@
                  (bytes-copy! bstr end src-bstr src-start (fx+ src-start amt))
                  (let ([new-end (fx+ end amt)])
                    (set! end (if (fx= new-end len) 0 new-end)))
-                 (check-output-blocking)
                  (fast-mode! amt)
                  amt])]
              [(fx= end top-pos)
@@ -476,7 +461,6 @@
                     (check-input-unblocking)
                     (bytes-copy! bstr 0 src-bstr src-start (fx+ src-start amt))
                     (set! end amt)
-                    (check-output-blocking)
                     (fast-mode! amt)
                     amt])])]
              [(end . fx< . (fx- start 1))
@@ -488,7 +472,6 @@
                  (check-input-unblocking)
                  (bytes-copy! bstr end src-bstr src-start (fx+ src-start amt))
                  (set! end (fx+ end amt))
-                 (check-output-blocking)
                  (fast-mode! amt)
                  amt])]
              [else
@@ -502,33 +485,25 @@
      ;; in atomic mode
      (lambda ()
        (with-object pipe-data d
-         (when output
+         (when output-ref
            (slow-mode!)
-           (set! output #f)
-           (when write-ready-sema
-             (semaphore-post write-ready-sema))
-           (when more-read-ready-sema
-             (semaphore-post more-read-ready-sema))
-           (semaphore-post read-ready-sema))))]))
+           (set! output-ref #f)
+           (check-input-unblocking))))]))
 
 ;; ----------------------------------------
     
 (define (make-pipe-ends [limit #f] [input-name 'pipe] [output-name 'pipe])
   (define len (min+1 limit 16))
-  (define read-ready-sema (make-semaphore))
-  (define write-ready-sema (and limit (make-semaphore 1)))
-  (define write-ready-evt (if limit
-                              (semaphore-peek-evt write-ready-sema)
-                              always-evt))
+
   (define d (new pipe-data
                  [bstr (make-bytes len)]
                  [len len]
-                 [limit limit]
-                 [read-ready-sema read-ready-sema]
-                 [write-ready-sema write-ready-sema]
-                 [read-ready-evt (wrap-evt (semaphore-peek-evt read-ready-sema)
-                                           (lambda (v) 0))]
-                 [write-ready-evt write-ready-evt]))
+                 [limit limit]))
+
+  (define write-ready-evt (if limit
+                              (pipe-write-poller d)
+                              always-evt))
+  (define read-ready-evt (pipe-read-poller d))
 
   (define input (new pipe-input-port
                      [name input-name]
@@ -538,8 +513,12 @@
                       [evt write-ready-evt]
                       [d d]))
 
-  (set-pipe-data-input! d input)
-  (set-pipe-data-output! d output)
+  (set-pipe-data-input-buffer! d (core-port-buffer input))
+  (set-pipe-data-output-buffer! d (core-port-buffer output))
+  (set-pipe-data-input-ref! d (make-ref input))
+  (set-pipe-data-output-ref! d (make-ref output))
+  (set-pipe-data-write-ready-evt! d write-ready-evt)
+  (set-pipe-data-read-ready-evt! d read-ready-evt)
 
   (values input output))
 
@@ -550,3 +529,45 @@
     (port-count-lines! ip)
     (port-count-lines! op))
   (values ip op))
+
+;; ----------------------------------------
+
+;; Note: a thread blocked on writing to a limited pipe cannot be GCed
+;; due to the use of `replace-evt`.
+(struct pipe-write-poller (d)
+  #:property
+  prop:evt
+  (poller
+   (lambda (pwp ctx)
+     (with-object pipe-data (pipe-write-poller-d pwp)
+       (sync-both)
+       (cond
+         [(not (output-full?))
+          (values (list pwp) #f)]
+         [else
+          (unless write-ready-sema
+            (set! write-ready-sema (make-semaphore)))
+          (define in (ref-value input-ref))
+          (when in
+            (send pipe-input-port in on-output-full))
+          (values #f (replace-evt (semaphore-peek-evt write-ready-sema)
+                                  (lambda (v) pwp)))])))))
+
+(struct pipe-read-poller (d)
+  #:property
+  prop:evt
+  (poller
+   (lambda (prp ctx)
+     (with-object pipe-data (pipe-read-poller-d prp)
+       (sync-both)
+       (cond
+         [(not (input-empty?))
+          (values (list 0) #f)]
+         [else
+          (unless read-ready-sema
+            (set! read-ready-sema (make-semaphore)))
+          (define out (ref-value output-ref))
+          (when out
+            (send pipe-output-port out on-input-empty))
+          (values #f (wrap-evt (semaphore-peek-evt read-ready-sema)
+                               (lambda (v) 0)))])))))
diff --git a/racket/src/io/port/port.rkt b/racket/src/io/port/port.rkt
index 62d547edd1..df3e38b2bf 100644
--- a/racket/src/io/port/port.rkt
+++ b/racket/src/io/port/port.rkt
@@ -5,6 +5,7 @@
          "evt.rkt")
 
 (provide (struct-out core-port)
+         (struct-out direct)
          (struct-out location)
          get-core-port-offset)
 
@@ -14,23 +15,23 @@
 
    [data #f] ; FIXME: remove after all uses are converted
 
-   ;; When `buffer` is #f, it enables a shortcut for reading and
-   ;; writing, where `buffer-pos` must also be less than `buffer-end`
-   ;; for the shortcut to apply. The shortcut is not necessarily
-   ;; always taken, just if it is used, the `buffer-pos` position can
-   ;; be adjusted and the port's methods must adapt accordingly. The
-   ;; `buffer` and `buffer-end` fields are modified only by the port's
-   ;; methods, however.
+   ;; When `(direct-bstr buffer)` is not #f, it enables a shortcut for
+   ;; reading and writing, where `(direct-pos buffer)` must also be
+   ;; less than `(direct-end buffer)` for the shortcut to apply. The
+   ;; shortcut is not necessarily always taken, just if it is used,
+   ;; the `(direct-pos buffer)` position can be adjusted and the
+   ;; port's methods must adapt accordingly. The `(direct-bstr
+   ;; buffer)` and `(direct-end buffer)` fields are modified only by
+   ;; the port's methods, however.
    ;;
    ;; For an input port, shortcut mode implies that `prepare-change`
    ;; does not need to be called, and no checking is needed for whether
    ;; the port is closed.
    ;;
-   ;; A non-#f `buffer` further implies that `buffer-pos` should be
-   ;; added to `offset` to get the true offset.
-   [buffer #f]
-   [buffer-pos 0]   ; if < `buffer-end`, allows direct read/write on `buffer`
-   [buffer-end 0]
+   ;; A non-#f `(direct-bstr buffer)` further implies that
+   ;; `(direct-pos buffer)` should be added to `offset` to get the
+   ;; true offset.
+   [buffer (direct #f 0 0)]
    
    [closed? #f]
    [closed-sema #f]
@@ -81,15 +82,22 @@
    [prop:object-name (struct-field-index name)]
    [prop:secondary-evt port->evt]))
 
+(struct direct ([bstr #:mutable]
+                [pos #:mutable]
+                [end #:mutable])
+  #:authentic)
+
 (struct location ([state #:mutable]      ; state of UTF-8 decoding
                   [cr-state #:mutable]   ; state of CRLF counting as a single LF
                   [line #:mutable]       ; count newlines
                   [column #:mutable]     ; count UTF-8 characters in line
-                  [position #:mutable])) ; count UTF-8 characters
+                  [position #:mutable])  ; count UTF-8 characters
+  #:authentic)
 
 (define (get-core-port-offset p)
   (define offset (core-port-offset p))
+  (define buffer (core-port-buffer p))
   (and offset
-       (if (core-port-buffer p)
-           (+ offset (core-port-buffer-pos p))
+       (if (direct-bstr buffer)
+           (+ offset (direct-pos buffer))
            offset)))
diff --git a/racket/src/io/port/read-and-peek.rkt b/racket/src/io/port/read-and-peek.rkt
index 5b08df991b..375edbdfa9 100644
--- a/racket/src/io/port/read-and-peek.rkt
+++ b/racket/src/io/port/read-and-peek.rkt
@@ -58,15 +58,16 @@
        (end-atomic)
        eof]
       [else
-       (define buf-pos (core-port-buffer-pos in))
-       (define buf-end (core-port-buffer-end in))
+       (define buffer (core-port-buffer in))
+       (define buf-pos (direct-pos buffer))
+       (define buf-end (direct-end buffer))
        (cond
          [(buf-pos . fx< . buf-end)
           ;; Read bytes directly from buffer
           (define v (fxmin (fx- buf-end buf-pos) (fx- end start)))
           (define new-pos (fx+ buf-pos v))
-          (bytes-copy! bstr start (core-port-buffer in) buf-pos new-pos)
-          (set-core-port-buffer-pos! in new-pos)
+          (bytes-copy! bstr start (direct-bstr buffer) buf-pos new-pos)
+          (set-direct-pos! buffer new-pos)
           (when (or (pair? extra-count-ins) (core-port-count in))
             (port-count-all! in extra-count-ins v bstr start))
           (end-atomic)
@@ -152,13 +153,14 @@
        (end-atomic)
        eof]
       [else
-       (define buf-pos (+ (core-port-buffer-pos in) skip))
-       (define buf-end (core-port-buffer-end in))
+       (define buffer (core-port-buffer in))
+       (define buf-pos (+ (direct-pos buffer) skip))
+       (define buf-end (direct-end buffer))
        (cond
          [(buf-pos . < . buf-end)
           ;; Copy bytes from buffer
           (define v (min (- buf-end buf-pos) (- end start)))
-          (bytes-copy! bstr start (core-port-buffer in) buf-pos (fx+ buf-pos v))
+          (bytes-copy! bstr start (direct-bstr buffer) buf-pos (fx+ buf-pos v))
           (end-atomic)
           v]
          [else
@@ -205,11 +207,12 @@
 ;; Try the buffer shortcut first
 (define (read-a-byte who in #:special-ok? [special-ok? #f])
   (start-atomic)
-  (define pos (core-port-buffer-pos in))
+  (define buffer (core-port-buffer in))
+  (define pos (direct-pos buffer))
   (cond
-    [(pos . fx< . (core-port-buffer-end in))
-     (define b (bytes-ref (core-port-buffer in) pos))
-     (set-core-port-buffer-pos! in (fx+ pos 1))
+    [(pos . fx< . (direct-end buffer))
+     (define b (bytes-ref (direct-bstr buffer) pos))
+     (set-direct-pos! buffer (fx+ pos 1))
      (when (core-port-count in)
        (port-count-byte! in b))
      (end-atomic)
@@ -232,10 +235,11 @@
 ;; Try the buffer shortcut first
 (define (peek-a-byte who in skip-k #:special-ok? [special-ok? #f])
   (start-atomic)
-  (define pos (+ (core-port-buffer-pos in) skip-k))
+  (define buffer (core-port-buffer in))
+  (define pos (+ (direct-pos buffer) skip-k))
   (cond
-    [(pos . < . (core-port-buffer-end in))
-     (define b (bytes-ref (core-port-buffer in) pos))
+    [(pos . < . (direct-end buffer))
+     (define b (bytes-ref (direct-bstr buffer) pos))
      (end-atomic)
      b]
     [else
diff --git a/racket/src/io/port/write.rkt b/racket/src/io/port/write.rkt
index da750e9bcf..f4dbeae9ca 100644
--- a/racket/src/io/port/write.rkt
+++ b/racket/src/io/port/write.rkt
@@ -23,14 +23,15 @@
        (end-atomic)
        0]
       [else
-       (define buf-pos (core-port-buffer-pos out))
-       (define buf-end (core-port-buffer-end out))
+       (define buffer (core-port-buffer out))
+       (define buf-pos (direct-pos buffer))
+       (define buf-end (direct-end buffer))
        (cond
          [(buf-pos . fx< . buf-end)
           ;; Copy bytes directly to buffer
           (define v (fxmin (fx- buf-end buf-pos) (fx- end start)))
-          (bytes-copy! (core-port-buffer out) buf-pos bstr start (fx+ start v))
-          (set-core-port-buffer-pos! out (fx+ buf-pos v))
+          (bytes-copy! (direct-bstr buffer) buf-pos bstr start (fx+ start v))
+          (set-direct-pos! buffer (fx+ buf-pos v))
           (when (or (pair? extra-count-outs) (core-port-count out))
             (port-count-all! out extra-count-outs v bstr start))
           (end-atomic)
diff --git a/racket/src/thread/sandman.rkt b/racket/src/thread/sandman.rkt
index 83c8a91bc4..62d753b1a8 100644
--- a/racket/src/thread/sandman.rkt
+++ b/racket/src/thread/sandman.rkt
@@ -133,7 +133,7 @@
   (sandman
    ;; sleep
    (lambda (timeout-at)
-     (host:sleep (/ (- (or timeout-at (distant-future)) (current-inexact-milliseconds)) 1000.0)))
+     (host:sleep (max 0.0 (/ (- (or timeout-at (distant-future)) (current-inexact-milliseconds)) 1000.0))))
 
    ;; poll
    (lambda (mode wakeup)