diff --git a/racket/src/io/common/class.rkt b/racket/src/io/common/class.rkt
new file mode 100644
index 0000000000..edd6711820
--- /dev/null
+++ b/racket/src/io/common/class.rkt
@@ -0,0 +1,405 @@
+#lang racket/base
+(require (for-syntax racket/base
+                     racket/struct-info)
+         racket/stxparam)
+
+;; A class system that is somewhat similar to `racket/class`, but
+;; completely first order, with its structure nature exposed, and
+;; where the notion of "method" is flexible to allow non-procedures in
+;; the vtable.
+;;
+;;  <class-defn> = (class <class-id> <clause> ...)
+;;               | (class <class-id> #:extends <class-id> <clause> ...)
+;;  <clause> = (field [<field-id> <duplicatable-init-expr>] ...)
+;;           | (public [<method-id> <method>] ...)
+;;           | (private [<method-id> <method>] ...)
+;;           | (override [<method-id> <method>] ...)
+;;           | (property [<property-expr> <val-expr>] ...)
+;;  <method> = #f
+;;           | (lambda (<id> ...) <expr> ...+)
+;;           | (case-lambda [(<id> ...) <expr> ...+] ...)
+;;           | <expr> ; must have explicit `self`, etc.
+;;
+;; A <class-id> and its <field>s behave as if they are in
+;; a `struct` declaration where `create-<class-id>` is the
+;; constructor, but an extra `vtable` field is added to
+;; the start of a class's structure if it has no superclass.
+;; The `#:authentic` option is added implicitly.
+;;
+;; Normally, use
+;;   (new <class-id> [<field-id> <expr] ...)
+;; to create an instance of the class, where each unmentioned
+;; <field-id> gets its default value. To override methods for just
+;; this object, use
+;;   (new <class-id> #:override ([<method-id> <method>] ...)
+;;        [<field-id> <expr] ...)
+;; but beware that it involves allocating a new vtable each
+;; time the `new` expression is evaluated.
+;;
+;; Use
+;;    (send <class-id> <obj-expr> <method-id> <arg-expr> ...)
+;; to call a method, or
+;;    (mewthod <class-id> <obj-expr> <method-id>)
+;; to get a method that expects the object as its first argument.
+;;
+;; In a method, fields can be accessed directly by name, and `this` is
+;; bound to the current object.
+
+(provide class
+         this
+         new
+         send
+         method)
+
+(define-syntax-parameter this
+  (lambda (stx)
+    (raise-syntax-error #f "illegal use outside of a method" stx)))
+
+(begin-for-syntax
+  (struct class-info (struct-info methods-id vtable-id vtable-accessor-id fields methods)
+    #:property prop:struct-info (lambda (ci)
+                                  (class-info-struct-info ci))))
+
+(define-syntax (class stx)
+  (define id (syntax-case stx ()
+               [(_ id . _) #'id]))
+  (define super-id (syntax-case stx ()
+                     [(_ id #:extends super-id . _)
+                      #'super-id]
+                     [_ #f]))
+  (define super-ci (and super-id
+                        (syntax-local-value super-id)))
+  (define (combine-ids ctx . elems)
+    (datum->syntax ctx (string->symbol (apply string-append
+                                              (for/list ([elem (in-list elems)])
+                                                (if (string? elem)
+                                                    elem
+                                                    (symbol->string (syntax-e elem))))))))
+  (define methods-id (combine-ids #'here id "-methods"))
+  (define (add-procs base-id l what #:can-immutable? [can-immutable? #f])
+    (for/list ([e (in-list l)])
+      (syntax-case e ()
+        [(id expr #:immutable)
+         can-immutable?
+         (list #'id #'expr (combine-ids base-id base-id "-" #'id) #f)]
+        [(id expr)
+         (list #'id #'expr (combine-ids base-id base-id "-" #'id) (combine-ids #'id "set-" base-id "-" #'id "!"))]
+        [_ (raise-syntax-error #f (format "bad ~a clause" what) stx e)])))
+  (define-values (new-fields new-methods override-methods locals properties)
+    (let ([l-stx (syntax-case stx ()
+                   [(_ _ #:extends _ . rest) #'rest]
+                   [(_ _ . rest) #'rest])])
+      (let loop ([l-stx l-stx] [new-fields null] [new-methods null] [override-methods null] [locals null] [properties null])
+        (syntax-case l-stx (field public override private property)
+          [() (values new-fields new-methods override-methods locals properties)]
+          [((field fld ...) . rest)
+           (loop #'rest
+                 (add-procs id (syntax->list #'(fld ...)) "field" #:can-immutable? #t)
+                 new-methods
+                 override-methods
+                 locals
+                 properties)]
+          [((public method ...) . rest)
+           (loop #'rest
+                 new-fields
+                 (add-procs methods-id (syntax->list #'(method ...)) "public")
+                 override-methods
+                 locals
+                 properties)]
+          [((override method ...) . rest)
+           (loop #'rest new-fields new-methods (syntax->list #'(method ...)) locals properties)]
+          [((private method ...) . rest)
+           (loop #'rest new-fields new-methods override-methods (syntax->list #'(method ...)) properties)]
+          [((property prop ...) . rest)
+           (loop #'rest new-fields new-methods override-methods locals (syntax->list #'((#:property . prop) ...)))]
+          [(other . _)
+           (raise-syntax-error #f "unrecognized" stx #'other)]))))
+  (define all-fields (if super-ci
+                         (append (class-info-fields super-ci) new-fields)
+                         new-fields))
+  (for ([override (in-list override-methods)])
+    (syntax-case override ()
+      [(method-id _) (check-member stx #'method-id (if super-ci (class-info-methods super-ci) null) "method")]
+      [_ (raise-syntax-error #f "bad override clause" stx override)]))
+  (with-syntax ([((field-id field-init-expr field-accessor-id field-mutator-maybe-id) ...) all-fields])
+    (define wrapped-new-methods
+      (for/list ([new-method (in-list new-methods)])
+        (syntax-case new-method ()
+          [(method-id method-init-expr . rest)
+           #'(method-id (let ([method-id
+                               (bind-fields-in-body
+                                ([field-id field-accessor-id field-mutator-maybe-id] ...)
+                                method-init-expr)])
+                          method-id)
+                        . rest)])))
+    (define all-methods/vtable (if super-ci
+                                   (append (for/list ([method (in-list (class-info-methods super-ci))])
+                                             (syntax-case method ()
+                                               [(method-id method-init-expr . rest)
+                                                (or (for/or ([override (in-list override-methods)])
+                                                      (syntax-case override ()
+                                                        [(override-id override-init-expr . _)
+                                                         (and (eq? (syntax-e #'method-id) (syntax-e #'override-id))
+                                                              (list* #'method-id
+                                                                     #'(let ([method-id
+                                                                              (bind-fields-in-body
+                                                                               ([field-id field-accessor-id field-mutator-maybe-id] ...)
+                                                                               override-init-expr)])
+                                                                         method-id)
+                                                                     #'rest))]))
+                                                    method)]))
+                                           wrapped-new-methods)
+                                   wrapped-new-methods))
+    (define vtable-id (combine-ids #'here id "-vtable"))
+    (define all-methods/next (for/list ([method (in-list all-methods/vtable)])
+                               (syntax-case method ()
+                                 [(method-id method-init-expr method-accessor-id . _)
+                                  (with-syntax ([vtable-id vtable-id])
+                                    (list #'method-id
+                                          #'(method-accessor-id vtable-id)
+                                          #'method-accessor-id))])))
+    (with-syntax ([id id]
+                  [(super-ids ...) (if super-id
+                                       (list super-id)
+                                       null)]
+                  [quoted-super-id (and super-id #`(quote-syntax #,super-id))]
+                  [(vtable-ids ...) (if super-id
+                                        null
+                                        (list (datum->syntax id 'vtable)))]
+                  [vtable-accessor-id (if super-ci
+                                          (class-info-vtable-accessor-id super-ci)
+                                          (combine-ids id id "-vtable"))]
+                  [vtable-id vtable-id]
+                  [struct:id (combine-ids id "struct:" id)]
+                  [make-id (combine-ids id "create-" id)]
+                  [id? (combine-ids id id "?")]
+                  [methods-id methods-id]
+                  [(super-methods-ids ...) (if super-ci
+                                               (list (class-info-methods-id super-ci))
+                                               null)]
+                  [(new-field-id/annotated ...) (for/list ([new-field (in-list new-fields)])
+                                                  (syntax-case new-field ()
+                                                    [(id _ _ #f) #'id]
+                                                    [(id . _) #'[id #:mutable]]))]
+                  [((new-method-id . _) ...) new-methods]
+                  [((_ _ rev-field-accessor-id . _) ...) (reverse all-fields)]
+                  [((_ _ _ rev-field-mutator-maybe-id) ...) (reverse all-fields)]
+                  [((method-id method-init-expr/vtable . _) ...) all-methods/vtable]
+                  [((_ method-init-expr/next  method-accessor-id) ...) all-methods/next]
+                  [((local-id local-expr) ...) locals]
+                  [(local-tmp-id ...) (generate-temporaries locals)]
+                  [((propss ...) ...) properties])
+      #`(begin
+          (struct id super-ids ... (vtable-ids ... new-field-id/annotated ...)
+            #:omit-define-syntaxes
+            #:constructor-name make-id
+            #:authentic
+            propss ... ...)
+          (struct methods-id super-methods-ids ... (new-method-id ...))
+          (define vtable-id (methods-id method-init-expr/vtable ...))
+          (begin
+            (define local-tmp-id (let ([local-id
+                                        (bind-fields-in-body ([field-id field-accessor-id field-mutator-maybe-id] ...)
+                                                             local-expr)])
+                                   local-id))
+            (define-syntax (local-id stx)
+              (syntax-case stx ()
+                [(_ arg (... ...))
+                 (with-syntax ([this-id (datum->syntax #'here 'this stx)])
+                   (syntax/loc stx (local-tmp-id this-id arg (... ...))))])))
+          ...
+          (define-syntax id
+            (class-info (list (quote-syntax struct:id)
+                              (quote-syntax make-id)
+                              (quote-syntax id?)
+                              (list (quote-syntax rev-field-accessor-id) ... (quote-syntax vtable-accessor-id))
+                              (list (maybe-quote-syntax rev-field-mutator-maybe-id) ... #f)
+                              quoted-super-id)
+                        (quote-syntax methods-id)
+                        (quote-syntax vtable-id)
+                        (quote-syntax vtable-accessor-id)
+                        (list (list (quote-syntax field-id) (quote-syntax field-init-expr)
+                                    (quote-syntax field-accessor-id) (maybe-quote-syntax field-mutator-maybe-id))
+                              ...)
+                        (list (list (quote-syntax method-id) (quote-syntax method-init-expr/next)
+                                    (quote-syntax method-accessor-id))
+                              ...)))))))
+
+(define-syntax (bind-fields-in-body stx)
+  (syntax-case stx (lambda case-lambda)
+    [(_ fields #f) #'#f]
+    [(_ fields (form . rest))
+     #'(bind-fields-in-body fields form (form . rest))]
+    [(_ fields ctx (lambda (arg ...) body0 body ...))
+     #'(bind-fields-in-body fields ctx (case-lambda [(arg ...) body0 body ...]))]
+    [(_ fields ctx (case-lambda clause ...))
+     (with-syntax ([(new-clause ...)
+                    (for/list ([clause (in-list (syntax->list #'(clause ...)))])
+                      (syntax-case clause ()
+                        [[(arg ...) body0 body ...]
+                         (with-syntax ([(arg-tmp ...) (generate-temporaries #'(arg ...))])
+                           #'[(this-id arg-tmp ...)
+                              (syntax-parameterize ([this (make-rename-transformer #'this-id)])
+                                (bind-fields
+                                 fields
+                                 this-id ctx
+                                 (let-syntax ([arg (make-rename-transformer #'arg-tmp)] ...)
+                                   body0 body ...)))])]))])
+       (syntax/loc (syntax-case stx () [(_ _ _ rhs) #'rhs])
+         (case-lambda new-clause ...)))]
+    [(_ fields _ expr)
+     #'expr]))
+
+(define-syntax (bind-fields stx)
+  (syntax-case stx ()
+    [(_ ([field-id field-accessor-id field-mutator-maybe-id] ...) this-id ctx body)
+     (with-syntax ([(field-id ...) (for/list ([field-id (in-list (syntax->list #'(field-id ...)))])
+                                     (datum->syntax #'ctx (syntax-e field-id)))])
+       #'(let-syntax ([field-id (make-set!-transformer
+                                 (lambda (stx)
+                                   (syntax-case stx (set!)
+                                     [(set! _ rhs) (if (syntax-e (quote-syntax field-mutator-maybe-id))
+                                                       (syntax/loc stx (field-mutator-maybe-id this-id rhs))
+                                                       (raise-syntax-error #f "field is immutable" stx))]
+                                     [(_ arg (... ...)) (syntax/loc stx ((field-accessor-id this-id) arg (... ...)))]
+                                     [else (syntax/loc stx (field-accessor-id this-id))])))]
+                      ...)
+           body))]))
+
+(define-syntax (new stx)
+  (syntax-case stx ()
+    [(_ class-id #:override (override ...) init ...)
+     (let ([ci (and (identifier? #'class-id)
+                    (syntax-local-value #'class-id (lambda () #f)))])
+       (unless (class-info? ci)
+         (raise-syntax-error #f "not a class identifier" stx #'class-id))
+       (for ([init (in-list (syntax->list #'(init ...)))])
+         (syntax-case init ()
+           [(field-id _) (check-member stx #'field-id (class-info-fields ci) "field")]
+           [_ (raise-syntax-error #f "bad field-inialization clause" stx init)]))
+       (for ([override (in-list (syntax->list #'(override ...)))])
+         (syntax-case override ()
+           [(method-id _) (check-member stx #'method-id (class-info-methods ci) "method")]
+           [_ (raise-syntax-error #f "bad method-override clause" stx override)]))
+       (define field-exprs (for/list ([field (in-list (class-info-fields ci))])
+                             (syntax-case field ()
+                               [(field-id field-expr . _)
+                                (or (for/or ([init (in-list (syntax->list #'(init ...)))])
+                                      (syntax-case init ()
+                                        [(id expr)
+                                         (and (eq? (syntax-e #'id) (syntax-e #'field-id))
+                                              #'expr)]))
+                                    #'field-expr)])))
+       (define overrides (syntax->list #'(override ...)))
+       (with-syntax ([make-id (cadr (class-info-struct-info ci))]
+                     [vtable-id (class-info-vtable-id ci)]
+                     [(field-expr ...) field-exprs])
+         (cond
+           [(null? overrides)
+            (syntax/loc stx (make-id vtable-id field-expr ...))]
+           [else
+            (with-syntax ([methods-id (class-info-methods-id ci)]
+                          [(method-expr ...)
+                           (for/list ([method (in-list (class-info-methods ci))])
+                             (syntax-case method ()
+                               [(id _ selector-id . _)
+                                (or (for/or ([override (in-list overrides)])
+                                      (syntax-case override ()
+                                        [(override-id expr)
+                                         (and (eq? (syntax-e #'override-id) (syntax-e #'id))
+                                              (with-syntax ([((field-id _ field-accessor-id field-mutator-maybe-id) ...)
+                                                             (class-info-fields ci)])
+                                                #'(bind-fields-in-body
+                                                   ([field-id field-accessor-id field-mutator-maybe-id] ...)
+                                                   expr)))]))
+                                    #'(selector-id vtable-id))]))])
+              (syntax/loc stx (make-id (methods-id method-expr ...)
+                                       field-expr ...)))])))]
+    [(_ class-id init ...)
+     (syntax/loc stx (new class-id #:override () init ...))]))
+
+(define-for-syntax (send-or-method stx call?)
+  (syntax-case stx ()
+    [(_ class-id obj method-id arg ...)
+     (let ([ci (and (identifier? #'class-id)
+                    (syntax-local-value #'class-id (lambda () #f)))])
+       (unless (class-info? ci)
+         (raise-syntax-error #f "not a class identifier" stx #'class-id))
+       (define method-accessor-id
+         (or (for/or ([method (in-list (class-info-methods ci))])
+               (syntax-case method ()
+                 [(id _ accessor-id)
+                  (and (eq? (syntax-e #'id) (syntax-e #'method-id))
+                       #'accessor-id)]))
+             (raise-syntax-error #f "cannot find method" stx #'method-id)))
+       (with-syntax ([vtable-accessor-id (class-info-vtable-accessor-id ci)]
+                     [method-accessor-id method-accessor-id])
+         (if call?
+             #'(let ([o obj])
+                 ((method-accessor-id (vtable-accessor-id o)) o arg ...))
+             #'(method-accessor-id (vtable-accessor-id obj)))))]))
+
+(define-syntax (send stx)
+  (send-or-method stx #t))
+
+;; Gets a method to be called as a procedure, where the call must
+;; include the "self" argument --- so, less safe than `send`, but
+;; allows external handling for a method that is #f.
+(define-syntax (method stx)
+  (syntax-case stx ()
+    [(_ class-id obj method-id)
+     (send-or-method stx #f)]))
+
+(define-for-syntax (check-member stx id l what)
+  (or (for/or ([e (in-list l)])
+        (syntax-case e ()
+          [(e-id . _)
+           (eq? (syntax-e #'e-id) (syntax-e id))]))
+      (raise-syntax-error #f (format "no such ~a" what) stx id)))
+
+(begin-for-syntax
+  (define-syntax maybe-quote-syntax
+    (syntax-rules ()
+      [(_ #f) #f]
+      [(_ e) (quote-syntax e)])))
+
+;; ----------------------------------------
+
+(module+ test
+  (class example
+    (field
+     [a 1 #:immutable]
+     [b 2])
+    (private
+      [other (lambda (q) (list q this))])
+    (public
+     [q #f]
+     [m (lambda (z) (list a (other b)))]
+     [n (lambda (x y z) (vector a b x y z))]))
+
+  (class sub #:extends example
+    (field
+     [c 3]
+     [d 4])
+    (override
+      [m (lambda (z) 'other)])
+    (property
+     [prop:custom-write (lambda (s o m)
+                          (write 'sub: o)
+                          (write (sub-d s) o))]))
+
+  (define ex (new example [b 5]))
+
+  (send example ex m 'ok)
+  (method example ex m)
+  (new sub [d 5])
+  (send example (new sub) m 'more)
+  (set-example-b! ex 6)
+
+  (define ex2 (new example
+                   #:override
+                   ([q (lambda (x y z)
+                         (box (vector x y z a b)))])
+                   [b 'b]
+                   [a 'a]))
+  (send example ex2 n 1 2 3))
diff --git a/racket/src/io/port/buffer-mode.rkt b/racket/src/io/port/buffer-mode.rkt
index 50be72adfc..835d67045a 100644
--- a/racket/src/io/port/buffer-mode.rkt
+++ b/racket/src/io/port/buffer-mode.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -16,11 +17,11 @@
                 [(output-port? p) (->core-output-port p)]
                 [else
                  (raise-argument-error 'file-stream-buffer-mode "port?" p)])])
-       (define buffer-mode (core-port-buffer-mode p))
+       (define buffer-mode (method core-port p buffer-mode))
        (atomically
         (check-not-closed who p)
         (and buffer-mode
-             (buffer-mode (core-port-self p)))))]
+             (buffer-mode p))))]
     [(p mode)
      (unless (or (input-port? p) (output-port? p))
        (raise-argument-error who "port?" p))
@@ -33,10 +34,10 @@
      (define (set-buffer-mode p)
        (atomically
         (check-not-closed who p)
-        (define buffer-mode (core-port-buffer-mode p))
+        (define buffer-mode (method core-port p buffer-mode))
         (cond
           [buffer-mode
-           (buffer-mode (core-port-self p) mode)
+           (buffer-mode p mode)
            #t]
           [else #f])))
      (cond
diff --git a/racket/src/io/port/bytes-input.rkt b/racket/src/io/port/bytes-input.rkt
index b359646fca..edb61190ce 100644
--- a/racket/src/io/port/bytes-input.rkt
+++ b/racket/src/io/port/bytes-input.rkt
@@ -18,13 +18,10 @@
          peek-bytes!
          peek-bytes-avail!
          peek-bytes-avail!*
-         peek-bytes-avail!/enable-break
-
-         do-read-byte/core-port)
+         peek-bytes-avail!/enable-break)
 
 (module+ internal
-  (provide do-read-bytes!
-           peek-byte/core-port))
+  (provide do-read-bytes!))
 
 ;; ----------------------------------------
 
@@ -51,13 +48,7 @@
 
 (define/who (read-byte [orig-in (current-input-port)])
   (let ([in (->core-input-port orig-in who)])
-    (do-read-byte/core-port who in)))
-
-(define (do-read-byte/core-port who in)
-  (define read-byte (core-input-port-read-byte in))
-  (cond
-    [read-byte (do-read-byte who read-byte in)]
-    [else (read-byte-via-bytes in #:special-ok? #f)]))
+    (read-a-byte who in)))
 
 (define/who (read-bytes amt [in (current-input-port)])
   (check who exact-nonnegative-integer? amt)
@@ -133,14 +124,7 @@
   (check who input-port? orig-in)
   (check who exact-nonnegative-integer? skip-k)
   (let ([in (->core-input-port orig-in)])
-    (peek-byte/core-port in skip-k)))
-
-(define/who (peek-byte/core-port in skip-k)
-  (define peek-byte (and (zero? skip-k)
-                         (core-input-port-peek-byte in)))
-  (cond
-    [peek-byte (do-peek-byte who peek-byte in)]
-    [else (peek-byte-via-bytes in skip-k #:special-ok? #f)]))
+    (peek-a-byte who in skip-k)))
 
 (define/who (peek-bytes amt skip-k [in (current-input-port)])
   (check who exact-nonnegative-integer? amt)
diff --git a/racket/src/io/port/bytes-output.rkt b/racket/src/io/port/bytes-output.rkt
index 7702c680bc..47bf5dcc1a 100644
--- a/racket/src/io/port/bytes-output.rkt
+++ b/racket/src/io/port/bytes-output.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 (require racket/fixnum
          "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "output-port.rkt"
@@ -77,15 +78,15 @@
   (let ([out (->core-output-port out)])
     (atomically
      (check-not-closed who out)
-     (define get-write-evt (core-output-port-get-write-evt out))
+     (define get-write-evt (method core-output-port out get-write-evt))
      (unless get-write-evt
        (end-atomic)
        (raise-arguments-error who
                               "port does not support output events"
                               "port" out))
-     (get-write-evt (core-port-self out) out bstr start-pos end-pos))))
+     (get-write-evt out bstr start-pos end-pos))))
 
 (define/who (port-writes-atomic? out)
   (check who output-port? out)
   (let ([out (->core-output-port out)])
-    (and (core-output-port-get-write-evt out) #t)))
+    (and (method core-output-port out get-write-evt) #t)))
diff --git a/racket/src/io/port/bytes-port.rkt b/racket/src/io/port/bytes-port.rkt
index ee3a94b099..118ba75350 100644
--- a/racket/src/io/port/bytes-port.rkt
+++ b/racket/src/io/port/bytes-port.rkt
@@ -2,7 +2,7 @@
 (require racket/fixnum
          "../common/check.rkt"
          "../common/fixnum.rkt"
-         "../common/object.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -17,8 +17,6 @@
          get-output-bytes
          string-port?)
 
-(struct input-bytes-data ())
-
 (define/who (open-input-bytes bstr [name 'string])
   (check who bytes? bstr)
   (define p (make-input-bytes (bytes->immutable-bytes bstr) name))
@@ -26,144 +24,174 @@
     (port-count-lines! p))
   p)
 
-(define-constructor (make-input-bytes bstr name)
-  (define-fixnum i 0)
-  (define alt-pos #f)
-  (define len (bytes-length bstr))
+(class bytes-input-port #:extends core-input-port
+  (field
+   [progress-sema #f]
+   [commit-manager #f]
+   [bstr #f] ; normally installed as buffer
+   [pos 0]   ; used when bstr is not installed as buffer
+   [alt-pos #f])
 
-  (define progress-sema #f)
-  (define (progress!)
-    (when progress-sema
-      (semaphore-post progress-sema)
-      (set! progress-sema #f)))
+  (private
+    ;; in atomic mode
+    [progress!
+     (lambda ()
+       (when progress-sema
+         (semaphore-post progress-sema)
+         (set! progress-sema #f)))]
 
-  (define commit-manager #f)
+    ;; in atomic mode [can leave atomic mode temporarily]
+    ;; After this function returns, complete any commit-changing work
+    ;; before leaving atomic mode again.
+    [pause-waiting-commit
+     (lambda ()
+       (when commit-manager
+         (commit-manager-pause commit-manager)))]
 
-  ;; in atomic mode [can leave atomic mode temporarily]
-  ;; After this function returns, complete any commit-changing work
-  ;; before leaving atomic mode again.
-  (define (pause-waiting-commit)
-    (when commit-manager
-      (commit-manager-pause commit-manager)))
-  ;; in atomic mode [can leave atomic mode temporarily]
-  (define (wait-commit progress-evt ext-evt finish)
-    (cond
-      [(and (not commit-manager)
-            ;; Try shortcut:
-            (not (sync/timeout 0 progress-evt))
-            (sync/timeout 0 ext-evt))
-       (finish)
-       #t]
-      [else
-       ;; General case to support blocking and potentially multiple
-       ;; commiting threads:
-       (unless commit-manager
-         (set! commit-manager (make-commit-manager)))
-       (commit-manager-wait commit-manager progress-evt ext-evt finish)]))
+    ;; in atomic mode [can leave atomic mode temporarily]
+    [wait-commit
+     (lambda (progress-evt ext-evt finish)
+       (cond
+         [(and (not commit-manager)
+               ;; Try shortcut:
+               (not (sync/timeout 0 progress-evt))
+               (sync/timeout 0 ext-evt))
+          (finish)
+          #t]
+         [else
+          ;; General case to support blocking and potentially multiple
+          ;; commiting threads:
+          (unless commit-manager
+            (set! commit-manager (make-commit-manager)))
+          (commit-manager-wait commit-manager progress-evt ext-evt finish)]))]
 
-  (make-core-input-port
-   #:name name
-   #:data (input-bytes-data)
-   #:self self
+    ;; in atomic mode
+    [in-buffer-pos
+     (lambda ()
+       (if buffer
+           buffer-pos
+           pos))])
 
-   #:prepare-change
-   (method
-    (lambda ()
-      (pause-waiting-commit)))
+  (override
+    [close
+     (lambda ()
+       (set! commit-manager #f) ; to indicate closed
+       (progress!)
+       (set! bstr #f)
+       (when buffer
+         (set! offset buffer-pos)
+         (set! buffer #f)))]
+    [file-position
+     (case-lambda
+       [() (or alt-pos (in-buffer-pos))]
+       [(given-pos)
+        (define len buffer-end)
+        (define new-pos (if (eof-object? given-pos)
+                            len
+                            (min len given-pos)))
+        (if buffer
+            (set! buffer-pos new-pos)
+            (set! pos new-pos))
+        (set! alt-pos (and (not (eof-object? given-pos))
+                           (given-pos . > . new-pos)
+                           given-pos))])]
 
-   #:read-byte
-   (method
-    (lambda ()
-      (let ([pos i])
-        (if (pos . fx< . len)
-            (begin
-              (set! i (fx+ pos 1))
-              (progress!)
-              (bytes-ref bstr pos))
-            eof))))
+    [prepare-change
+     (lambda ()
+       (pause-waiting-commit))]
 
-   #:read-in
-   (method
-    (lambda (dest-bstr start end copy?)
-      (define pos i)
-      (cond
-        [(pos . < . len)
-         (define amt (min (- end start) (- len pos)))
-         (set! i (+ pos amt))
-         (bytes-copy! dest-bstr start bstr pos (+ pos amt))
-         (progress!)
-         amt]
-        [else eof])))
+    [read-in
+     (lambda (dest-bstr start end copy?)
+       (define len buffer-end)
+       (define i (in-buffer-pos))
+       (cond
+         [(i . < . len)
+          (define amt (min (- end start) (fx- len i)))
+          (define new-pos (fx+ i amt))
+          (cond
+            [(not count)
+             ;; Keep/resume fast mode
+             (set! buffer-pos new-pos)
+             (set! offset 0)
+             (set! buffer bstr)]
+            [else
+             (set! pos new-pos)])
+          (bytes-copy! dest-bstr start bstr i new-pos)
+          (progress!)
+          amt]
+         [else eof]))]
 
-   #:peek-byte
-   (method
-    (lambda ()
-      (let ([pos i])
-        (if (pos . < . len)
-            (bytes-ref bstr pos)
-            eof))))
+    [peek-in
+     (lambda (dest-bstr start end skip progress-evt copy?)
+       (define i (in-buffer-pos))
+       (define len buffer-end)
+       (define at-pos (+ i skip))
+       (cond
+         [(and progress-evt (sync/timeout 0 progress-evt))
+          #f]
+         [(at-pos . < . len)
+          (define amt (min (- end start) (fx- len at-pos)))
+          (bytes-copy! dest-bstr start bstr at-pos (fx+ at-pos amt))
+          amt]
+         [else eof]))]
 
-   #:peek-in
-   (method
-    (lambda (dest-bstr start end skip progress-evt copy?)
-      (define pos (+ i skip))
-      (cond
-        [(and progress-evt (sync/timeout 0 progress-evt))
-         #f]
-        [(pos . < . len)
-         (define amt (min (- end start) (- len pos)))
-         (bytes-copy! dest-bstr start bstr pos (+ pos amt))
-         amt]
-        [else eof])))
+    [byte-ready
+     (lambda (work-done!)
+       ((in-buffer-pos) . < . buffer-end))]
+   
+    [get-progress-evt
+     (lambda ()
+       (define new-sema
+         (or progress-sema
+             (let ([sema (make-semaphore)])
+               (set! progress-sema sema)
+               ;; set port to slow mode:
+               (when buffer
+                 (define i buffer-pos)
+                 (set! pos i)
+                 (set! offset i)
+                 (set! buffer #f)
+                 (set! buffer-pos buffer-end))
+               sema)))
+       (semaphore-peek-evt new-sema))]
 
-   #:byte-ready
-   (method
-    (lambda (work-done!)
-      (i . < . len)))
+    [commit
+     (lambda (amt progress-evt ext-evt finish)
+       (wait-commit
+        progress-evt ext-evt
+        ;; in atomic mode, maybe in a different thread:
+        (lambda ()
+          (define len buffer-end)
+          (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))
+            (cond
+              [(not count)
+               ;; Keep/resume fast mode
+               (set! buffer-pos (fx+ i amt))
+               (set! buffer bstr)
+               (set! offset 0)]
+              [else
+               (set! pos (fx+ i amt))])
+            (progress!)
+            (finish dest-bstr)))))]
 
-   #:close
-   (method
-    (lambda ()
-      (set! commit-manager #f) ; to indicate closed
-      (progress!)))
+    [count-lines!
+     (lambda ()
+       (when buffer
+         (define i buffer-pos)
+         (set! offset i)
+         (set! pos i)
+         (set! buffer #f)
+         (set! buffer-pos buffer-end)))]))
 
-   #:get-progress-evt
-   (method
-    (lambda ()
-      (unless progress-sema
-        (set! progress-sema (make-semaphore)))
-      (semaphore-peek-evt progress-sema)))
-
-   #:commit
-   (method
-    (lambda (amt progress-evt ext-evt finish)
-      (unless commit-manager
-        (set! commit-manager (make-commit-manager)))
-      (commit-manager-wait
-       commit-manager
-       progress-evt ext-evt
-       ;; in atomic mode, maybe in a different thread:
-       (lambda ()
-         (let ([amt (min amt (- len i))])
-           (define dest-bstr (make-bytes amt))
-           (bytes-copy! dest-bstr 0 bstr i (+ i amt))
-           (set! i (+ i amt))
-           (progress!)
-           (finish dest-bstr))))))
-
-   #:file-position
-   (method
-    (case-lambda
-      [() (or alt-pos i)]
-      [(new-pos)
-       (set! i (if (eof-object? new-pos)
-                   len
-                   (min len new-pos)))
-       (set! alt-pos
-             (and new-pos
-                  (not (eof-object? new-pos))
-                  (new-pos . > . i)
-                  new-pos))]))))
+(define (make-input-bytes bstr name)
+  (new bytes-input-port
+       [name name]
+       [buffer bstr]
+       [buffer-end (bytes-length bstr)]
+       [bstr bstr]))
 
 ;; ----------------------------------------
 
@@ -183,20 +211,20 @@
      #:evt o
      #:write-out
      (lambda (o src-bstr src-start src-end nonblock? enable-break? copy?)
-       ((core-output-port-write-out o) (core-port-self o) src-bstr src-start src-end nonblock? enable-break? copy?))
+       (send core-output-port o write-out src-bstr src-start src-end nonblock? enable-break? copy?))
      #:close
-     (lambda (o) ((core-port-close o) (core-port-self o)))
+     (lambda (o) (send core-port o close))
      #:get-write-evt
-     (and (core-output-port-get-write-evt o)
+     (and (method core-output-port o get-write-evt)
           (lambda (o orig-o bstr start-k end-k)
-            ((core-output-port-get-write-evt o) (core-port-self o) o bstr start-k end-k)))
+            (send core-output-port o get-write-evt bstr start-k end-k)))
      #:get-location
-     (and (core-port-get-location o)
-          (lambda (o) ((core-port-get-location o) (core-port-self o))))
+     (and (method core-port o get-location)
+          (lambda (o) (send core-port o get-location)))
      #:count-lines!
-     (and (core-port-count-lines! o)
+     (and (method core-port o count-lines!)
           (lambda (o)
-            ((core-port-count-lines! o) (core-port-self o))))
+            (send core-port o count-lines!)))
      #:file-position
      (case-lambda
        [(o) (pipe-write-position o)]
@@ -215,7 +243,7 @@
                                     "position" new-pos))
            (pipe-write-position o len)
            (define amt (- new-pos len))
-           ((core-output-port-write-out o) (core-port-self o) (make-bytes amt 0) 0 amt #f #f #f)
+           (send core-output-port o write-out (make-bytes amt 0) 0 amt #f #f #f)
            (void)]
           [else
            (pipe-write-position o new-pos)])])))
@@ -253,7 +281,7 @@
   (cond
     [(input-port? p)
      (let ([p (->core-input-port p)])
-       (input-bytes-data? (core-port-data p)))]
+       (bytes-input-port? p))]
     [(output-port? p)
      (let ([p (->core-output-port p)])
        (output-bytes-data? (core-port-data p)))]
diff --git a/racket/src/io/port/check.rkt b/racket/src/io/port/check.rkt
index 991c590ebf..7363cec33a 100644
--- a/racket/src/io/port/check.rkt
+++ b/racket/src/io/port/check.rkt
@@ -12,7 +12,7 @@
 ;; that is prefixed when a port-closed check normally needs
 ;; to happen atomically with respect to the check.
 (define (check-not-closed who cp)
-  (when (closed-state-closed? (core-port-closed cp))
+  (when (core-port-closed? cp)
     (end-atomic)
     (define input? (core-input-port? cp))
     (raise-arguments-error who
diff --git a/racket/src/io/port/close.rkt b/racket/src/io/port/close.rkt
index 1202512031..89da827b1b 100644
--- a/racket/src/io/port/close.rkt
+++ b/racket/src/io/port/close.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -19,21 +20,20 @@
              [(output-port? p) (->core-output-port p)]
              [else
               (raise-argument-error 'close-input-port "port?" p)])])
-    (closed-state-closed? (core-port-closed p))))
+    (core-port-closed? p)))
 
 ;; maybe in atomic mode via custodian shutdown:
 (define (close-port p)
-  (define closed (core-port-closed p))
-  (unless (closed-state-closed? closed)
+  (unless (core-port-closed? p)
     (atomically
-     ((core-port-close p) (core-port-self p))
-     (set-closed-state! closed))))
+     (send core-port p close)
+     (set-closed-state! p))))
 
 ;; in atomic mode
-(define (set-closed-state! closed)
-  (unless (closed-state-closed? closed)
-    (set-closed-state-closed?! closed #t)
-    (let ([s (closed-state-closed-sema closed)])
+(define (set-closed-state! p)
+  (unless (core-port-closed? p)
+    (set-core-port-closed?! p #t)
+    (let ([s (core-port-closed-sema p)])
       (when s (semaphore-post s)))))
 
 (define/who (close-input-port p)
@@ -50,13 +50,12 @@
              [(output-port? p) (->core-output-port p)]
              [else
               (raise-argument-error 'port-closed-evt "port?" p)])])
-    (define closed (core-port-closed p))
     (define sema
       (atomically
-       (or (closed-state-closed-sema closed)
+       (or (core-port-closed-sema p)
            (let ([s (make-semaphore)])
-             (set-closed-state-closed-sema! closed s)
-             (when (closed-state-closed? closed)
+             (set-core-port-closed-sema! p s)
+             (when (core-port-closed? p)
                (semaphore-post s))
              s))))
     (define self (wrap-evt (semaphore-peek-evt sema)
diff --git a/racket/src/io/port/count.rkt b/racket/src/io/port/count.rkt
index 690a0a6d37..1518a95fd7 100644
--- a/racket/src/io/port/count.rkt
+++ b/racket/src/io/port/count.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -31,22 +32,20 @@
              [else (check who #:test #f #:contract "port?" p)])])
     (atomically
      (check-not-closed who p)
-     (unless (core-port-count? p)
-       (set-core-port-count?! p #t)
-       (set-core-port-line! p 1)
-       (set-core-port-column! p 0)
-       (set-core-port-position! p (add1 (or (core-port-offset p) 0)))
-       (define count-lines! (core-port-count-lines! p))
+     (unless (core-port-count p)
+       (set-core-port-count! p (location #f #f 1 0 (add1 (or (core-port-offset p) 0))))
+       (define count-lines! (method core-port p count-lines!))
        (when count-lines!
-         (count-lines! (core-port-self p)))))))
+         (count-lines! p))))))
 
 (define/who (port-counts-lines? p)
-  (core-port-count?
-   (cond
-     [(input-port? p) (->core-input-port p)]
-     [(output-port? p) (->core-output-port p)]
-     [else
-      (check who #:test #f #:contract "port?" p)])))
+  (and (core-port-count
+        (cond
+          [(input-port? p) (->core-input-port p)]
+          [(output-port? p) (->core-output-port p)]
+          [else
+           (check who #:test #f #:contract "port?" p)]))
+       #t))
 
 (define/who (port-next-location p)
   (let ([p (cond
@@ -54,23 +53,24 @@
              [(output-port? p) (->core-output-port p)]
              [else
               (check who #:test #f #:contract "port?" p)])])
+    (define loc (core-port-count p))
     (cond
-      [(core-port-count? p)
+      [loc
        (atomically
         (check-not-closed who p)
-        (define get-location (core-port-get-location p))
+        (define get-location (method core-port p get-location))
         (cond
           [get-location
-           (get-location (core-port-self p))]
+           (get-location p)]
           [else
-           (values (core-port-line p)
-                   (core-port-column p)
-                   (core-port-position p))]))]
-      [(core-port-file-position p)
+           (values (location-line loc)
+                   (location-column loc)
+                   (location-position loc))]))]
+      [(method core-port p file-position)
        (define offset (do-simple-file-position who p (lambda () #f)))
        (values #f #f (and offset (add1 offset)))]
       [else
-       (define offset (core-port-offset p))
+       (define offset (get-core-port-offset p))
        (values #f #f (and offset (add1 offset)))])))
 
 (define/who (set-port-next-location! p line col pos)
@@ -84,11 +84,11 @@
              [(input-port? p) (->core-input-port p)]
              [else (->core-output-port p)])])
     (atomically
-     (when (and (core-port-count? p)
-                (not (core-port-count-lines! p)))
-       (set-core-port-line! p line)
-       (set-core-port-column! p col)
-       (set-core-port-position! p pos)))))
+     (define loc (core-port-count p))
+     (when (and loc (not (method core-port p get-location)))
+       (set-location-line! loc line)
+       (set-location-column! loc col)
+       (set-location-position! loc pos)))))
 
 ;; in atomic mode
 ;; When line counting is enabled, increment line, column, etc. counts
@@ -98,15 +98,16 @@
 ;; can go backwards when the decoding completes.
 (define (port-count! in amt bstr start)
   (increment-offset! in amt)
-  (when (core-port-count? in)
+  (define loc (core-port-count in))
+  (when loc
     (define end (+ start amt))
     (let loop ([i start]
                [span 0] ; number of previous bytes still to send to UTF-8 decoding
-               [line (core-port-line in)]
-               [column (core-port-column in)]
-               [position (core-port-position in)]
-               [state (core-port-state in)]
-               [cr-state (core-port-cr-state in)]) ; #t => previous char was #\return
+               [line (location-line loc)]
+               [column (location-column loc)]
+               [position (location-position loc)]
+               [state (location-state loc)]
+               [cr-state (location-cr-state loc)]) ; #t => previous char was #\return
       (define (finish-utf-8 i abort-mode)
         (define-values (used-bytes got-chars new-state)
           (utf-8-decode! bstr (- i span) i
@@ -133,11 +134,11 @@
        [(= i end)
         (cond
          [(zero? span)
-          (set-core-port-line! in line)
-          (set-core-port-column! in column)
-          (set-core-port-position! in position)
-          (set-core-port-state! in state)
-          (set-core-port-cr-state! in cr-state)]
+          (set-location-line! loc line)
+          (set-location-column! loc column)
+          (set-location-position! loc position)
+          (set-location-state! loc state)
+          (set-location-cr-state! loc cr-state)]
          [else          
           ;; span doesn't include CR, LF, or tab
           (finish-utf-8 end 'state)])]
@@ -182,20 +183,21 @@
 ;; a non-whitespace byte.
 (define (port-count-byte! in b)
   (increment-offset! in 1)
-  (when (core-port-count? in)
+  (define loc (core-port-count in))
+  (when loc
     (cond
-     [(or (core-port-state in)
-          (core-port-cr-state in)
+     [(or (location-state loc)
+          (location-cr-state loc)
           (and (fixnum? b) (b . > . 127))
           (eq? b (char->integer #\return))
           (eq? b (char->integer #\newline))
           (eq? b (char->integer #\tab)))
       (port-count! in 1 (bytes b) 0)]
      [else
-      (let ([column (core-port-column in)]
-            [position (core-port-position in)])
-        (when position (set-core-port-position! in (add1 position)))
-        (when column (set-core-port-column! in (add1 column))))])))
+      (let ([column (location-column loc)]
+            [position (location-position loc)])
+        (when position (set-location-position! loc (add1 position)))
+        (when column (set-location-column! loc (add1 column))))])))
 
 ;; in atomic mode
 (define (port-count-byte-all! in extra-ins b)
@@ -205,6 +207,7 @@
 
 ;; in atomic mode
 (define (increment-offset! in amt)
-  (define old-offset (core-port-offset in))
-  (when old-offset
-    (set-core-port-offset! in (+ amt old-offset))))
+  (unless (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/custom-input-port.rkt b/racket/src/io/port/custom-input-port.rkt
index a2bed29191..a9a377aeff 100644
--- a/racket/src/io/port/custom-input-port.rkt
+++ b/racket/src/io/port/custom-input-port.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -162,8 +163,7 @@
           (set! input-pipe #f)
           (read-in self dest-bstr dest-start dest-end copy?)]
          [else
-          (define read-in (core-input-port-read-in input-pipe))
-          (read-in (core-port-self input-pipe) dest-bstr dest-start dest-end copy?)])]
+          (send core-input-port input-pipe read-in dest-bstr dest-start dest-end copy?)])]
       [else
        (define r
          (parameterize-break #f
@@ -189,8 +189,7 @@
           (set! input-pipe #f)
           (peek-in self dest-bstr dest-start dest-end skip-k progress-evt copy?)]
          [else
-          (define peek-in (core-input-port-peek-in input-pipe))
-          (peek-in (core-port-self input-pipe) dest-bstr dest-start dest-end skip-k progress-evt copy?)])]
+          (send core-input-port input-pipe peek-in dest-bstr dest-start dest-end skip-k progress-evt copy?)])]
       [else
        (define r
          (parameterize-break #f
diff --git a/racket/src/io/port/custom-output-port.rkt b/racket/src/io/port/custom-output-port.rkt
index 9ea9bb416c..6cfc7920da 100644
--- a/racket/src/io/port/custom-output-port.rkt
+++ b/racket/src/io/port/custom-output-port.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "output-port.rkt"
@@ -112,8 +113,7 @@
           (set! output-pipe #f)
           (write-out self bstr start end non-block/buffer? enable-break? copy?)]
          [else
-          (define write-out (core-output-port-write-out output-pipe))
-          (write-out (core-port-self output-pipe) bstr start end non-block/buffer? enable-break? copy?)])]
+          (send core-output-port output-pipe write-out bstr start end non-block/buffer? enable-break? copy?)])]
       [else
        (define r
          ;; Always tell user port to re-enable breaks if it blocks, since
diff --git a/racket/src/io/port/evt.rkt b/racket/src/io/port/evt.rkt
index 60c435be76..0faea24d4f 100644
--- a/racket/src/io/port/evt.rkt
+++ b/racket/src/io/port/evt.rkt
@@ -8,7 +8,7 @@
 ;; used only when a structure doesn't have `prop:evt`, so `prop:input-port`
 ;; and `prop:output-port` can be mixed with `prop:evt`.
 
-;; A structue with `prop:secondary-evt` mapped to `port->evt` should
+;; A structure with `prop:secondary-evt` mapped to `port->evt` should
 ;; also have `prop:input-port-evt` or `prop:input-port-evt`. Those
 ;; properties provide an indirection to avoid a dependency cycle between
 ;; this module and the implement of input and output ports.
diff --git a/racket/src/io/port/fd-port.rkt b/racket/src/io/port/fd-port.rkt
index 521d91f866..47b5049d6a 100644
--- a/racket/src/io/port/fd-port.rkt
+++ b/racket/src/io/port/fd-port.rkt
@@ -81,7 +81,7 @@
               (raise-network-error #f n "error reading from stream port")
               (raise-filesystem-error #f n "error reading from stream port"))]
          [(eqv? n RKTIO_READ_EOF) eof]
-         [(eqv? n 0) (wrap-evt (fd-evt fd RKTIO_POLL_READ (core-port-closed port))
+         [(eqv? n 0) (wrap-evt (fd-evt fd RKTIO_POLL_READ port)
                                (lambda (v) 0))]
          [else n]))
      #:read-is-atomic? #t
@@ -253,7 +253,7 @@
   (define custodian-reference
     (register-fd-close cust fd fd-refcount flush-handle port))
 
-  (set-fd-evt-closed! evt (core-port-closed port))
+  (set-fd-evt-closed! evt port)
 
   port)
 
@@ -319,7 +319,7 @@
    ;; whether the file descriptor has data available:
    (lambda (fde ctx)
      (cond
-       [(closed-state-closed? (fd-evt-closed fde))
+       [(core-port-closed? (fd-evt-closed fde))
         (values (list fde) #f)]
        [else
         (define mode (fd-evt-mode fde))
@@ -353,7 +353,6 @@
 ;; ----------------------------------------
 
 (define (register-fd-close custodian fd fd-refcount flush-handle port)
-  (define closed (core-port-closed port))
   (unsafe-custodian-register custodian
                              fd
                              ;; in atomic mode
@@ -361,7 +360,7 @@
                                (when flush-handle
                                  (plumber-flush-handle-remove! flush-handle))
                                (fd-close fd fd-refcount)
-                               (set-closed-state! closed))
+                               (set-closed-state! port))
                              #f
                              #f))
 
diff --git a/racket/src/io/port/file-position.rkt b/racket/src/io/port/file-position.rkt
index a1f3b60d58..280c65b19f 100644
--- a/racket/src/io/port/file-position.rkt
+++ b/racket/src/io/port/file-position.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -32,12 +33,12 @@
      (let ([cp (cond
                  [(input-port? p) (->core-input-port p)]
                  [else (->core-output-port p)])])
-       (define file-position (core-port-file-position cp))
+       (define file-position (method core-port cp file-position))
        (cond
          [(and (procedure? file-position) (procedure-arity-includes? file-position 2))
           (atomically
            (check-not-closed who cp)
-           (file-position (core-port-self cp) pos))]
+           (file-position cp pos))]
          [else
           (raise-arguments-error who
                                  "setting position allowed for file-stream and string ports only"
@@ -54,7 +55,7 @@
              [else (raise-argument-error who "port?" orig-p)])])
     (start-atomic)
     (check-not-closed who p)
-    (define file-position (core-port-file-position p))
+    (define file-position (method core-port p file-position))
     (cond
       [(or (input-port? file-position)
            (output-port? file-position))
@@ -62,7 +63,7 @@
        (do-simple-file-position who file-position fail-k)]
       [else
        (define pos (or (and file-position
-                            (file-position (core-port-self p)))
-                       (core-port-offset p)))
+                            (file-position p))
+                       (get-core-port-offset p)))
        (end-atomic)
        (or pos (fail-k))])))
diff --git a/racket/src/io/port/flush-output.rkt b/racket/src/io/port/flush-output.rkt
index 4173b0eb62..4eb33ed237 100644
--- a/racket/src/io/port/flush-output.rkt
+++ b/racket/src/io/port/flush-output.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "parameter.rkt"
          "port.rkt"
@@ -12,19 +13,20 @@
 (define/who (flush-output [p (current-output-port)])
   (check who output-port? p)
   (let wo-loop ([p p])
-    (let ([write-out (core-output-port-write-out (->core-output-port p))])
-      (cond
-        [(procedure? write-out)
-         (let loop ()
-           (define r (atomically
-                      (write-out (core-port-self p) #"" 0 0 #f #f #f)))
-           (let r-loop ([r r])
-             (cond
-               [(eq? r 0) (void)]
-               [(not r) (loop)]
-               [(evt? r) (r-loop (sync r))]
-               [else (error 'flush-output "weird result")])))]
-        [else (wo-loop write-out)]))))
+    (define out (->core-output-port p))
+    (define write-out (method core-output-port out write-out))
+    (cond
+      [(procedure? write-out)
+       (let loop ()
+         (define r (atomically
+                    (write-out out #"" 0 0 #f #f #f)))
+         (let r-loop ([r r])
+           (cond
+             [(eq? r 0) (void)]
+             [(not r) (loop)]
+             [(evt? r) (r-loop (sync r))]
+             [else (error 'flush-output "weird result")])))]
+      [else (wo-loop write-out)])))
 
 ;; ----------------------------------------
 
diff --git a/racket/src/io/port/input-port.rkt b/racket/src/io/port/input-port.rkt
index 42991027f1..58313ffdba 100644
--- a/racket/src/io/port/input-port.rkt
+++ b/racket/src/io/port/input-port.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "../host/pthread.rkt"
          "port.rkt"
@@ -9,7 +10,8 @@
          input-port?
          ->core-input-port
          (struct-out core-input-port)
-         make-core-input-port)
+         make-core-input-port
+         compat-input-port-self)
 
 (define-values (prop:input-port input-port-via-property? input-port-ref)
   (make-struct-type-property 'input-port
@@ -47,113 +49,110 @@
     [who (raise-argument-error who "input-port?" v)]
     [else empty-input-port]))
 
-(struct core-input-port core-port
-  (
-   ;; Various functions below are called in atomic mode. The intent of
-   ;; atomic mode is to ensure that the completion and return of the
-   ;; function is atomic with respect to some further activity, such
-   ;; as position and line counting. Also, a guard against operations
-   ;; on a closed port precedes most operations. Any of the functions
-   ;; is free to exit and re-enter atomic mode, but they may take on
-   ;; the burden of re-checking for a closed port. Leave atomic mode
-   ;; explicitly before raising an exception.
+(class core-input-port #:extends core-port
+  (field
+   [pending-eof? #f]
+   [read-handler #f])
 
-   prepare-change ; #f or (-*> void)
-   ;;               Called in atomic mode
-   ;;               May leave atomic mode temporarily, but on return,
-   ;;               ensures that other atomic operations are ok to
-   ;;               change the port. The main use of `prepare-change`
-   ;;               is to pause and `port-commit-peeked` attempts to
-   ;;               not succeed while a potential change is in
-   ;;               progress, where the commit attempts can resume after
-   ;;               atomic mode is left. The `close` operation
-   ;;               is *not* guarded by a call to `prepare-change`.
+  (public
 
-   read-byte ; #f or (-*> (or/c byte? eof-object? evt?))
-   ;;          Called in atomic mode.
-   ;;          This shortcut is optional.
-   ;;          Non-blocking byte read, where an event must be
-   ;;          returned if no byte is available. The event's result
-   ;;          is ignored, so it should not consume a byte.
+   ;; #f or (-*> void)
+   ;; Called in atomic mode
+   ;; May leave atomic mode temporarily, but on return, ensures that
+   ;; other atomic operations are ok to change the port. The main use
+   ;; of `prepare-change` is to pause and `port-commit-peeked`
+   ;; attempts to not succeed while a potential change is in progress,
+   ;; where the commit attempts can resume after atomic mode is left.
+   ;; The `close` operation is *not* guarded by a call to
+   ;; `prepare-change`.
+   [prepare-change #f]
 
-   read-in   ; port or (bytes start-k end-k copy? -*> (or/c integer? ...))
-   ;;          Called in atomic mode.
-   ;;          A port value redirects to the port. Otherwise, the function
-   ;;          never blocks, and can assume `(- end-k start-k)` is non-zero.
-   ;;          The `copy?` flag indicates that the given byte string should
-   ;;          not be exposed to untrusted code, and instead of should be
-   ;;          copied if necessary. The return values are the same as
-   ;;          documented for `make-input-port`, except that a pipe result
-   ;;          is not allowed (or, more precisely, it's treated as an event).
+   ;; port or (bytes start-k end-k copy? -*> (or/c integer? ...))
+   ;; Called in atomic mode.
+   ;; A port value redirects to the port. Otherwise, the function
+   ;; never blocks, and can assume `(- end-k start-k)` is non-zero.
+   ;; The `copy?` flag indicates that the given byte string should not
+   ;; be exposed to untrusted code, and instead of should be copied if
+   ;; necessary. The return values are the same as documented for
+   ;; `make-input-port`, except that a pipe result is not allowed (or,
+   ;; more precisely, it's treated as an event).
+   [read-in (lambda (bstr start end copy?) eof)]
 
-   peek-byte ; #f or (-*> (or/c byte? eof-object? evt?))
-   ;;          Called in atomic mode.
-   ;;          This shortcut is optional.
-   ;;          Non-blocking byte read, where an event must be
-   ;;          returned if no byte is available. The event's result
-   ;;          is ignored.
+   ;; port or (bytes start-k end-k skip-k progress-evt copy? -*> (or/c integer? ...))
+   ;; Called in atomic mode.
+   ;; A port value redirects to the port. Otherwise, the function
+   ;; never blocks, and it can assume that `(- end-k start-k)` is
+   ;; non-zero. The `copy?` flag is the same as for `read-in`. The
+   ;; return values are the same as documented for `make-input-port`.
+   [peek-in (lambda (bstr start end progress-evt copy?) eof)]
 
-   peek-in   ; port or (bytes start-k end-k skip-k progress-evt copy? -*> (or/c integer? ...))
-   ;;          Called in atomic mode.
-   ;;          A port value redirects to the port. Otherwise, the function
-   ;;          never blocks, and it can assume that `(- end-k start-k)` is non-zero.
-   ;;          The `copy?` flag is the same as for `read-in`.  The return values
-   ;;          are the same as documented for `make-input-port`.
+   ;; port or ((->) -*> (or/c boolean? evt))
+   ;; Called in atomic mode.
+   ;; A port value makes sense when `peek-in` has a port value.
+   ;; Otherwise, check whether a peek on one byte would succeed
+   ;; without blocking and return a boolean, or return an event that
+   ;; effectively does the same. The event's value doesn't matter,
+   ;; because it will be wrapped to return some original port. When
+   ;; `byte-ready` is a function, it should call the given function
+   ;; (for its side effect) when work has been done that might unblock
+   ;; this port or some other port.
+   [byte-ready (lambda (work-done!) #t)]
 
-   byte-ready  ; port or ((->) -*> (or/c boolean? evt))
-   ;;          Called in atomic mode.
-   ;;          A port value makes sense when `peek-in` has a port value.
-   ;;          Otherwise, check whether a peek on one byte would succeed
-   ;;          without blocking and return a boolean, or return an event
-   ;;          that effectively does the same. The event's value doesn't
-   ;;          matter, because it will be wrapped to return some original
-   ;;          port. When `byte-ready` is a function, it should call the
-   ;;          given function (for its side effect) when work has been
-   ;;          done that might unblock this port or some other port.
+   ;; #f or (-*> evt?)
+   ;; *Not* called in atomic mode.
+   ;; Optional support for progress events, and may be called on a
+   ;; closed port.
+   [get-progress-evt #f]
 
-   get-progress-evt ; #f or (-*> evt?)
-   ;;           *Not* called in atomic mode.
-   ;;           Optional support for progress events, and may be
-   ;;           called on a closed port.
+   ;; (amt-k progress-evt? evt? (bytes? -> any) -*> boolean)
+   ;; Called in atomic mode.
+   ;; Goes with `get-progress-evt`. The final `evt?` argument is
+   ;; constrained to a few kinds of events; see docs for
+   ;; `port-commit-peeked` for more information. On success, a
+   ;; completion function is called in atomic mode, but possibly in a
+   ;; different thread, with the committed bytes. The result is a
+   ;; boolean indicating success or failure.
+   [commit (lambda (amt progress-evt ext-evt finish) #f)])
 
-   commit    ; (amt-k progress-evt? evt? (bytes? -> any) -*> boolean)
-   ;;          Called in atomic mode.
-   ;;          Goes with `get-progress-evt`. The final `evt?`
-   ;;          argument is constrained to a few kinds of events;
-   ;;          see docs for `port-commit-peeked` for more information.
-   ;;          On success, a completion function is called in atomic mode,
-   ;;          but possibly in a different thread, with the committed bytes.
-   ;;          The result is a boolean indicating success or failure.
+  (property
+   [prop:input-port-evt (lambda (i)
+                          ;; not atomic mode
+                          (let ([i (->core-input-port i)])
+                            (cond
+                              [(core-port-closed? i)
+                               always-evt]
+                              [else
+                               (define byte-ready (method core-input-port i byte-ready))
+                               (cond
+                                 [(input-port? byte-ready)
+                                  byte-ready]
+                                 [else
+                                  (poller-evt
+                                   (poller
+                                    (lambda (self poll-ctx)
+                                      ;; atomic mode
+                                      (define v (byte-ready i
+                                                            (lambda ()
+                                                              (schedule-info-did-work! (poll-ctx-sched-info poll-ctx)))))
+                                      (cond
+                                        [(evt? v)
+                                         (values #f v)]
+                                        [(eq? v #t)
+                                         (values (list #t) #f)]
+                                        [else
+                                         (values #f self)]))))])])))]))
 
-   [pending-eof? #:mutable]
-   [read-handler #:mutable])
-  #:authentic
-  #:property prop:input-port-evt (lambda (i)
-                                   ;; not atomic mode
-                                   (let ([i (->core-input-port i)])
-                                     (cond
-                                       [(closed-state-closed? (core-port-closed i))
-                                        always-evt]
-                                       [else
-                                        (define byte-ready (core-input-port-byte-ready i))
-                                        (cond
-                                          [(input-port? byte-ready)
-                                           byte-ready]
-                                          [else
-                                           (poller-evt
-                                            (poller
-                                             (lambda (self poll-ctx)
-                                               ;; atomic mode
-                                               (define v (byte-ready (core-port-self i)
-                                                                     (lambda ()
-                                                                       (schedule-info-did-work! (poll-ctx-sched-info poll-ctx)))))
-                                               (cond
-                                                 [(evt? v)
-                                                  (values #f v)]
-                                                 [(eq? v #t)
-                                                  (values (list #t) #f)]
-                                                 [else
-                                                  (values #f self)]))))])]))))
+;; ----------------------------------------
+
+(define empty-input-port
+  (new core-input-port
+       [name 'empty]))
+
+;; ----------------------------------------
+
+(class compat-input-port #:extends core-input-port
+  (field
+   [self #f]))
 
 (define (make-core-input-port #:name name
                               #:data [data #f]
@@ -172,40 +171,43 @@
                               #:init-offset [init-offset 0]
                               #:file-position [file-position #f]
                               #:buffer-mode [buffer-mode #f])
-  (core-input-port name
-                   data
-                   self
-
-                   close
-                   count-lines!
-                   get-location
-                   file-position
-                   buffer-mode
-                   
-                   (closed-state #f #f)
-                   init-offset ; offset
-                   #f   ; count?
-                   #f   ; state
-                   #f   ; cr-state
-                   #f   ; line
-                   #f   ; column
-                   #f   ; position
-
-                   prepare-change
-                   read-byte
-                   read-in
-                   peek-byte
-                   peek-in
-                   byte-ready
-                   get-progress-evt
-                   commit
-                   #f   ; pending-eof?
-                   #f)) ; read-handler
-
-(define empty-input-port
-  (make-core-input-port #:name 'empty
-                        #:self #f
-                        #:read-in (lambda (self bstr start-k end-k copy?) eof)
-                        #:peek-in (lambda (self bstr start-k end-k skip-k copy?) eof)
-                        #:byte-ready (lambda (self did-work!) #f)
-                        #:close void))
+  (new compat-input-port
+       #:override
+       ([close (and #t (lambda (in) (close self)))]
+        [count-lines! (and count-lines! (lambda (in) (count-lines! self)))]
+        [get-location (and get-location (lambda (in) (get-location self)))]
+        [file-position (and file-position
+                            (if (input-port? file-position)
+                                file-position
+                                (if (procedure-arity-includes? file-position 2)
+                                    (case-lambda
+                                      [(in) (file-position self)]
+                                      [(in pos) (file-position self pos)])
+                                    (lambda (out) (file-position self)))))]
+        [buffer-mode
+         (and buffer-mode (case-lambda
+                            [(in) (buffer-mode self)]
+                            [(in mode) (buffer-mode self mode)]))]
+        [prepare-change (and prepare-change (lambda (in) (prepare-change self)))]
+        [read-in
+         (if (input-port? read-in)
+             read-in
+             (lambda (in bstr start end copy?)
+               (read-in self bstr start end copy?)))]
+        [peek-in
+         (if (input-port? peek-in)
+             peek-in
+             (lambda (in bstr start end skip progress-evt copy?)
+               (peek-in self bstr start end skip progress-evt copy?)))]
+        [byte-ready
+         (if (input-port? byte-ready)
+             byte-ready
+             (lambda (in work-done!) (byte-ready self work-done!)))]
+        [get-progress-evt (and get-progress-evt (lambda (in) (get-progress-evt self)))]
+        [commit (and #t (lambda (in amt-k progress-evt? evt? finish)
+                          (commit self amt-k progress-evt? evt? finish)))])
+       ;; fields
+       [name name]
+       [offset init-offset]
+       [data data]
+       [self self]))
diff --git a/racket/src/io/port/line-input.rkt b/racket/src/io/port/line-input.rkt
index 524c198c6b..f473232fb1 100644
--- a/racket/src/io/port/line-input.rkt
+++ b/racket/src/io/port/line-input.rkt
@@ -2,6 +2,7 @@
 (require racket/fixnum
          "../common/check.rkt"
          "input-port.rkt"
+         "read-and-peek.rkt"
          "bytes-input.rkt"
          "string-input.rkt"
          "parameter.rkt"
@@ -17,7 +18,7 @@
 (define-syntax-rule (define-read-line read-line
                       make-string string-set! 
                       string-copy! substring
-                      do-read-char peek-char
+                      read-a-char peek-a-char
                       as-char)
   (define/who (read-line [orig-in (current-input-port)] [mode 'linefeed])
     (define in (->core-input-port orig-in who))
@@ -28,7 +29,7 @@
     (define crlf? (case mode [(return-linefeed any) #t] [else #f]))
     (define init-len 32)
     (let loop ([str (make-string init-len)] [len init-len] [pos 0])
-      (define ch (do-read-char 'read-line in))
+      (define ch (read-a-char 'read-line in))
       (define (keep-char)
         (if (pos . fx< . len)
             (begin
@@ -48,8 +49,8 @@
              (eqv? ch (as-char #\return)))
         (cond
          [(and crlf?
-               (eqv? (peek-char in) (as-char #\linefeed)))
-          (do-read-char 'read-line in)
+               (eqv? (peek-a-char 'read-line in 0) (as-char #\linefeed)))
+          (read-a-char 'read-line in)
           (substring str 0 pos)]
          [cr?
           (substring str 0 pos)]
@@ -62,11 +63,11 @@
 (define-read-line read-line
   make-string string-set! 
   string-copy! substring
-  do-read-char/core-port peek-char
+  read-a-char peek-a-char
   values)
 
  (define-read-line read-bytes-line
    make-bytes bytes-set! 
    bytes-copy! subbytes
-   do-read-byte/core-port peek-byte
+   read-a-byte peek-a-byte
    char->integer)
diff --git a/racket/src/io/port/output-port.rkt b/racket/src/io/port/output-port.rkt
index 73895aa57c..be1d29407f 100644
--- a/racket/src/io/port/output-port.rkt
+++ b/racket/src/io/port/output-port.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "../host/pthread.rkt"
          "port.rkt"
@@ -9,7 +10,8 @@
          output-port?
          ->core-output-port
          (struct-out core-output-port)
-         make-core-output-port)
+         make-core-output-port
+         compat-output-port-self)
 
 (define-values (prop:output-port output-port-via-property? output-port-ref)
   (make-struct-type-property 'output-port
@@ -47,58 +49,83 @@
     [who (raise-argument-error who "output-port?" v)]
     [else empty-output-port]))
 
-(struct core-output-port core-port
-  (
-   ;; Various functions below are called in atomic mode; see
-   ;; `core-input-port` for more information on atomicity.
+(class core-output-port #:extends core-port
+  (field
+   [evt always-evt] ; An evt that is ready when writing a byte won't block
+   [write-handler #f]
+   [print-handler #f]
+   [display-handler #f])
 
-   evt ; An evt that is ready when writing a byte won't block
+  (public
+   ;; port or (bstr start-k end-k no-block/buffer? enable-break? copy? -*> ...)
+   ;; Called in atomic mode.
+   ;; Doesn't block if `no-block/buffer?` is true. Does enable breaks
+   ;; while blocking if `enable-break?` is true. The `copy?` flag
+   ;; indicates that the given byte string should not be exposed to
+   ;; untrusted code, and instead of should be copied if necessary.
+   ;; The return values are the same as documented for
+   ;; `make-output-port`.
+   [write-out (lambda (bstr start-k end-k no-block/buffer? enable-break? copy?)
+                (- start-k end-k))]
+
+   ;; #f or (any no-block/buffer? enable-break? -*> boolean?)
+   ;; Called in atomic mode.
+   [write-out-special #f]
    
-   write-out ; port or (bstr start-k end-k no-block/buffer? enable-break? copy? -*> ...)
-   ;;          Called in atomic mode.
-   ;;          Doesn't block if `no-block/buffer?` is true.
-   ;;          Does enable breaks while blocking if `enable-break?` is true.
-   ;;          The `copy?` flag indicates that the given byte string should
-   ;;          not be exposed to untrusted code, and instead of should be
-   ;;          copied if necessary. The return values are the same as
-   ;;          documented for `make-output-port`.
+   ;; #f or (bstr start-k end-k -*> evt?)
+   ;; Called in atomic mode.
+   ;; The given bstr should not be exposed to untrusted code.
+   [get-write-evt (lambda (bstr start-k end-k) always-evt)]
 
-   write-out-special ; (any no-block/buffer? enable-break? -*> boolean?)
-   ;;          Called in atomic mode.
+   ;; #f or (any -*> evt?)
+   ;; *Not* called in atomic mode.
+   [get-write-special-evt #f])
 
-   get-write-evt ; (port bstr start-k end-k -*> evt?)
-   ;;            Called in atomic mode.
-   ;;            Note the extra "self" argument as a port, which is useful
-   ;;            for implementing `count-write-evt-via-write-out`.
-   ;;            The given bstr should not be exposed to untrusted code.
+  (property
+   [prop:output-port-evt (lambda (o)
+                           ;; not atomic mode
+                           (let ([o (->core-output-port o)])
+                             (choice-evt
+                              (list
+                               (poller-evt
+                                (poller
+                                 (lambda (self sched-info)
+                                   ;; atomic mode
+                                   (cond
+                                     [(core-port-closed? o)
+                                      (values '(#t) #f)]
+                                     [else (values #f self)]))))
+                               (core-output-port-evt o)))))]))
 
-   get-write-special-evt ; (-*> evt?)
-   ;;            *Not* called in atomic mode.
-   
-   [write-handler #:mutable]
-   [print-handler #:mutable]
-   [display-handler #:mutable])
-  #:authentic
-  #:property prop:output-port-evt (lambda (o)
-                                    ;; not atomic mode
-                                    (let ([o (->core-output-port o)])
-                                      (choice-evt
-                                       (list
-                                        (poller-evt
-                                         (poller
-                                          (lambda (self sched-info)
-                                            ;; atomic mode
-                                            (cond
-                                              [(closed-state-closed? (core-port-closed o))
-                                               (values '(#t) #f)]
-                                              [else (values #f self)]))))
-                                        (core-output-port-evt o))))))
+;; If `write-out` is always atomic (in no-block, no-buffer mode),
+;; then an event can poll `write-out`
+(define (get-write-evt-via-write-out count-write-evt-via-write-out)
+  (lambda (out src-bstr src-start src-end)
+    (write-evt
+     ;; in atomic mode:
+     (lambda (self-evt)
+       (define v (send core-output-port out write-out src-bstr src-start src-end #f #f #t))
+       (when (exact-integer? v)
+         (count-write-evt-via-write-out out v src-bstr src-start))
+       (if (evt? v)
+           (values #f (replace-evt v self-evt))
+           (values (list v) #f))))))
 
 (struct write-evt (proc)
   #:property prop:evt (poller
                        (lambda (self sched-info)
                          ((write-evt-proc self) self))))
 
+(define empty-output-port
+  (new core-output-port
+       [name 'empty]))
+
+;; ----------------------------------------
+
+(class compat-output-port #:extends core-output-port
+  (field
+   [self #f]))
+
 (define (make-core-output-port #:name name
                                #:data [data #f]
                                #:self self
@@ -114,54 +141,49 @@
                                #:file-position [file-position #f]
                                #:init-offset [init-offset 0]
                                #:buffer-mode [buffer-mode #f])
-  (core-output-port name
-                    data
-                    self
-
-                    close
-                    count-lines!
-                    get-location
-                    file-position
-                    buffer-mode
-
-                    (closed-state #f #f)
-                    init-offset ; offset
-                    #f   ; count?
-                    #f   ; state
-                    #f   ; cr-state
-                    #f   ; line
-                    #f   ; column
-                    #f   ; position
-                    
-                    evt
-                    write-out
-                    write-out-special
-                    (or get-write-evt
-                        (and count-write-evt-via-write-out
-                             ;; If `write-out` is always atomic (in no-block, no-buffer mode),
-                             ;; then an event can poll `write-out`:
-                             (lambda (self o src-bstr src-start src-end)
-                               (write-evt
-                                ;; in atomic mode:
-                                (lambda (self-evt)
-                                  (define v (write-out self src-bstr src-start src-end #f #f #t))
-                                  (when (exact-integer? v)
-                                    (count-write-evt-via-write-out self o v src-bstr src-start))
-                                  (if (evt? v)
-                                      (values #f (replace-evt v self-evt))
-                                      (values (list v) #f)))))))
-                    get-write-special-evt
-                    
-                    #f   ; write-handler
-                    #f   ; display-handler
-                    #f)) ; print-handler
-  
-(define empty-output-port
-  (make-core-output-port #:name 'empty
-                         #:self #f
-                         #:evt always-evt
-                         #:write-out (lambda (self bstr start end no-buffer? enable-break?)
-                                       (- end start))
-                         #:write-out-special (lambda (self v no-buffer? enable-break?)
-                                               #t)
-                         #:close void))
+  (new compat-output-port
+       #:override
+       ([close (and #t (lambda (out) (close self)))]
+        [count-lines! (and count-lines! (lambda (out) (count-lines! self)))]
+        [get-location (and get-location (lambda (out) (get-location self)))]
+        [file-position (and file-position
+                            (if (output-port? file-position)
+                                file-position
+                                (if (procedure-arity-includes? file-position 2)
+                                    (case-lambda
+                                      [(out) (file-position self)]
+                                      [(out pos) (file-position self pos)])
+                                    (lambda (out) (file-position self)))))]
+        [buffer-mode (and buffer-mode (case-lambda
+                                        [(out) (buffer-mode self)]
+                                        [(out mode) (buffer-mode self mode)]))]
+        [write-out
+         (if (output-port? write-out)
+             write-out
+             (lambda (out bstr start-k end-k no-block/buffer? enable-break? copy?)
+               (write-out self bstr start-k end-k no-block/buffer? enable-break? copy?)))]
+        [write-out-special
+         (and write-out-special
+              (if (output-port? write-out-special)
+                  write-out-special
+                  (lambda (out any no-block/buffer? enable-break?)
+                    (write-out-special self any no-block/buffer? enable-break?))))]
+        [get-write-evt
+         (cond
+           [get-write-evt (lambda (out src-bstr src-start src-endv)
+                            (get-write-evt self out src-bstr src-start src-endv))]
+           [count-write-evt-via-write-out
+            (get-write-evt-via-write-out
+             (lambda (out v src-bstr src-start)
+               (count-write-evt-via-write-out self out v src-bstr src-start)))]
+           [else #f])]
+        [get-write-special-evt
+         (and get-write-special-evt
+              (lambda (out v)
+                (get-write-special-evt self v)))])
+       ;; fields
+       [name name]
+       [offset init-offset]
+       [evt evt]
+       [data data]
+       [self self]))
diff --git a/racket/src/io/port/peek-via-read-port.rkt b/racket/src/io/port/peek-via-read-port.rkt
index 20b1431ddf..884d452ea8 100644
--- a/racket/src/io/port/peek-via-read-port.rkt
+++ b/racket/src/io/port/peek-via-read-port.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
-(require "../host/thread.rkt"
+(require "../common/class.rkt"
+         "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
          "output-port.rkt"
@@ -25,7 +26,7 @@
 
   ;; in atomic mode
   (define (prepare-change self)
-    ((core-input-port-prepare-change peek-pipe-i) (core-port-self peek-pipe-i)))
+    (send core-input-port peek-pipe-i prepare-change))
 
   ;; in atomic mode
   (define (pull-some-bytes [amt (if (eq? 'block buffer-mode) (bytes-length buf) 1)] #:keep-eof? [keep-eof? #t])
@@ -39,8 +40,7 @@
       [(eqv? v 0) 0]
       [else
        (let loop ([wrote 0])
-         (define write-out (core-output-port-write-out peek-pipe-o))
-         (define just-wrote (write-out (core-port-self peek-pipe-o) buf wrote v #t #f #f))
+         (define just-wrote (send core-output-port peek-pipe-o write-out buf wrote v #t #f #f))
          (define next-wrote (+ wrote just-wrote))
          (unless (= v next-wrote)
            (loop next-wrote)))
@@ -54,8 +54,7 @@
     (let try-again ()
       (cond
         [(positive? (pipe-content-length peek-pipe-i))
-         (define read-in (core-input-port-read-in peek-pipe-i))
-         (read-in (core-port-self peek-pipe-i) dest-bstr start end copy?)]
+         (send core-input-port peek-pipe-i read-in dest-bstr start end copy?)]
         [peeked-eof?
          (set! peeked-eof? #f)
          ;; an EOF doesn't count as progress
@@ -74,24 +73,6 @@
               (progress!))
             v])])))
 
-  ;; in atomic mode
-  (define (read-byte self)
-    (define b ((core-input-port-read-byte peek-pipe-i) (core-port-self peek-pipe-i)))
-    (cond
-      [(or (fixnum? b) (eof-object? b))
-       b]
-      [peeked-eof?
-       (set! peeked-eof? #f)
-       ;; an EOF doesn't count as progress
-       eof]
-      [else
-       (define v (pull-some-bytes #:keep-eof? #f))
-       (cond
-         [(retry-pull? v) (read-byte self)]
-         [else
-          (progress!)
-          v])]))
-
   ;; in atomic mode
   (define (do-peek-in self dest-bstr start end skip progress-evt copy?)
     (let try-again ()
@@ -104,8 +85,7 @@
          #f]
         [(and peek-pipe-i
               (peeked-amt . > . skip))
-         (define peek-in (core-input-port-peek-in peek-pipe-i))
-         (peek-in (core-port-self peek-pipe-i) dest-bstr start end skip progress-evt copy?)]
+         (send core-input-port peek-pipe-i peek-in dest-bstr start end skip progress-evt copy?)]
         [peeked-eof?
          eof]
         [else
@@ -114,19 +94,6 @@
              (try-again)
              v)])))
 
-  ;; in atomic mode
-  (define (peek-byte self)
-    (cond
-      [(positive? (pipe-content-length peek-pipe-i))
-       ((core-input-port-peek-byte peek-pipe-i) (core-port-self peek-pipe-i))]
-      [peeked-eof?
-       eof]
-      [else
-       (define v (pull-some-bytes))
-       (if (retry-pull? v)
-           (peek-byte self)
-           v)]))
-
   ;; in atomic mode
   (define (do-byte-ready self work-done!)
     (cond
@@ -151,15 +118,15 @@
 
   ;; in atomic mode
   (define (get-progress-evt self)
-    ((core-input-port-get-progress-evt peek-pipe-i) (core-port-self peek-pipe-i)))
+    (send core-input-port peek-pipe-i get-progress-evt))
 
   ;; in atomic mode
   (define (progress!)
     ;; Relies on support for `0 #f #f` arguments in pipe implementation:
-    ((core-input-port-commit peek-pipe-i) (core-port-self peek-pipe-i) 0 #f #f void))
+    (send core-input-port peek-pipe-i commit 0 #f #f void))
 
   (define (commit self amt evt ext-evt finish)
-    ((core-input-port-commit peek-pipe-i) (core-port-self peek-pipe-i) amt evt ext-evt finish))
+    (send core-input-port peek-pipe-i commit amt evt ext-evt finish))
 
   (define do-buffer-mode
     (case-lambda
@@ -173,9 +140,7 @@
 
            #:prepare-change prepare-change
            
-           #:read-byte read-byte
            #:read-in do-read-in
-           #:peek-byte peek-byte
            #:peek-in do-peek-in
            #:byte-ready do-byte-ready
 
diff --git a/racket/src/io/port/pipe.rkt b/racket/src/io/port/pipe.rkt
index d38222655c..d356e8bbbf 100644
--- a/racket/src/io/port/pipe.rkt
+++ b/racket/src/io/port/pipe.rkt
@@ -35,28 +35,30 @@
        (pipe-data? (core-port-data (->core-output-port p)))))
 
 (define (pipe-content-length p)
-  ((pipe-data-get-content-length
-    (core-port-data 
-     (cond
-       [(pipe-input-port? p) (->core-input-port p)]
-       [(pipe-output-port? p) (->core-output-port p)]
-       [else
-        (raise-argument-error 'pipe-contact-length "(or/c pipe-input-port? pipe-output-port?)" p)])))
-   (core-port-self p)))
+  (define cp
+    (cond
+      [(pipe-input-port? p) (->core-input-port p)]
+      [(pipe-output-port? p) (->core-output-port p)]
+      [else
+       (raise-argument-error 'pipe-contact-length "(or/c pipe-input-port? pipe-output-port?)" p)]))
+  ((pipe-data-get-content-length (core-port-data cp))
+   (if (core-input-port? cp)
+       (compat-input-port-self cp)
+       (compat-output-port-self cp))))
 
 ;; in atomic mode:
 (define pipe-write-position
   (case-lambda
-    [(p) ((pipe-data-write-position (core-port-data p)) (core-port-self p))]
-    [(p pos) ((pipe-data-write-position (core-port-data p)) (core-port-self p) pos)]))
+    [(p) ((pipe-data-write-position (core-port-data p)) (compat-output-port-self p))]
+    [(p pos) ((pipe-data-write-position (core-port-data p)) (compat-output-port-self p) pos)]))
 
 ;; in atomic mode:
 (define (pipe-discard-all p)
-  ((pipe-data-discard-all (core-port-data p)) (core-port-self p)))
+  ((pipe-data-discard-all (core-port-data p)) (compat-output-port-self p)))
 
-;; in atomic mode:
+;; in atomic mode:x
 (define (pipe-get-content p bstr start-pos)
-  ((pipe-data-get-content (core-port-data p)) (core-port-self p) bstr start-pos))
+  ((pipe-data-get-content (core-port-data p)) (compat-output-port-self p) bstr start-pos))
 
 (define-constructor (make-pipe-ends [limit #f] [input-name 'pipe] [output-name 'pipe]
                                     #:need-input? [need-input? #t])
diff --git a/racket/src/io/port/port.rkt b/racket/src/io/port/port.rkt
index 9eb7b8c6d2..1a19f4e635 100644
--- a/racket/src/io/port/port.rkt
+++ b/racket/src/io/port/port.rkt
@@ -1,44 +1,99 @@
 #lang racket/base
-(require "../host/thread.rkt"
+(require "../common/class.rkt"
+         "../host/thread.rkt"
          "../host/pthread.rkt"
          "evt.rkt"
          "place-message.rkt")
 
 (provide (struct-out core-port)
-         (struct-out closed-state))
+         (struct-out location)
+         get-core-port-offset)
 
-(struct core-port (name      ; anything, reported as `object-name` for the port
-                   data      ; anything, effectively a subtype indicator
+(class core-port
+  (field
+   [name 'port #:immutable] ; anything, reported as `object-name` for the port
 
-                   ;; A "method" or "-*>" gets this value back as its
-                   ;; first argument:
-                   self      ; anything, passed to every method
+   [data #f] ; FIXME: remove after all uses are converted
 
-                   close     ; -*> (void)
-                   ;;          Called in atomic mode.
+   ;; 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.
+   ;;
+   ;; 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.
+   ;;
+   ;; Shortcut mode must be disabled when line counting is enabled,
+   ;; since shortcut mode skips explicit count.
+   [buffer #f]
+   [buffer-pos 0]   ; if < `buffer-end`, allows direct read/write on `buffer`
+   [buffer-end 0]
+   
+   [closed? #f]
+   [closed-sema #f]
+   
+   [offset 0]   ; count plain bytes; add `(- buffer-pos buffer-start)`
+   [count #f])  ; #f or a `location`
+  
+  ;; Various methods below are called in atomic mode. The intent of
+  ;; atomic mode is to ensure that the completion and return of the
+  ;; function is atomic with respect to some further activity, such
+  ;; as position and line counting. Also, a guard against operations
+  ;; on a closed port precedes most operations. Any of the functions
+  ;; is free to exit and re-enter atomic mode, but they may take on
+  ;; the burden of re-checking for a closed port. Leave atomic mode
+  ;; explicitly before raising an exception.
 
-                   count-lines!  ; #f or method called in atomic mode
-                   get-location  ; #f or method called in atomic mode
-                   file-position ; #f, port, or method called in atomic mode
-                   buffer-mode   ; #f or method in atomic mode
+  (public
+   ;; -*> (void)
+   ;; Called in atomic mode.
+   ;; Reqeusts a close, and the port is closed if/when
+   ;; the method returns.
+   [close (lambda () (void))]
 
-                   closed        ; `closed-state`
+   ;; #f or (-*> (void))
+   ;; Called in atomic mode.
+   ;; Notifies the port that line counting is enabled, and
+   ;; `get-location` can be called afterward (if it is defined)
+   [count-lines! #f]
 
-                   [offset #:mutable] ; count plain bytes
-                   [count? #:mutable] ; whether line counting is enabled
-                   [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
-  #:authentic
-  #:property prop:unsafe-authentic-override #t ; allow evt chaperone
-  #:property prop:object-name (struct-field-index name)
-  #:property prop:secondary-evt port->evt
-  #:property prop:place-message (lambda (p)
-                                  (define data (core-port-data p))
-                                  (data->place-message data p)))
+   ;; #f or (-*> (values line-or-#f column-or-#f position-or-#f))
+   ;; Called in atomic mode.
+   ;; Returns the location of the next character. If #f, this method
+   ;; is implemented externally.
+   [get-location #f]  ; #f or method called in atomic mode
 
-(struct closed-state ([closed? #:mutable]
-                      [closed-sema #:mutable]) ; #f or a semaphore posed on close
-  #:authentic)
+   ;; #f or (U (-*> position-k) (position-k -*> (void))
+   ;; Called in atomic mode.
+   ;; If not #f, the port implements `file-position`.
+   [file-position #f]
+
+   ;; #f or (U (-*> mode-sym) (mode-sym -*> (void))
+   ;; Called in atomic mode.
+   ;; If not #f, the port implements buffer-mode selection.
+   [buffer-mode #f])
+
+  (property
+   [prop:unsafe-authentic-override #t] ; allow evt chaperone
+   [prop:object-name (struct-field-index name)]
+   [prop:secondary-evt port->evt]))
+
+(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
+
+(define (get-core-port-offset p)
+  (define offset (core-port-offset p))
+  (and offset
+       (if (core-port-buffer p)
+           (+ offset (core-port-buffer-pos p))
+           offset)))
diff --git a/racket/src/io/port/prepare-change.rkt b/racket/src/io/port/prepare-change.rkt
index cc8a27c8d1..7ee72cf628 100644
--- a/racket/src/io/port/prepare-change.rkt
+++ b/racket/src/io/port/prepare-change.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
-(require "port.rkt"
+(require "../common/class.rkt"
+         "port.rkt"
          "input-port.rkt")
 
 (provide prepare-change)
@@ -7,6 +8,6 @@
 ;; in atomic mode
 ;;  ... but may leave and return to atomic mode
 (define (prepare-change in)
-  (define prepare-change (core-input-port-prepare-change in))
+  (define prepare-change (method core-input-port in prepare-change))
   (when prepare-change
-    (prepare-change (core-port-self in))))
+    (prepare-change in)))
diff --git a/racket/src/io/port/progress-evt.rkt b/racket/src/io/port/progress-evt.rkt
index 6fc559efb9..0d9aa0b91a 100644
--- a/racket/src/io/port/progress-evt.rkt
+++ b/racket/src/io/port/progress-evt.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "parameter.rkt"
          "port.rkt"
@@ -34,14 +35,14 @@
 (define/who (port-provides-progress-evts? in)
   (check who input-port? in)
   (let ([in (->core-input-port in)])
-    (and (core-input-port-get-progress-evt in) #t)))
+    (and (method core-input-port in get-progress-evt) #t)))
 
 (define/who (port-progress-evt orig-in)
   (check who input-port? orig-in)
   (let ([in (->core-input-port orig-in)])
-    (define get-progress-evt (core-input-port-get-progress-evt in))
+    (define get-progress-evt (method core-input-port in get-progress-evt))
     (if get-progress-evt
-        (progress-evt orig-in (get-progress-evt (core-port-self in)))
+        (progress-evt orig-in (get-progress-evt in))
         (raise-arguments-error 'port-progress-evt
                                "port does not provide progress evts"
                                "port" orig-in))))
@@ -55,14 +56,14 @@
   (check who input-port? in)
   (check-progress-evt who progress-evt in)
   (let ([in (->core-input-port in)])
-    (define commit (core-input-port-commit in))
     (atomically
      ;; We specially skip a check on whether the port is closed,
      ;; since that's handled as the progress evt becoming ready
-     (commit (core-port-self in) amt (progress-evt-evt progress-evt) evt
-             ;; in atomic mode (but maybe leaves atomic mode in between)
-             (lambda (bstr)
-               (port-count! in (bytes-length bstr) bstr 0))))))
+     (send core-input-port in commit
+           amt (progress-evt-evt progress-evt) evt
+           ;; in atomic mode (but maybe leaves atomic mode in between)
+           (lambda (bstr)
+             (port-count! in (bytes-length bstr) bstr 0))))))
 
 (define (check-progress-evt who progress-evt in)
   (unless (progress-evt?* progress-evt in)
diff --git a/racket/src/io/port/read-and-peek.rkt b/racket/src/io/port/read-and-peek.rkt
index 3d46922528..aeccf20290 100644
--- a/racket/src/io/port/read-and-peek.rkt
+++ b/racket/src/io/port/read-and-peek.rkt
@@ -1,5 +1,7 @@
 #lang racket/base
-(require "../common/internal-error.rkt"
+(require racket/fixnum
+         "../common/internal-error.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "input-port.rkt"
@@ -10,9 +12,9 @@
 (provide read-some-bytes!
          peek-some-bytes!
 
-         do-read-byte
+         read-a-byte
          read-byte-via-bytes
-         do-peek-byte
+         peek-a-byte
          peek-byte-via-bytes)
 
 ;; Read up to `(- end start)` bytes, producing at least a
@@ -47,7 +49,7 @@
       [(= start end) ; intentionally before the port-closed check
        (end-atomic)
        0]
-      [(closed-state-closed? (core-port-closed in))
+      [(core-port-closed? in)
        (check-not-closed who in)]
       ;; previously detected EOF?
       [(core-input-port-pending-eof? in)
@@ -56,58 +58,70 @@
        (end-atomic)
        eof]
       [else
-       ;; normal mode...
-       (define read-in (core-input-port-read-in in))
+       (define buf-pos (core-port-buffer-pos in))
+       (define buf-end (core-port-buffer-end in))
        (cond
-         [(procedure? read-in)
-          (define v (read-in (core-port-self in) bstr start end copy-bstr?))
-          (let result-loop ([v v])
-            (cond
-              [(and (integer? v) (not (eq? v 0)))
-               (port-count-all! in extra-count-ins v bstr start)]
-              [(procedure? v)
-               (port-count-byte-all! in extra-count-ins #f)])
-            (end-atomic)
-            (cond
-              [(exact-nonnegative-integer? v)
-               (cond
-                 [(zero? v)
-                  (if zero-ok?
-                      0
-                      (loop in extra-count-ins))]
-                 [(v . <= . (- end start)) v]
-                 [else
-                  (raise-arguments-error who
-                                         "result integer is larger than the supplied byte string"
-                                         "result" v
-                                         "byte-string length" (- end start))])]
-              [(eof-object? v) eof]
-              [(evt? v)
-               ;; If `zero-ok?`, we should at least poll the event
-               (define timeout (if zero-ok? (lambda () 0) #f))
-               (define next-v (if enable-break?
-                                  (sync/timeout/enable-break timeout v)
-                                  (sync/timeout timeout v)))
-               (cond
-                 [(and zero-ok? (evt? next-v))
-                  ;; Avoid looping on events
-                  0]
-                 [else
-                  (start-atomic)
-                  (result-loop next-v)])]
-              [(procedure? v)
-               (if special-ok?
-                   (if limit-special-arity?
-                       (lambda (a b c d) (v a b c d))
-                       v)
-                   (raise-arguments-error who
-                                          "non-character in an unsupported context"
-                                          "port" orig-in))]
-              [else
-               (internal-error (format "weird read-bytes result ~s" v))]))]
-         [else
+         [(buf-pos . < . buf-end)
+          ;; Read bytes from buffer
+          (define v (min (- buf-end buf-pos) (- 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)
           (end-atomic)
-          (loop (->core-input-port read-in) (cons in extra-count-ins))])])))
+          v]
+         [else
+          ;; Call port's `read-in` method
+          (define read-in (method core-input-port in read-in))
+          (cond
+            [(procedure? read-in)
+             (define v (read-in in bstr start end copy-bstr?))
+             (let result-loop ([v v])
+               (cond
+                 [(and (integer? v) (not (eq? v 0)))
+                  (port-count-all! in extra-count-ins v bstr start)]
+                 [(procedure? v)
+                  (port-count-byte-all! in extra-count-ins #f)])
+               (end-atomic)
+               (cond
+                 [(exact-nonnegative-integer? v)
+                  (cond
+                    [(zero? v)
+                     (if zero-ok?
+                         0
+                         (loop in extra-count-ins))]
+                    [(v . <= . (- end start)) v]
+                    [else
+                     (raise-arguments-error who
+                                            "result integer is larger than the supplied byte string"
+                                            "result" v
+                                            "byte-string length" (- end start))])]
+                 [(eof-object? v) eof]
+                 [(evt? v)
+                  ;; If `zero-ok?`, we should at least poll the event
+                  (define timeout (if zero-ok? (lambda () 0) #f))
+                  (define next-v (if enable-break?
+                                     (sync/timeout/enable-break timeout v)
+                                     (sync/timeout timeout v)))
+                  (cond
+                    [(and zero-ok? (evt? next-v))
+                     ;; Avoid looping on events
+                     0]
+                    [else
+                     (start-atomic)
+                     (result-loop next-v)])]
+                 [(procedure? v)
+                  (if special-ok?
+                      (if limit-special-arity?
+                          (lambda (a b c d) (v a b c d))
+                          v)
+                      (raise-arguments-error who
+                                             "non-character in an unsupported context"
+                                             "port" orig-in))]
+                 [else
+                  (internal-error (format "weird read-bytes result ~s" v))]))]
+            [else
+             (end-atomic)
+             (loop (->core-input-port read-in) (cons in extra-count-ins))])])])))
 
 ;; Like `read-some-bytes!`, but merely peeks
 (define (peek-some-bytes! who orig-in bstr start end skip
@@ -129,77 +143,76 @@
             (sync/timeout 0 progress-evt))
        (end-atomic)
        0]
-      [(closed-state-closed? (core-port-closed in))
+      [(core-port-closed? in)
        (check-not-closed who in)]
       ;; previously detected EOF? (never skip past it)
       [(core-input-port-pending-eof? in)
        (end-atomic)
-       
        eof]
       [else
-       (define peek-in (core-input-port-peek-in in))
+       (define buf-pos (+ (core-port-buffer-pos in) skip))
+       (define buf-end (core-port-buffer-end in))
        (cond
-         [(procedure? peek-in)
-          (define v (peek-in (core-port-self in) bstr start end skip progress-evt copy-bstr?))
+         [(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))
           (end-atomic)
-          (let result-loop ([v v])
-            (cond
-              [(exact-nonnegative-integer? v)
-               (cond
-                 [(zero? v)
-                  (if zero-ok?
-                      0
-                      (loop in))]
-                 [(v . <= . (- end start)) v]
-                 [else
-                  (raise-arguments-error who
-                                         "result integer is larger than the supplied byte string"
-                                         "result" v
-                                         "byte-string length" (- end start))])]
-              [(eof-object? v) eof]
-              [(evt? v)
-               (cond
-                 [zero-ok? 0]
-                 [else (result-loop (if enable-break?
-                                        (sync/enable-break v)
-                                        (sync v)))])]
-              [(procedure? v)
-               (if special-ok?
-                   (if limit-special-arity?
-                       (lambda (a b c d) (v a b c d))
-                       v)
-                   (raise-arguments-error who
-                                          "non-character in an unsupported context"
-                                          "port" orig-in))]
-              [else
-               (internal-error (format "weird peek-bytes result ~s" v))]))]
+          v]
          [else
-          (end-atomic)
-          (loop (->core-input-port peek-in))])])))
+          (define peek-in (method core-input-port in peek-in))
+          (cond
+            [(procedure? peek-in)
+             (define v (peek-in in bstr start end skip progress-evt copy-bstr?))
+             (end-atomic)
+             (let result-loop ([v v])
+               (cond
+                 [(exact-nonnegative-integer? v)
+                  (cond
+                    [(zero? v)
+                     (if zero-ok?
+                         0
+                         (loop in))]
+                    [(v . <= . (- end start)) v]
+                    [else
+                     (raise-arguments-error who
+                                            "result integer is larger than the supplied byte string"
+                                            "result" v
+                                            "byte-string length" (- end start))])]
+                 [(eof-object? v) eof]
+                 [(evt? v)
+                  (cond
+                    [zero-ok? 0]
+                    [else (result-loop (if enable-break?
+                                           (sync/enable-break v)
+                                           (sync v)))])]
+                 [(procedure? v)
+                  (if special-ok?
+                      (if limit-special-arity?
+                          (lambda (a b c d) (v a b c d))
+                          v)
+                      (raise-arguments-error who
+                                             "non-character in an unsupported context"
+                                             "port" orig-in))]
+                 [else
+                  (internal-error (format "weird peek-bytes result ~s" v))]))]
+            [else
+             (end-atomic)
+             (loop (->core-input-port peek-in))])])])))
 
-
-;; Use a `read-byte` shortcut
-(define (do-read-byte who read-byte in)
-  (let loop ()
-    (start-atomic)
-    (prepare-change in)
-    (cond
-      [(closed-state-closed? (core-port-closed in))
-       (check-not-closed who in)]
-      [else
-       (define b (read-byte (core-port-self in)))
-       (cond
-         [(eof-object? b)
-          (end-atomic)
-          b]
-         [(fixnum? b)
-          (port-count-byte! in b)
-          (end-atomic)
-          b]
-         [else ; must be an evt
-          (end-atomic)
-          (sync b)
-          (loop)])])))
+;; 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))
+  (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))
+     (end-atomic)
+     b]
+    [else
+     (end-atomic)
+     (read-byte-via-bytes in #:special-ok? special-ok?)]))
 
 ;; Use the general path; may return a procedure for a special
 (define (read-byte-via-bytes in #:special-ok? [special-ok? #t])
@@ -212,19 +225,18 @@
       (bytes-ref bstr 0)
       v))
 
-;; Use a `peek-byte` shortcut
-(define (do-peek-byte who peek-byte in)
-  (let loop ()
-    (start-atomic)
-    (prepare-change in)
-    (check-not-closed who in)
-    (define b (peek-byte (core-port-self in)))
-    (end-atomic)
-    (cond
-      [(evt? b)
-       (sync b)
-       (loop)]
-      [else b])))
+;; 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))
+  (cond
+    [(pos . < . (core-port-buffer-end in))
+     (define b (bytes-ref (core-port-buffer in) pos))
+     (end-atomic)
+     b]
+    [else
+     (end-atomic)
+     (peek-byte-via-bytes in skip-k #:special-ok? special-ok?)]))
 
 ;; Use the general path; may return a procedure for a special
 (define (peek-byte-via-bytes in skip-k
diff --git a/racket/src/io/port/ready.rkt b/racket/src/io/port/ready.rkt
index 2b27454bf8..fe7cc22e7a 100644
--- a/racket/src/io/port/ready.rkt
+++ b/racket/src/io/port/ready.rkt
@@ -1,9 +1,11 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "../string/utf-8-decode.rkt"
          "port.rkt"
          "input-port.rkt"
+         "read-and-peek.rkt"
          "bytes-input.rkt"
          "check.rkt"
          "prepare-change.rkt")
@@ -14,14 +16,14 @@
 (define/who (byte-ready? in)
   (check who input-port? in)
   (let loop ([in (->core-input-port in)])
-    (define byte-ready (core-input-port-byte-ready in))
+    (define byte-ready (method core-input-port in byte-ready))
     (cond
       [(input-port? byte-ready) (loop (->core-input-port byte-ready))]
       [else
        (start-atomic)
        (prepare-change in)
        (check-not-closed who in)
-       (define r (byte-ready (core-port-self in) void))
+       (define r (byte-ready in void))
        (end-atomic)
        (eq? #t r)])))
 
@@ -30,8 +32,7 @@
   (let ([in (->core-input-port in)])
     (cond
       [(byte-ready? in)
-       (define peek-byte (core-input-port-peek-byte in))
-       (define b (and peek-byte (atomically (peek-byte (core-port-self in)))))
+       (define b (peek-a-byte who in 0))
        (cond
          [(and b
                (or (eof-object? b)
diff --git a/racket/src/io/port/special-input.rkt b/racket/src/io/port/special-input.rkt
index 87c6942647..a6ecefa238 100644
--- a/racket/src/io/port/special-input.rkt
+++ b/racket/src/io/port/special-input.rkt
@@ -18,13 +18,12 @@
   (check who input-port? orig-in)
   (check who #:or-false (procedure-arity-includes/c 1) special-wrap)
   (let ([in (->core-input-port orig-in)])
-    (define read-byte (core-input-port-read-byte in))
-    (cond
-      [read-byte (do-read-byte who read-byte in)]
-      [else
-       (extract-special-value (read-byte-via-bytes in)
-                              in source-name -1
-                              special-wrap)])))
+    (define v (read-a-byte who in #:special-ok? #t))
+    (if (fixnum? v)
+        v
+        (extract-special-value v
+                               in source-name -1
+                               special-wrap))))
 
 
 (define/who (peek-byte-or-special [orig-in (current-input-port)]
@@ -39,9 +38,14 @@
   (when progress-evt
     (check-progress-evt who progress-evt orig-in))
   (let ([in (->core-input-port orig-in)])
-    (define peek-byte (core-input-port-peek-byte in))
     (cond
-      [peek-byte (do-peek-byte who peek-byte in)]
+      [(not progress-evt)
+       (define v (peek-a-byte who in skip-k #:special-ok? #t))
+       (if (fixnum? v)
+           v
+           (extract-special-value v
+                                  in source-name skip-k
+                                  special-wrap))]
       [else
        (extract-special-value (peek-byte-via-bytes in skip-k #:progress-evt progress-evt)
                               in source-name skip-k
@@ -54,7 +58,7 @@
                                   [source-name #f])
   (let ([in (->core-input-port in who)])
     (check who #:or-false (procedure-arity-includes/c 1) special-wrap)
-    (extract-special-value (do-read-char/core-port who in #:special-ok? #t)
+    (extract-special-value (read-a-char who in #:special-ok? #t)
                            in source-name -1
                            special-wrap)))
 
@@ -65,7 +69,7 @@
   (check who input-port? in)
   (check who exact-nonnegative-integer? skip-k)
   (check who special-wrap-for-peek? #:contract special-wrap-for-peek/c-str special-wrap)
-  (extract-special-value (do-peek-char who in skip-k #:special-ok? #t)
+  (extract-special-value (peek-a-char who in skip-k #:special-ok? #t)
                          in source-name skip-k
                          special-wrap))
 
diff --git a/racket/src/io/port/special-output.rkt b/racket/src/io/port/special-output.rkt
index b55cb80055..f55eeefa42 100644
--- a/racket/src/io/port/special-output.rkt
+++ b/racket/src/io/port/special-output.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require "../common/check.rkt"
+         "../common/class.rkt"
          "../host/thread.rkt"
          "port.rkt"
          "output-port.rkt"
@@ -14,13 +15,13 @@
 (define/who (port-writes-special? o)
   (check who output-port? o)
   (let ([o (->core-output-port o)])
-    (and (core-output-port-write-out-special o) #t)))
+    (and (method core-output-port o write-out-special) #t)))
 
 (define (do-write-special who v orig-o #:retry? retry?)
   (check who output-port? orig-o)
   (let port-loop ([o orig-o] [extra-count-os null])
     (let ([o (->core-output-port o)])
-      (define write-out-special (core-output-port-write-out-special o))
+      (define write-out-special (method core-output-port o write-out-special))
       (unless write-out-special
         (raise-arguments-error who
                                "port does not support special values"
@@ -31,7 +32,7 @@
         [else
          (let loop ()
            (start-atomic)
-           (define r (write-out-special (core-port-self o) v (not retry?) #f))
+           (define r (write-out-special o v (not retry?) #f))
            (let result-loop ([r r])
              (cond
                [(not r)
@@ -57,9 +58,9 @@
 (define/who (write-special-evt v [o (current-output-port)])
   (check who output-port? o)
   (let ([o (->core-output-port o)])
-    (define get-write-special-evt (core-output-port-get-write-special-evt o))
+    (define get-write-special-evt (method core-output-port o get-write-special-evt))
     (unless get-write-special-evt
       (raise-arguments-error who
                              "port does not support special-value events"
                              "port" o))
-    (get-write-special-evt (core-port-self o) v)))
+    (get-write-special-evt o v)))
diff --git a/racket/src/io/port/string-input.rkt b/racket/src/io/port/string-input.rkt
index f7cb7fcf9b..7c27662a5b 100644
--- a/racket/src/io/port/string-input.rkt
+++ b/racket/src/io/port/string-input.rkt
@@ -21,8 +21,8 @@
          peek-string
          peek-string!
 
-         do-read-char/core-port
-         do-peek-char)
+         read-a-char
+         peek-a-char)
 
 ;; ----------------------------------------
 
@@ -196,10 +196,11 @@
 
 ;; A shortcut to implement `read-char` in terms of a port-specific
 ;; `read-byte`:
-(define (read-char-via-read-byte who in read-byte #:special-ok? [special-ok? #t])
-  (define b (do-read-byte who read-byte in))
+(define (read-char-via-read-byte who in #:special-ok? [special-ok? #t])
+  (define b (read-a-byte who in #:special-ok? special-ok?))
   (cond
     [(eof-object? b) b]
+    [(and special-ok? (procedure? b)) b]
     [else
      (cond
        [(b . fx< . 128) (integer->char b)]
@@ -217,7 +218,7 @@
            ;; complete, and consume only the already-consumed byte
            ;; if there's a decoding error
            (let loop ([skip-k 0] [accum accum] [remaining remaining])
-             (define b (peek-byte/core-port in skip-k))
+             (define b (peek-a-byte who in skip-k))
              (cond
                [(eof-object? b)
                 ;; Already-consumed byte is consume as an error byte
@@ -229,7 +230,7 @@
                   [(eq? state 'complete)
                    ;; Consume used bytes
                    (let loop ([skip-k skip-k])
-                     (do-read-byte who read-byte in)
+                     (read-a-byte who in)
                      (unless (fx= 0 skip-k)
                        (loop (fx- skip-k 1))))
                    (integer->char next-accum)]
@@ -241,22 +242,12 @@
 ;; ----------------------------------------
 
 ;; If `special-ok?`, can return a special-value procedure
-(define (do-read-char/core-port who in #:special-ok? [special-ok? #f])
-  (define read-byte (core-input-port-read-byte in))
-  (cond
-    [(not read-byte)
-     (define str (make-string 1))
-     (define-values (v used-bytes) (read-some-chars! who in str 0 1 #:special-ok? special-ok?))
-     (if (eq? v 1)
-         (string-ref str 0)
-         v)]
-    [else
-     ;; Byte-level shortcut is available, so try it as a char shortcut
-     (read-char-via-read-byte who in read-byte #:special-ok? special-ok?)]))
+(define (read-a-char who in #:special-ok? [special-ok? #f])
+  (read-char-via-read-byte who in #:special-ok? special-ok?))
 
 (define/who (read-char [in (current-input-port)])
   (let ([in (->core-input-port in who)])
-    (do-read-char/core-port who in)))
+    (read-a-char who in)))
   
 (define/who (read-string amt [in (current-input-port)])
   (check who exact-nonnegative-integer? amt)
@@ -287,18 +278,17 @@
 (define (do-peek-string! who in str start end skip #:special-ok? [special-ok? #f])
   (do-read-string! who in str start end #:skip skip #:just-peek? #t #:special-ok? special-ok?))
 
-(define (do-peek-char who in skip-k #:special-ok? [special-ok? #f])
+(define (peek-a-char who in skip-k #:special-ok? [special-ok? #f])
   (let ([in (->core-input-port in)])
-    (define peek-byte (and (zero? skip-k)
-                           (core-input-port-peek-byte in)))
-    (define b (and peek-byte (atomically (peek-byte (core-port-self in)))))
+    (define b (peek-a-byte who in skip-k #:special-ok? special-ok?))
     (cond
       [(and b
             (or (eof-object? b)
 	    	(and (byte? b)
-                     (b . < . 128))))
-       ;; Shortcut worked
-       (if (eof-object? b) b (integer->char b))]
+                     (b . < . 128))
+                (procedure? b)))
+       ;; Shortcut workedx
+       (if (fixnum? b) (integer->char b) b)]
       [else
        ;; General mode
        (define bstr (make-string 1))
@@ -310,7 +300,7 @@
 (define/who (peek-char [in (current-input-port)] [skip-k 0])
   (check who input-port? in)
   (check who exact-nonnegative-integer? skip-k)
-  (do-peek-char who in skip-k #:special-ok? #f))
+  (peek-a-char who in skip-k #:special-ok? #f))
   
 (define/who (peek-string amt skip-k [in (current-input-port)])
   (check who exact-nonnegative-integer? amt)
diff --git a/racket/src/io/port/write.rkt b/racket/src/io/port/write.rkt
index 52e79c0254..3eda061f9e 100644
--- a/racket/src/io/port/write.rkt
+++ b/racket/src/io/port/write.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require racket/fixnum
+         "../common/class.rkt"
          "../common/internal-error.rkt"
          "../host/thread.rkt"
          "port.rkt"
@@ -22,10 +23,10 @@
        (end-atomic)
        0]
       [else
-       (define write-out (core-output-port-write-out out))
+       (define write-out (method core-output-port out write-out))
        (cond
          [(procedure? write-out)
-          (define v (write-out (core-port-self out) bstr start end (not buffer-ok?) enable-break? copy-bstr?))
+          (define v (write-out out bstr start end (not buffer-ok?) enable-break? copy-bstr?))
           (let result-loop ([v v])
             (cond
               [(not v)