diff --git a/collects/r6rs/private/records-explicit.ss b/collects/r6rs/private/records-explicit.ss
index 0421388636..7d8734cd00 100644
--- a/collects/r6rs/private/records-explicit.ss
+++ b/collects/r6rs/private/records-explicit.ss
@@ -55,19 +55,34 @@
 	      (?k ?default . ?rands))
 	     ((?name/cps ((?tag ?val) . ?rest) ?k . ?rands)
 	      (?k ?val . ?rands))
-	     ((?name/cps ((?another-tag ?val) . ?rest) ?k . ?rands)
+	     ((?name/cps ((?another-tag . ?vals) . ?rest) ?k . ?rands)
 	      (?name/cps ?rest ?k . ?rands))))
-
 	 (define-syntax ?name
 	   (syntax-rules (?tag)
 	     ((?name ())
 	      ?default)
 	     ((?name ((?tag ?val) . ?rest))
 	      ?val)
-	     ((?name ((?another-tag ?val) . ?rest))
+	     ((?name ((?another-tag . ?vals) . ?rest))
 	      (?name ?rest))))))))
 
-  (define-alist-extractor extract-parent extract-parent/cps parent no-record-type)
+  (define-syntax extract-parent/sel 
+    (syntax-rules (parent parent-rtd)
+      ((_ () ?sel) #f)
+      ((_ ((parent ?val) . ?rest) ?sel)
+       (?sel (record-type-descriptor ?val)
+             (record-constructor-descriptor ?val)))
+      ((_ ((parent-rtd ?rtd ?cons) . ?rest) ?sel)
+       (?sel ?rtd ?cons))
+      ((_ ((?another-tag . ?vals) . ?rest) ?sel)
+       (extract-parent/sel ?rest ?sel))))
+  (define-syntax sel-record-type-descriptor
+    (syntax-rules ()
+      [(_ ?rtd ?cons) ?rtd]))
+  (define-syntax sel-record-constructor-descriptor
+    (syntax-rules ()
+      [(_ ?rtd ?cons) ?cons]))
+
   (define-alist-extractor extract-sealed extract-sealed/cps sealed #f)
   (define-alist-extractor extract-opaque extract-opaque/cps opaque #f)
   (define-alist-extractor extract-protocol extract-protocol/cps
@@ -93,7 +108,7 @@
 	 ?clause ...))))
 
   (define-syntax define-record-type-1
-    (syntax-rules (parent protocol sealed nongenerative opaque fields mutable immutable)
+    (syntax-rules (parent parent-rtd protocol sealed nongenerative opaque fields mutable immutable)
       ;; find PARENT clause
       ((define-record-type-1 ?props
 	 ?field-specs
@@ -102,6 +117,13 @@
        (define-record-type-1 ((parent ?parent) . ?props)
 	 ?field-specs
 	 ?clause ...))
+      ((define-record-type-1 ?props
+	 ?field-specs
+	 (parent-rtd ?parent ?cons)
+	 ?clause ...)
+       (define-record-type-1 ((parent-rtd ?parent ?cons) . ?props)
+	 ?field-specs
+	 ?clause ...))
 
       ;; find PROTOCOL clause
       ((define-record-type-1 ?props
@@ -192,7 +214,7 @@
 
 	 (define $rtd
 	   (make-record-type-descriptor (extract-record-name/cps ?props quote)
-					(extract-parent/cps ?props record-type-descriptor)
+					(extract-parent/sel ?props sel-record-type-descriptor)
 					(extract-nongenerative ?props)
 					(extract-sealed ?props)
 					(extract-opaque ?props)
@@ -201,7 +223,7 @@
 	 (define $constructor-descriptor
 	   (make-record-constructor-descriptor
 	    $rtd
-	    (extract-parent/cps ?props record-constructor-descriptor)
+	    (extract-parent/sel ?props sel-record-constructor-descriptor)
 	    (extract-protocol ?props)))
 
 	 (extract-record-name/cps
diff --git a/collects/rnrs/records/syntactic-6.ss b/collects/rnrs/records/syntactic-6.ss
index 8ce921f0d9..62d86616cf 100644
--- a/collects/rnrs/records/syntactic-6.ss
+++ b/collects/rnrs/records/syntactic-6.ss
@@ -36,20 +36,184 @@
 	  (rename (r6rs private records-explicit)
 		  (define-record-type define-record-type/explicit)))
 
-  ;; R5RS part of the implementation of DEFINE-RECORD-TYPE for Records SRFI
-
   (define-syntax define-record-type
-    (syntax-rules ()
-      ((define-record-type (?record-name ?constructor-name ?predicate-name)
-	 ?clause ...)
-       (define-record-type-1 ?record-name (?record-name ?constructor-name ?predicate-name)
-	 ()
-	 ?clause ...))
-      ((define-record-type ?record-name
-	 ?clause ...)
-       (define-record-type-1 ?record-name ?record-name
-	 ()
-	 ?clause ...))))
+    ;; Just check syntax, then send off to reference implementation
+    (lambda (stx)
+      (syntax-case stx ()
+        [(_ name-spec clause ...)
+         (with-syntax ([(name parts)
+                        (syntax-case #'name-spec ()
+                          [(name cname pname)
+                           (begin
+                             (if (not (identifier? #'name))
+                                 (syntax-violation #f
+                                                   "expected an identifier for the record type name"
+                                                   stx
+                                                   #'name))
+                             (if (not (identifier? #'cname))
+                                 (syntax-violation #f
+                                                   "expected an identifier for the record type constructor name"
+                                                   stx
+                                                   #'cname))
+                             (if (not (identifier? #'pname))
+                                 (syntax-violation #f
+                                                   "expected an identifier for the record type predicate name"
+                                                   stx
+                                                   #'pname))
+                             #'(name (name cname pname)))]
+                          [name
+                           (identifier? #'name)
+                           #'(name name)]
+                          [_
+                           (syntax-violation #f
+                                             (string-append
+                                              "expected either an identifier for the record type name"
+                                              " or a form (<name-id> <constructor-id> <predicate-id>)")
+                                             stx
+                                             #'name-spec)])])
+           (let* ([clauses #'(clause ...)]
+                  [extract (lambda (id)
+                             (let loop ([clauses clauses][found #f])
+                               (cond
+                                [(null? clauses) found]
+                                [(syntax-case (car clauses) ()
+                                   [(tag . body)
+                                    (free-identifier=? #'tag id)])
+                                 (if found
+                                     (syntax-violation #f
+                                                       (string-append "duplicate "
+                                                                      (symbol->string (syntax->datum id))
+                                                                      " clause")
+                                                       stx
+                                                       (car clauses))
+                                     (loop (cdr clauses) (car clauses)))]
+                                [else
+                                 (loop (cdr clauses) found)])))]
+                  [kws (with-syntax ([(kw ...)
+                                      #'(fields mutable immutable parent 
+                                                protocol sealed opaque nongenerative
+                                                parent-rtd)])
+                         #'(kw ...))])
+             (for-each (lambda (clause)
+                         (syntax-case clause ()
+                           [(id . _)
+                            (and (identifier? #'id)
+                                 (let loop ([kws kws])
+                                   (and (not (null? kws))
+                                        (or (free-identifier=? #'id (car kws))
+                                            (loop (cdr kws))))))
+                            'ok]
+                           [_
+                            (syntax-violation #f
+                                              (string-append
+                                               "expected a `mutable', `immutable', `parent',"
+                                               " `protocol', `sealed', `opaque', `nongenerative',"
+                                               " or `parent-rtd' clause")
+                                              stx
+                                              clause)]))
+                       clauses)
+             (if (and (extract #'parent) (extract #'parent-rtd))
+                 (syntax-violation #f
+                                   "cannot specify both `parent' and `parent-rtd'"
+                                   stx))
+             (syntax-case (extract #'fields) ()
+               [#f 'ok]
+               [(_ spec ...)
+                (for-each (lambda (spec)
+                            (syntax-case spec (immutable mutable)
+                              [(immutable id acc-id)
+                               (begin
+                                 (if (not (identifier? #'id))
+                                     (syntax-violation #f
+                                                       "expected a field-name identifier"
+                                                       spec
+                                                       #'id))
+                                 (if (not (identifier? #'acc-id))
+                                     (syntax-violation #f
+                                                       "expected a field-accessor identifier"
+                                                       spec
+                                                       #'acc-id)))]
+                              [(immutable id)
+                               (if (not (identifier? #'id))
+                                   (syntax-violation #f
+                                                     "expected a field-name identifier"
+                                                     spec
+                                                     #'id))]
+                              [(immutable . _)
+                               (syntax-violation #f
+                                                 "expected one or two identifiers"
+                                                 spec)]
+                              [(mutable id acc-id set-id)
+                               (begin
+                                 (if (not (identifier? #'id))
+                                     (syntax-violation #f
+                                                       "expected a field-name identifier"
+                                                       spec
+                                                       #'id))
+                                 (if (not (identifier? #'acc-id))
+                                     (syntax-violation #f
+                                                       "expected a field-accessor identifier"
+                                                       spec
+                                                       #'acc-id))
+                                 (if (not (identifier? #'set-id))
+                                     (syntax-violation #f
+                                                       "expected a field-mutator identifier"
+                                                       spec
+                                                       #'set-id)))]
+                              [(mutable id)
+                               (if (not (identifier? #'id))
+                                   (syntax-violation #f
+                                                     "expected a field-name identifier"
+                                                     spec
+                                                     #'id))]
+                              [(mutable . _)
+                               (syntax-violation #f
+                                                 "expected one or three identifiers"
+                                                 spec)]
+                              [id (identifier? #'id) 'ok]
+                              [_ (syntax-violation #f
+                                                   "expected an identifier, `immutable' form, or `mutable' form for field"
+                                                   stx
+                                                   spec)]))
+                          #'(spec ...))])
+
+             (let ([p (extract #'parent)])
+               (syntax-case p ()
+                 [#f 'ok]
+                 [(_ id) (identifier? #'id) 'ok]
+                 [_ (syntax-violation #f
+                                      "expected a single identifier for the parent record type"
+                                      p)]))
+
+             (let ([p (extract #'parent-rtd)])
+               (syntax-case p ()
+                 [#f 'ok]
+                 [(_ id cons-id) 'ok]
+                 [_ (syntax-violation #f
+                                      "expected two expressions for the parent record type and constructor"
+                                      p)]))
+
+             (syntax-case (extract #'protocol) ()
+               [#f 'ok]
+               [(_ expr) 'ok])
+
+             (syntax-case (extract #'sealed) ()
+               [#f 'ok]
+               [(_ #f) 'ok]
+               [(_ #t) 'ok])
+
+             (syntax-case (extract #'opaque) ()
+               [#f 'ok]
+               [(_ #f) 'ok]
+               [(_ #t) 'ok])
+
+             (syntax-case (extract #'nongenerative) ()
+               [#f 'ok]
+               [(_) 'ok]
+               [(_ id) (identifier? #'id) 'ok])
+
+             #'(define-record-type-1 name parts
+                 () clause ...)))])))
 
   (define-syntax define-record-type-1
     (syntax-rules (fields)
diff --git a/collects/rnrs/syntax-case-6.ss b/collects/rnrs/syntax-case-6.ss
index 367f1fb36f..f19f319a5e 100644
--- a/collects/rnrs/syntax-case-6.ss
+++ b/collects/rnrs/syntax-case-6.ss
@@ -21,7 +21,7 @@
          (rename-out [raise-syntax-error syntax-violation]))
 
 (define (r6rs:free-identifier=? a b)
-  (free-identifier=? a a))
+  (free-identifier=? a b))
 
 (define (r6rs:datum->syntax id datum)
   (unless (identifier? id)
diff --git a/collects/tests/r6rs/conditions.ss b/collects/tests/r6rs/conditions.ss
index e5bf3478dc..be1ef06a24 100644
--- a/collects/tests/r6rs/conditions.ss
+++ b/collects/tests/r6rs/conditions.ss
@@ -5,6 +5,18 @@
   (import (rnrs)
           (tests r6rs test))
 
+
+  (define-syntax test-cond
+    (syntax-rules ()
+      [(_ &c &parent (make arg ...) pred sel ...)
+       (begin
+         (test (pred (make arg ...)) #t)
+         (let ([v (make arg ...)])
+           (test (sel v) arg) ...
+           'ok)
+         (test ((record-predicate &parent) (make arg ...)) #t)
+         (test (record-type-parent &c) &parent))]))
+
   ;; ----------------------------------------
 
   (define-record-type (&cond1 make-cond1 real-cond1?)
@@ -118,7 +130,63 @@
     (test (c1-a v5)      "a3")
     (test (c2-b v5)      "b2")
 
+    (test-cond &message &condition
+               (make-message-condition "message")
+               message-condition?
+               condition-message)
     
+    (test-cond &warning &condition
+               (make-warning)
+               warning?)
+    
+    (test-cond &serious &condition
+               (make-serious-condition)
+               serious-condition?)
+
+    (test-cond &error &serious
+               (make-error)
+               error?)
+
+    (test-cond &violation &serious
+               (make-violation)
+               violation?)
+
+    (test-cond &assertion &violation
+               (make-assertion-violation)
+               assertion-violation?)
+
+    (test-cond &irritants &condition
+               (make-irritants-condition (list 'sand 'salt 'acid))
+               irritants-condition?
+               condition-irritants)
+
+    (test-cond &who &condition
+               (make-who-condition 'new-boss)
+               who-condition?
+               condition-who)
+
+    (test-cond &non-continuable &violation
+               (make-non-continuable-violation)
+               non-continuable-violation?)
+
+    (test-cond &implementation-restriction &violation
+              (make-implementation-restriction-violation)
+              implementation-restriction-violation?)
+
+    (test-cond &lexical &violation
+               (make-lexical-violation)
+               lexical-violation?)
+    
+    (test-cond &syntax &violation
+               (make-syntax-violation '(lambda (x) case) 'case)
+               syntax-violation?
+               syntax-violation-form
+               syntax-violation-subform)
+
+    (test-cond &undefined &violation
+               (make-undefined-violation)
+               undefined-violation?)
+
     ;;
     ))
 
diff --git a/collects/tests/r6rs/records/syntactic.ss b/collects/tests/r6rs/records/syntactic.ss
index 8b4ff694eb..3e38942b8c 100644
--- a/collects/tests/r6rs/records/syntactic.ss
+++ b/collects/tests/r6rs/records/syntactic.ss
@@ -22,6 +22,12 @@
     (fields
      (mutable rgb cpoint-rgb cpoint-rgb-set!)))
   
+  (define-record-type (cpoint2 make-cpoint2 cpoint2?)
+    (parent-rtd (record-type-descriptor point)
+                (record-constructor-descriptor point))
+    (fields rgb)
+    (opaque #f) (sealed #f))
+  
   (define (color->rgb c)
     (cons 'rgb c))
   
@@ -94,6 +100,7 @@
     (test (point-y p1) 17)
 
     (test (record-rtd p1) (record-type-descriptor point))
+    (test point (record-type-descriptor point))
     
     (test (ex1-f ex1-i1) '(1 2 3))
 
@@ -107,8 +114,37 @@
     (test (ex3-thickness ex3-i1) 18)
     (test *ex3-instance* ex3-i1)
 
+    (test (record? p1) #t)
     (test (record? ex3-i1) #f)
+
+    (test (record-type-name point) 'point)
+    (test (record-type-name cpoint2) 'cpoint2)
+    (test (record-type-name ex1) 'ex1)
+
+    (test (record-type-parent point) #f)
+    (test (record-type-parent cpoint2) point)
+
+    (test (record-type-uid point) 'point-4893d957-e00b-11d9-817f-00111175eb9e)
+    (test/unspec (record-type-uid cpoint2))
+    (test/unspec (record-type-uid ex1))
+
+    (test (record-type-generative? point) #f)
+    (test (record-type-generative? cpoint2) #t)
+    (test (record-type-generative? ex1) #t)
+
+    (test (record-type-sealed? point) #f)
+    (test (record-type-sealed? ex3) #t)
       
+    (test (record-type-opaque? point) #f)
+    (test (record-type-opaque? ex3) #t)
+      
+    (test (record-type-field-names point) '#(x y))
+    (test (record-type-field-names cpoint2) '#(rgb))
+    
+    (test (record-field-mutable? point 0) #f)
+    (test (record-field-mutable? point 1) #t)
+    (test (record-field-mutable? cpoint 0) #t)
+
     ;;
     ))