diff --git a/racket/src/ChezScheme/mats/record.ms b/racket/src/ChezScheme/mats/record.ms
index c6acf9e8c9..b82bd1023a 100644
--- a/racket/src/ChezScheme/mats/record.ms
+++ b/racket/src/ChezScheme/mats/record.ms
@@ -9187,3 +9187,31 @@
                (#2%display 4)
                1)))))
 )
+
+(mat cp0-$record-ref
+  (equivalent-expansion?
+   (parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
+     (expand/optimize
+    '(let ()
+       (define A (make-record-type-descriptor* 'A #f #f #f #f 2 0))
+       (define x ((record-constructor A) (begin (display A) 1) (begin (display 0
+) 2)))
+       (+ (#3%$record-ref x 0) (#3%$record-ref x 1)))))
+   '(let ([a (#2%make-record-type-descriptor* 'A #f #f #f #f 2 0)])
+      (#2%display 0)
+      (#2%display a)
+      3))
+  )
+
+(mat cp0-record?
+  (equivalent-expansion?
+   (parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
+     (expand/optimize
+      '(let ()
+         (define A (make-record-type-descriptor* 'A #f #f #f #f 2 0))
+         (define-record B (a b))
+         (record? ((record-constructor A) 1 2) (record-type-descriptor B)))))
+   '(begin
+      (#2%make-record-type-descriptor* 'A #f #f #f #f 2 0)
+      #f))
+)
diff --git a/racket/src/ChezScheme/s/cp0.ss b/racket/src/ChezScheme/s/cp0.ss
index 8a963417f4..0f58220278 100644
--- a/racket/src/ChezScheme/s/cp0.ss
+++ b/racket/src/ChezScheme/s/cp0.ss
@@ -3935,6 +3935,10 @@
                                            (and rtd (f rtd))))))
                             (residualize-seq '() (list ?x ?rtd) ctxt)
                             true-rec]
+                           [(record ,rtd ,rtd-expr ,e* ...)
+                            (obviously-incompatible? rtd d0)
+                            (residualize-seq '() (list ?x ?rtd) ctxt)
+                            false-rec]
                            [else (abandon-ship xval xres d0)]))))]
                [(record-type ,rtd ,e)
                 (cond
@@ -4092,7 +4096,22 @@
                                   (non-result-exp r-expr
                                     main)))
                               (loop (cdr e*) (cons (car e*) re*) (fx- index 1)))))]
-                  [else #f]))]
+                  [else
+                   (nanopass-case (Lsrc Expr) (result-exp/indirect-ref r-expr)
+                     [(record ,rtd1 ,rtd-expr1 ,e* ...)
+                      (guard (< d (length e*))
+                        (rtd-immutable-field? rtd1 d))
+                      (let ([e (list-ref e* d)])
+                        (and
+                         (nanopass-case (Lsrc Expr) e
+                           [(quote ,d) #t]
+                           [(ref ,maybe-src ,x) (not (prelex-assigned x))]
+                           [,pr (all-set? (prim-mask proc) (primref-flags pr))]
+                           [else #f])
+                         (begin
+                           (residualize-seq (list ?r ?i) '() ctxt)
+                           (non-result-exp i-expr (non-result-exp r-expr e)))))]
+                     [else #f])]))]
               [else #f]))])
 
       (let ()