diff --git a/code/class.lisp b/code/class.lisp
index 627dc8acf40235eeff0a62b3074d50e8f7379d08..034d2634c692383e6e24c346805c96523912d9e4 100644
--- a/code/class.lisp
+++ b/code/class.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.43 2000/05/02 04:44:03 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/class.lisp,v 1.44 2000/08/06 19:12:17 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -174,6 +174,51 @@
 	    (1+ (random layout-hash-max seed)))))
   layout)
 
+;;; order-layout-inherits  --  Interface
+;;;
+;;; Arrange the inherited layouts to appear at their expected depth, ensuring
+;;; that hierarchical type tests succeed. Layouts with a specific depth are
+;;; placed first, then the non-hierarchical layouts fill remaining elements.
+;;; Any empty elements are filled with layout copies ensuring that all
+;;; elements have a valid layout. This re-ordering may destroy CPL ordering so
+;;; the inherits should not be read as being in CPL order, and further
+;;; duplicates may be introduced.
+;;;
+(defun order-layout-inherits (layouts)
+  (declare (simple-vector layouts))
+  (let ((length (length layouts))
+	(max-depth -1))
+    (dotimes (i length)
+      (let ((depth (layout-inheritance-depth (svref layouts i))))
+	(when (> depth max-depth)
+	  (setf max-depth depth))))
+    (let* ((new-length (max (1+ max-depth) length))
+	   (inherits (make-array new-length)))
+      (dotimes (i length)
+	(let* ((layout (svref layouts i))
+	       (depth (layout-inheritance-depth layout)))
+	  (unless (eql depth -1)
+	    (unless (eql (svref inherits depth) 0)
+	      (error "Layout depth confict: ~S~%" layouts))
+	    (setf (svref inherits depth) layout))))
+      (do ((i 0 (1+ i))
+	   (j 0))
+	  ((>= i length))
+	(declare (type index i j))
+	(let* ((layout (svref layouts i))
+	       (depth (layout-inheritance-depth layout)))
+	  (when (eql depth -1)
+	    (loop (when (eql (svref inherits j) 0)
+		    (return))
+		  (incf j))
+	    (setf (svref inherits j) layout))))
+      (do ((i (1- new-length) (1- i)))
+	  ((< i 0))
+	(declare (type fixnum i))
+	(when (eql (svref inherits i) 0)
+	  (setf (svref inherits i) (svref inherits (1+ i)))))
+      inherits)))
+
 
 ;;; The CLASS structure is a supertype of all CLASS types.  A CLASS is also a
 ;;; CTYPE structure as recognized by the type system.
@@ -758,8 +803,7 @@
 			   generic-sequence collection symbol)
 		:direct-superclasses (list symbol))
 
-	  (stream :hierarchical nil :state :read-only
-		  :inherits (instance t)))))
+	  (stream :state :read-only :depth 3 :inherits (instance)))))
 
 ;;; See also type-init.lisp where we finish setting up the translations for
 ;;; built-in types.
@@ -767,7 +811,7 @@
 (cold-load-init
   (dolist (x built-in-classes)
     (destructuring-bind (name &key (translation nil trans-p) inherits codes
-			      enumerable state (hierarchical t)
+			      enumerable state (hierarchical t) depth
 			      (direct-superclasses
 			       (if inherits (list (car inherits)) '(t))))
 			x
@@ -787,7 +831,9 @@
 	(setf (class-cell-class (find-class-cell name)) class)
 	(unless trans-p
 	  (setf (info type builtin name) class))
-	(let* ((inheritance-depth (if hierarchical (length inherits) -1))
+	(let* ((inheritance-depth (if hierarchical
+				      (or depth (length inherits))
+				      -1))
 	       (inherit-layouts
 		(map 'vector
 		     #'(lambda (x)
@@ -804,20 +850,20 @@
 ;;; correctly and the lisp layout replaced by a PCL wrapper after PCL
 ;;; is loaded and the class defined.
 (cold-load-init
-  (dolist (x '((fundamental-stream (t instance stream))))
+  (dolist (x '((fundamental-stream (t instance stream stream))))
     (let* ((name (first x))
 	   (inherits (second x))
-	   (class (lisp::make-standard-class :name name))
-	   (class-cell (lisp::find-class-cell name)))
-      (setf (lisp::class-cell-class class-cell) class)
+	   (class (make-standard-class :name name))
+	   (class-cell (find-class-cell name)))
+      (setf (class-cell-class class-cell) class)
       (setf (info type class name) class-cell)
       (setf (info type kind name) :instance)
       (let ((inherit-layouts
 	     (map 'vector #'(lambda (x)
-			      (lisp::class-layout (lisp:find-class x)))
+			      (class-layout (lisp:find-class x)))
 		  inherits)))
-	(lisp::register-layout (lisp::find-layout name 0 inherit-layouts -1)
-			       :invalidate nil)))))
+	(register-layout (find-layout name 0 inherit-layouts -1)
+			 :invalidate nil)))))
 
 ;;; Now that we have set up the class heterarchy, seal the sealed classes.
 ;;; This must be done after the subclasses have been set up.
diff --git a/code/error.lisp b/code/error.lisp
index a1b98bff2d5851e6f17c5eced30e4800085f606a..9eb7cfd0d7f7a1aa1bd7e51a24f618c1523652c8 100644
--- a/code/error.lisp
+++ b/code/error.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.55 2000/07/11 04:19:45 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.56 2000/08/06 19:12:17 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -420,10 +420,10 @@
 				parent-types)))))
 	 (cond-layout (info type compiler-layout 'condition))
 	 (olayout (info type compiler-layout name))
-	 (new-inherits 
-	  (concatenate 'simple-vector
-		       (layout-inherits cond-layout)
-		       (mapcar #'class-layout cpl))))
+	 (new-inherits
+	  (order-layout-inherits (concatenate 'simple-vector
+					      (layout-inherits cond-layout)
+					      (mapcar #'class-layout cpl)))))
     (if (and olayout
 	     (not (mismatch (layout-inherits olayout) new-inherits)))
 	olayout
diff --git a/code/exports.lisp b/code/exports.lisp
index 1223c8db97130279476c4951e5994b78c10bbee3..00e1628bac76eb18634cb0fdc163f831009bf221 100644
--- a/code/exports.lisp
+++ b/code/exports.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.170 2000/07/31 09:53:39 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.171 2000/08/06 19:12:18 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1573,7 +1573,8 @@
 	   "OBJECT-NOT-INSTANCE-ERROR" "OBJECT-NOT-SYMBOL-ERROR"
 	   "OBJECT-NOT-TYPE-ERROR" "OBJECT-NOT-UNSIGNED-BYTE-32-ERROR"
 	   "OBJECT-NOT-VECTOR-ERROR" "OBJECT-NOT-WEAK-POINTER-ERROR"
-	   "ODD-KEYWORD-ARGUMENTS-ERROR" "OUTPUT-OBJECT" "OUTPUT-UGLY-OBJECT"
+	   "ODD-KEYWORD-ARGUMENTS-ERROR" "ORDER-LAYOUT-INHERITS"
+	   "OUTPUT-OBJECT" "OUTPUT-UGLY-OBJECT"
 	   "PARSE-LAMBDA-LIST" "PARSE-UNKNOWN-TYPE"
 	   "PARSE-UNKNOWN-TYPE-SPECIFIER" "PATHNAME-DEVICE"
 	   "PATHNAME-DIRECTORY" "PATHNAME-HOST" "PATHNAME-NAME"
diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp
index 71fd334e463f4b8b2b20ca6a4145b5b7707129ff..8e3d1d3c481bc0b38670e7f777ddaf0622d213bc 100644
--- a/compiler/typetran.lisp
+++ b/compiler/typetran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.37 2000/05/23 06:52:09 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.38 2000/08/06 19:12:27 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -470,7 +470,7 @@
 				  (%layout-invalid-error object ',layout))))
 		      (eq ,n-layout ',layout)))))
 	   ((and (typep class 'basic-structure-class) layout)
-	    ;; Structure type tests; hierarchal layout depths.
+	    ;; Structure type tests; hierarchical layout depths.
 	    (let ((idepth (layout-inheritance-depth layout))
 		  (n-layout (gensym)))
 	      `(and (,pred object)
@@ -485,6 +485,22 @@
 				 (eq (svref (layout-inherits ,n-layout) 
 					    ,idepth)
 				     ',layout))))))))
+	   ((and layout (>= (layout-inheritance-depth layout) 0))
+	    ;; Hierarchical layout depths.
+	    (let ((idepth (layout-inheritance-depth layout))
+		  (n-layout (gensym)))
+	      `(and (,pred object)
+		    (let ((,n-layout (,get-layout object)))
+		      ,@(when (policy nil (>= safety speed))
+			      `((when (layout-invalid ,n-layout)
+				  (%layout-invalid-error object ',layout))))
+		      (if (eq ,n-layout ',layout)
+			  t
+			  (and (> (length (layout-inherits ,n-layout)) ,idepth)
+			       (locally (declare (optimize (safety 0)))
+				 (eq (svref (layout-inherits ,n-layout) 
+					    ,idepth)
+				     ',layout))))))))
 	   (t
 	    `(and (,pred object)
 		  (class-cell-typep (,get-layout object)
diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index a6790b8129f46ce9a65e768281469d2b55dbfc37..8082f5a40171f194f6ea31f68b002b8d52f02060 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.17 2000/08/06 19:11:13 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.18 2000/08/06 19:12:33 dtc Exp $")
 ;;;
 ;;; Bootstrapping the meta-braid.
 ;;;
@@ -563,8 +563,9 @@
   (let ((lclass (kernel:layout-class layout)))
     (unless (eq (kernel:class-layout lclass) layout)
       (setf (kernel:layout-inherits layout)
-	    (map 'vector #'class-wrapper
-		 (reverse (rest (class-precedence-list class)))))
+	    (kernel:order-layout-inherits
+	     (map 'simple-vector #'class-wrapper
+		  (reverse (rest (class-precedence-list class))))))
       (kernel:register-layout layout :invalidate nil)
 
       ;; Subclasses of formerly forward-referenced-class may be unknown