diff --git a/racket/src/cs/bootstrap/make-boot.rkt b/racket/src/cs/bootstrap/make-boot.rkt
index b83eba5e4f..5ac52e6028 100644
--- a/racket/src/cs/bootstrap/make-boot.rkt
+++ b/racket/src/cs/bootstrap/make-boot.rkt
@@ -2,6 +2,7 @@
 (require racket/runtime-path
          racket/match
          racket/file
+         racket/pretty
          (only-in "r6rs-lang.rkt"
                   optimize-level)
          (only-in "scheme-lang.rkt"
@@ -99,7 +100,11 @@
 (namespace-require `(only (submod (file ,(path->string (resolved-module-path-name r6rs-lang-mod))) ikarus) with-implicit)
                    ns)
 
-(define orig-eval (current-eval))
+(define show? #f)
+(define orig-eval (let ([e (current-eval)])
+                    (lambda args
+                      (when show? (pretty-write args))
+                      (apply e args))))
 
 (define (call-with-expressions path proc)
   (call-with-input-file*
@@ -332,7 +337,7 @@
           (with-handlers (#;[exn:fail? (lambda (exn)
                                        (eprintf "ERROR: ~s\n" (exn-message exn))
                                        (set! failed? #t))])
-            ((orig-eval 'compile-file) src dest)))))
+            (time ((orig-eval 'compile-file) src dest))))))
     (when failed?
       (raise-user-error 'make-boot "compilation failure(s)")))
 
diff --git a/racket/src/cs/bootstrap/r6rs-lang.rkt b/racket/src/cs/bootstrap/r6rs-lang.rkt
index 78adb4ac4a..78b2bfab3b 100644
--- a/racket/src/cs/bootstrap/r6rs-lang.rkt
+++ b/racket/src/cs/bootstrap/r6rs-lang.rkt
@@ -13,6 +13,7 @@
          "syntax-mode.rkt"
          "constant.rkt"
          "config.rkt"
+         "rcd.rkt"
          (only-in "record.rkt"
                   do-$make-record-type
                   register-rtd-name!
@@ -576,32 +577,7 @@
      ;; For Chez Scheme's legacy procedure
      (struct-type-make-constructor rcd)]
     [(rec-cons-desc? rcd)
-     (define rtd (rec-cons-desc-rtd rcd))
-     (define ctr (struct-type-make-constructor rtd))
-     ((record-constructor-generator rcd) ctr)]))
-
-(define (record-constructor-generator rcd)
-  (define rtd (rec-cons-desc-rtd rcd))
-  (define p (rec-cons-desc-protocol rcd))
-  (define-values (r-name init-cnt auto-cnt ref set immutables super skipped?)
-    (struct-type-info rtd))
-  (cond
-    [(not p) (lambda (ctr) ctr)]
-    [(rec-cons-desc-parent-rcd rcd)
-     => (lambda (p-rcd)
-          (lambda (ctr)
-            (p ((record-constructor-generator p-rcd)
-                (lambda args1
-                  (lambda args2
-                    (apply ctr (append args1 args2))))))))]
-    [super
-     (define parent-p (lookup-protocol super))
-     (lambda (ctr)
-       (p (parent-p
-           (lambda args1
-             (lambda args2
-               (apply ctr (append args1 args2)))))))]
-    [else p]))
+     (rcd->constructor rcd lookup-protocol)]))
 
 (define (make-record-type-descriptor name parent uid s? o? fields)
   (do-$make-record-type base-rtd parent name fields s? o? null #:uid uid))
diff --git a/racket/src/cs/bootstrap/rcd.rkt b/racket/src/cs/bootstrap/rcd.rkt
new file mode 100644
index 0000000000..6f450fc7e1
--- /dev/null
+++ b/racket/src/cs/bootstrap/rcd.rkt
@@ -0,0 +1,68 @@
+#lang racket/base
+(require "scheme-struct.rkt"
+         (for-template racket/base))
+
+(provide rcd->constructor
+         (struct-out rcd-info)
+         rcd->rcdi)
+
+(define (rcd->constructor rcd lookup-protocol)
+  (define rtd (rec-cons-desc-rtd rcd))
+  (define ctr (struct-type-make-constructor rtd))
+  ((record-constructor-generator rcd lookup-protocol) ctr)) 
+
+(define (record-constructor-generator rcd lookup-protocol)
+  (define rtd (rec-cons-desc-rtd rcd))
+  (define p (rec-cons-desc-protocol rcd))
+  (define-values (r-name init-cnt auto-cnt ref set immutables super skipped?)
+    (struct-type-info rtd))
+  (cond
+    [(not p) (lambda (ctr) ctr)]
+    [(rec-cons-desc-parent-rcd rcd)
+     => (lambda (p-rcd)
+          (define p-gen (record-constructor-generator p-rcd lookup-protocol))
+          (and p-gen
+               (lambda (ctr)
+                 (p (p-gen
+                     (lambda args1
+                       (lambda args2
+                         (apply ctr (append args1 args2)))))))))]
+    [(and super (not lookup-protocol)) #f]
+    [super
+     (define parent-p (lookup-protocol super))
+     (lambda (ctr)
+       (p (parent-p
+           (lambda args1
+             (lambda args2
+               (apply ctr (append args1 args2)))))))]
+    [else p]))
+
+;; ----------------------------------------
+
+(struct rcd-info (rtd proto-expr base-rcdi init-cnt)
+  #:transparent)
+
+(define (rcd->rcdi rcd)
+  (cond
+    [(rec-cons-desc-parent-rcd rcd)
+     => (lambda (p-rcd)
+          (define p-rcdi (rcd->rcdi p-rcd))
+          (and p-rcdi
+               (let ()
+                 (define-values (r-name init-cnt auto-cnt ref set immutables super skipped?)
+                   (struct-type-info (rec-cons-desc-rtd rcd)))
+                 (define proto (rec-cons-desc-protocol rcd))
+                 (rcd-info (rec-cons-desc-rtd rcd)
+                           proto
+                           p-rcdi
+                           (+ init-cnt
+                              (rcd-info-init-cnt p-rcdi))))))]
+    [else
+     (define-values (r-name init-cnt auto-cnt ref set immutables super skipped?)
+       (struct-type-info (rec-cons-desc-rtd rcd)))
+     (define proto (rec-cons-desc-protocol rcd))
+     (and (not super)
+          (rcd-info (rec-cons-desc-rtd rcd)
+                    proto
+                    #f
+                    init-cnt))]))
diff --git a/racket/src/cs/bootstrap/scheme-lang.rkt b/racket/src/cs/bootstrap/scheme-lang.rkt
index cea2e20f3d..a6f582b97f 100644
--- a/racket/src/cs/bootstrap/scheme-lang.rkt
+++ b/racket/src/cs/bootstrap/scheme-lang.rkt
@@ -23,7 +23,9 @@
                   make-record-constructor-descriptor
                   set-car!
                   set-cdr!)
-         (submod "r6rs-lang.rkt" hash-pair))
+         (submod "r6rs-lang.rkt" hash-pair)
+         (for-syntax "scheme-struct.rkt"
+                     "rcd.rkt"))
 
 (provide (rename-out [s:define define]
                      [s:define define-threaded]
@@ -364,16 +366,26 @@
 (define-syntax (letrec* stx)
   (syntax-case stx ()
     [(_ (clause ...) . body)
-     (let loop ([clauses (syntax->list #'(clause ...))] [lets '()] [letrecs '()])
+     (let loop ([clauses (syntax->list #'(clause ...))] [lets '()] [letrecs '()] [macros '()] [rcds #hasheq()])
        (cond
          [(null? clauses)
           #`(let #,(reverse lets)
-              (letrec #,(reverse letrecs)
+              (letrec-syntaxes+values #,(for/list ([s (in-list macros)])
+                                          (syntax-case s ()
+                                            [[id rhs]
+                                             #'[(id) (lambda (stx) (quote-syntax rhs))]]))
+                                      #,(for/list ([s (in-list (reverse letrecs))])
+                                          (syntax-case s ()
+                                            [[id rhs]
+                                             #'[(id) rhs]]))
                 . body))]
          [else
-          (syntax-case* (car clauses) ($primitive quote record-accessor record-predicate) (lambda (a b)
-                                                                                            (eq? (syntax-e a)
-                                                                                                 (syntax-e b)))
+          (define (id-eq? a b) (eq? (syntax-e a) (syntax-e b)))
+          (syntax-case* (car clauses) ($primitive record-accessor record-predicate
+                                                  $make-record-constructor-descriptor
+                                                  make-record-constructor-descriptor
+                                                  r6rs:record-constructor
+                                                  quote) id-eq?
             [[id (($primitive _ record-accessor) 'rtd n)]
              (and (struct-type? (syntax-e #'rtd))
                   (integer? (syntax-e #'n)))
@@ -382,7 +394,9 @@
                                              #`[id '#,a]
                                              (car clauses))
                                          lets)
-                     letrecs))]
+                     letrecs
+                     macros
+                     rcds))]
             [[id (($primitive _ record-mutator) 'rtd n)]
              (and (struct-type? (syntax-e #'rtd))
                   (integer? (syntax-e #'n)))
@@ -391,7 +405,9 @@
                                              #`[id '#,m]
                                              (car clauses))
                                          lets)
-                     letrecs))]
+                     letrecs
+                     macros
+                     rcds))]
             [[id (($primitive _ record-predicate) 'rtd)]
              (struct-type? (syntax-e #'rtd))
              (let ([p (compile-time-record-predicate (syntax-e #'rtd))])
@@ -399,9 +415,141 @@
                                              #`[id '#,p]
                                              (car clauses))
                                          lets)
-                     letrecs))]
+                     letrecs
+                     macros
+                     rcds))]
+            [[id (($primitive _ r6rs:record-constructor) 'rcd)]
+             (rec-cons-desc? (syntax-e #'rcd))
+             (let ([c (rcd->constructor (syntax-e #'rcd) #f)])
+               (cond
+                 [c (loop (cdr clauses) (cons #`[id #,c]
+                                              lets)
+                          letrecs
+                          macros
+                          rcds)]
+                 [else
+                  (and (log-warning "couldn't inline ~s" (car clauses)) #f)
+                  (loop (cdr clauses) lets (cons (car clauses) letrecs) macros rcds)]))]
+            [[id (($primitive _ mrcd)
+                  'rtd
+                  base
+                  proc
+                  . maybe-name)]
+             (and (or (eq? '$make-record-constructor-descriptor (syntax-e #'mrcd))
+                      (eq? 'make-record-constructor-descriptor (syntax-e #'mrcd)))
+                  (struct-type? (syntax-e #'rtd))
+                  (or (not (syntax-e #'base))
+                      (hash-ref rcds (syntax-e #'base) #f))
+                  (immediate-procedure-expression? #'proc))
+             (let ([rtd (syntax-e #'rtd)]
+                   [base-rcdi (and (syntax-e #'base)
+                                   (hash-ref rcds (syntax-e #'base) #f))])
+               (define-values (r-name init-cnt auto-cnt ref set immutables super skipped?)
+                 (struct-type-info rtd))
+               (when (and (not base-rcdi)
+                          super)
+                 (error "can't handle an rcd without a base rcd and with a parent record type"))
+               (define rdci (rcd-info rtd #'proc base-rcdi (+ init-cnt (if base-rcdi
+                                                                           (rcd-info-init-cnt base-rcdi)
+                                                                           0))))
+               (loop (cdr clauses)
+                     lets
+                     (cons #`[id (mrcd
+                                  '#,rtd
+                                  base
+                                  proc
+                                  . maybe-name)]
+                           letrecs)
+                     macros
+                     (hash-set rcds (syntax-e #'id) rdci)))]
+            [[id (($primitive _ mrcd)
+                  'rtd
+                  'base-rcd
+                  proc
+                  . maybe-name)]
+             (and (or (eq? '$make-record-constructor-descriptor (syntax-e #'mrcd))
+                      (eq? 'make-record-constructor-descriptor (syntax-e #'mrcd)))
+                  (struct-type? (syntax-e #'rtd))
+                  (rec-cons-desc? (syntax-e #'base-rcd))
+                  (immediate-procedure-expression? #'proc))
+             (let ([rtd (syntax-e #'rtd)]
+                   [base-rcdi (rcd->rcdi (syntax-e #'base-rcd))])
+               (unless base-rcdi
+                 (error "can't handle this literal rcd: ~e" (syntax-e #'base-rcd)))
+               (define-values (r-name init-cnt auto-cnt ref set immutables super skipped?)
+                 (struct-type-info rtd))
+               (define rdci (rcd-info rtd #'proc base-rcdi (+ init-cnt (rcd-info-init-cnt base-rcdi))))
+               (loop (cdr clauses)
+                     lets
+                     (cons #`[id (mrcd
+                                  '#,rtd
+                                  'base-rcd
+                                  proc
+                                  . maybe-name)]
+                           letrecs)
+                     macros
+                     (hash-set rcds (syntax-e #'id) rdci)))]
+            [[id (($primitive _ r6rs:record-constructor) rcd-id)]
+             (and (identifier? #'rcd-id)
+                  (hash-ref rcds (syntax-e #'rcd-id) #f))
+             (let ([rcdi (hash-ref rcds (syntax-e #'rcd-id))])
+               (define (rcdi->generator rcdi)
+                 (define base-rcdi (rcd-info-base-rcdi rcdi))
+                 (cond
+                   [(not (rcd-info-proto-expr rcdi))
+                    #`(lambda (ctr) ctr)]
+                   [(not base-rcdi)
+                    (rcd-info-proto-expr rcdi)]
+                   [else
+                    (with-syntax ([ctr (gensym 'ctr)]
+                                  [(p-arg ...) (for/list ([i (in-range (rcd-info-init-cnt base-rcdi))])
+                                                 (gensym))]
+                                  [(c-arg ...) (for/list ([i (in-range (- (rcd-info-init-cnt rcdi)
+                                                                          (rcd-info-init-cnt base-rcdi)))])
+                                                 (gensym))])
+                    #`(lambda (ctr)
+                        (#,(rcd-info-proto-expr rcdi)
+                         (#,(rcdi->generator base-rcdi)
+                          (lambda (p-arg ...)
+                            (lambda (c-arg ...)
+                              (ctr p-arg ... c-arg ...)))))))]))
+               (define c (struct-type-make-constructor (rcd-info-rtd rcdi)))
+               (loop (cdr clauses)
+                     lets
+                     (cons #`[id (#,(rcdi->generator rcdi) #,c)]
+                           letrecs)
+                     macros
+                     rcds))]
+            [[id (($primitive _ r6rs:record-constructor) _)]
+             (and (log-warning "couldn't simplify ~s" (car clauses))
+                  #f)
+             (void)]
+            
+            [[id (($primitive _ mrcd) . _)]
+             (and (or (eq? '$make-record-constructor-descriptor (syntax-e #'mrcd))
+                      (eq? 'make-record-constructor-descriptor (syntax-e #'mrcd)))
+                  (log-warning "couldn't recognize ~s" (car clauses))
+                  #f)
+             (void)]
             [else
-             (loop (cdr clauses) lets (cons (car clauses) letrecs))])]))]))
+             (loop (cdr clauses) lets (cons (car clauses) letrecs) macros rcds)])]))]))
+
+(define-for-syntax (immediate-procedure-expression? s)
+  (syntax-case s ()
+    [(id . _)
+     (and (identifier? #'id)
+          (or (eq? (syntax-e #'id) 'lambda)
+              (eq? (syntax-e #'id) 'case-lambda)))]
+    [_ #f]))
+
+(define-syntax (with-inline-cache stx)
+  (syntax-case stx ()
+    [(_ expr)
+     #`(let ([b #,(mcons #f #f)])
+         (or (mcar b)
+             (let ([r expr])
+               (set-mcar! b r)
+               r)))]))
 
 (define-syntax (s:parameterize stx)
   (syntax-case stx ()
@@ -582,16 +730,20 @@
 (define vector-for-each
   (case-lambda
     [(proc vec)
-     (for-each proc (vector->list vec))]
+     (for ([e (in-vector vec)])
+       (proc e))]
     [(proc vec1 vec2)
-     (for-each proc (vector->list vec1) (vector->list vec2))]
+     (for ([e1 (in-vector vec1)]
+           [e2 (in-vector vec2)])
+       (proc e1 e2))]
     [(proc . vecs)
      (apply for-each proc (map vector->list vecs))]))
    
 (define vector-map
   (case-lambda
     [(proc vec)
-     (list->vector (map proc (vector->list vec)))]
+     (for/vector #:length (vector-length vec) ([e (in-vector vec)])
+       (proc e))]
     [(proc . vecs)
      (list->vector (apply map proc (map vector->list vecs)))]))