diff --git a/compiler/dump.lisp b/compiler/dump.lisp
index 354937ea531fd5099a0a7771c9a3f8250c955cf4..eb135a1a4f53f30b29f4f024bfbe7787daca39af 100644
--- a/compiler/dump.lisp
+++ b/compiler/dump.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.47 1993/01/13 18:09:43 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.47.1.1 1993/01/15 15:30:50 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index 374a37f15cd4094089a7bd706ae9fb8b191c31b2..a75a7754f54045190292f4e0786fda5888e40094 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.83 1992/12/10 16:48:17 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.83.1.1 1993/01/15 15:31:34 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -302,10 +302,10 @@
 		 ((array t)
 		  (dotimes (i (array-total-size value))
 		    (grovel (row-major-aref value i))))
-		 (structure
+		 (instance
 		  (when (emit-make-load-form value)
-		    (dotimes (i (structure-length value))
-		      (grovel (structure-ref value i)))))
+		    (dotimes (i (%instance-length value))
+		      (grovel (%instance-ref value i)))))
 		 (t
 		  (compiler-error
 		   "Cannot dump objects of type ~S into fasl files."
@@ -2586,7 +2586,7 @@
 				      form)))))
 	  
 	  (unless ignore
-	    (funcall #'%proclaim form))
+	    (%proclaim form))
 	  (if ignore
 	      (ir1-convert start cont nil)
 	      (ir1-convert start cont `(%proclaim ,what)))))
@@ -2596,12 +2596,14 @@
 ;;; %Compiler-Defstruct IR1 Convert  --  Internal
 ;;;
 ;;;    This is a frob that DEFMACRO expands into to establish the compiler
-;;; semantics.  %%COMPILER-DEFSTRUCT does most of the work, we just clear all
-;;; of the functions out of *FREE-FUNCTIONS* to keep things in synch.
+;;; semantics.  %COMPILER-ONLY-DEFSTRUCT and %%COMPILER-DEFSTRUCT do most of
+;;; the work, we just clear all of the functions out of *FREE-FUNCTIONS* to
+;;; keep things in synch.  %%COMPILER-DEFSTRUCT is also called at load-time.
 ;;;
 (def-ir1-translator %compiler-defstruct ((info) start cont :kind :function)
   (let* ((info (eval info)))
-    (funcall #'%%compiler-defstruct info)
+    (%compiler-only-defstruct info)
+    (%%compiler-defstruct info)
     (dolist (slot (dd-slots info))
       (let ((fun (dsd-accessor slot)))
 	(remhash fun *free-functions*)
diff --git a/compiler/proclaim.lisp b/compiler/proclaim.lisp
index fcf49db2876197ddd85580d56fe8c68c97c34ee2..e291e0fbf1152e4afc695fad2153b0cfe5eeb7b0 100644
--- a/compiler/proclaim.lisp
+++ b/compiler/proclaim.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.26 1992/09/15 16:10:16 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.26.1.1 1993/01/15 15:31:55 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -390,189 +390,6 @@
 ;;;
 (setf (symbol-function 'proclaim) #'%proclaim)
 
-
-;;; UNDEFINE-STRUCTURE  --  Interface
-;;;
-;;;    Blow away all the compiler info for the structure described by Info.
-;;; This recursively descends the inheritance hierarchy.
-;;; 
-(defun undefine-structure (info)
-  (declare (type defstruct-description info))
-  (let* ((name (dd-name info))
-	 (all-types (cons name (dd-included-by info))))
-    ;;
-    ;; Iterate over this type and all subtypes, clearing the compiler structure
-    ;; type info, and undefining all the associated functions.
-    (dolist (type all-types)
-      (let ((this-info (info type structure-info type)))
-	(setf (info type kind type) nil)
-	(setf (info type structure-info type) nil)
-	(setf (info type frozen type) nil)
-	(undefine-function-name (dd-copier this-info))
-	(undefine-function-name (dd-predicate this-info))
-	(dolist (slot (dd-slots this-info))
-	  (let ((fun (dsd-accessor slot)))
-	    (undefine-function-name fun)
-	    (unless (dsd-read-only slot)
-	      (undefine-function-name `(setf ,fun)))))))
-    ;;
-    ;; Iterate over all types that include this type, removing this type and
-    ;; all subtypes from the list of subtypes of the included type.  We copy
-    ;; the DD and included list so that we don't clobber the type in the
-    ;; compiler's Lisp.
-    (dolist (include (dd-includes info))
-      (let ((new (copy-defstruct-description
-		  (info type structure-info include))))
-	(setf (dd-included-by new)
-	      (set-difference (dd-included-by new) all-types))
-	(setf (info type structure-info include) new))))
-  ;;
-  ;; Clear out the SPECIFIER-TYPE cache so that subsequent references are
-  ;; unknown types.
-  (values-specifier-type-cache-clear)
-  (undefined-value))
-
-
-;;; DEFINE-DEFSTRUCT-NAME  --  Internal
-;;;
-;;;    Like DEFINE-FUNCTION-NAME, but we also set the kind to :DECLARED and
-;;; blow away any ASSUMED-TYPE.  Also, if the thing is a slot accessor
-;;; currently, quietly unaccessorize it.  And if there are any undefined
-;;; warnings, we nuke them.
-;;;
-(defun define-defstruct-name (name)
-  (when name
-    (when (info function accessor-for name)
-      (setf (info function accessor-for name) nil))
-    (define-function-name name)
-    (note-name-defined name :function)
-    (setf (info function where-from name) :declared)
-    (when (info function assumed-type name)
-      (setf (info function assumed-type name) nil)))
-  (undefined-value))
-
-
-;;; FREEZE-STRUCTURE-TYPE  --  Internal
-;;;
-;;;    Freeze the named structure type and all its inferiors.
-;;;
-(defun freeze-structure-type (name)
-  (let ((def (info type structure-info name)))
-    (when def
-      (setf (info type frozen name) t)
-      (dolist (incl (dd-included-by def))
-	(setf (info type frozen incl) t))))
-  (undefined-value))
-
-
-;;; CHECK-FOR-STRUCTURE-REDEFINITION  --  Internal
-;;;
-;;;    Called when we process a DEFSTRUCT for a type that is already defined
-;;; for a structure.  We check for incompatible redefinition and undefine the
-;;; old structure if so.  We ignore the structures that DEFSTRUCT is built out
-;;; of, since they have to be hackishly defined in type-boot.  If the structure
-;;; is not incompatibly redefined, then we copy the old INCLUDED-BY into the
-;;; new structure.
-;;;
-(defun check-for-structure-redefinition (info)
-  (declare (type defstruct-description info))
-  (let* ((name (dd-name info))
-	 (old (info type structure-info name)))
-    (cond ((member name
-		   '(defstruct-description defstruct-slot-description)))
-	  ((and (equal (dd-includes old) (dd-includes info))
-		(equalp (dd-slots old) (dd-slots info)))
-	   (setf (dd-included-by info) (dd-included-by old)))
-	  (t
-	   (compiler-warning
-	    "Incompatibly redefining structure ~S.~@
-	    Removing the old definition~:[.~;~:* and these subtypes:~%  ~S~]"
-	    name (dd-included-by old))
-	   (undefine-structure old))))
-  (undefined-value))
-
-
-;;; ADD-NEW-SUBTYPE  --  Internal
-;;;
-;;;    Add a new subtype NAME to the structure type INC.  INFO is INC's current
-;;; info.
-;;;
-(defun add-new-subtype (name inc info)
-  (let ((new (copy-defstruct-description info)))
-    (setf (info type structure-info inc) new)
-    (push name (dd-included-by new))
-    (when (info type frozen inc)
-      (compiler-warning "Adding new subtype ~S to frozen type ~S.~@
-      			 Unfreezing this type and its inferiors.~@
-			 Previously compiled type tests must be recompiled."
-			name inc)
-      (setf (info type frozen inc) nil)
-      (dolist (subtype (dd-included-by info))
-	(setf (info type frozen subtype) nil)))))
-
-
-;;; %%Compiler-Defstruct  --  Interface
-;;;
-;;;    This function updates the global compiler information to represent the
-;;; definition of the the structure described by Info.  In addition to defining
-;;; all the functions and slots, we also update the INCLUDED-BY info in the
-;;; compiler's environment.  Note that at the first time the DEFSTRUCT is
-;;; loaded, STRUCTURE-INFO is EQ to DEFINED-STRUCTURE-INFO, so the name will
-;;; already be in INCLUDED-BY.  When we do update this info, we copy the
-;;; defstruct description so that the type definition in the compiler's Lisp
-;;; isn't trashed.
-;;;
-(defun %%compiler-defstruct (info)
-  (declare (type defstruct-description info))
-  (let ((name (dd-name info)))
-    (ecase (info type kind name)
-      ((nil))
-      (:structure
-       (check-for-structure-redefinition info))
-      (:primitive
-       (compiler-error "Illegal to redefine standard type ~S." name))
-      (:defined
-       (compiler-warning "Redefining DEFTYPE type to be a DEFSTRUCT: ~S."
-			 name)
-       (setf (info type expander name) nil)))
-    
-    (dolist (inc (dd-includes info))
-      (let ((info (info type structure-info inc)))
-	(unless info
-	  (error "Structure type ~S is included by ~S but not defined."
-		 inc name))
-	(unless (member name (dd-included-by info))
-	  (add-new-subtype name inc info))))
-    
-    (setf (info type kind name) :structure)
-    (setf (info type structure-info name) info)
-    (%note-type-defined name)
-    
-    (let ((copier (dd-copier info)))
-      (when copier
-	(%proclaim `(ftype (function (,name) ,name) ,copier))))
-    
-    (let ((pred (dd-predicate info)))
-      (when pred
-	(define-defstruct-name pred)
-	(setf (info function inlinep pred) :inline)
-	(setf (info function inline-expansion pred)
-	      `(lambda (x) (typep x ',name))))))
-
-  (dolist (slot (dd-slots info))
-    (let* ((fun (dsd-accessor slot))
-	   (setf-fun `(setf ,fun)))
-      (when fun
-      (define-defstruct-name fun)
-      (setf (info function accessor-for fun) info)
-      (unless (dsd-read-only slot)
-	(define-defstruct-name setf-fun)
-	(setf (info function accessor-for setf-fun) info)))))
-  (undefined-value))
-
-(setf (symbol-function '%compiler-defstruct) #'%%compiler-defstruct)
-
-
 ;;; %NOTE-TYPE-DEFINED  --  Interface
 ;;;
 ;;;    Note that the type Name has been (re)defined, updating the undefined
diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp
index 0b081e9c65f1aa50c490f99db21be119bda5b0a3..5d11343d9cdbca69dac33e667fdf4933d668df78 100644
--- a/compiler/typetran.lisp
+++ b/compiler/typetran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.14 1992/04/27 19:46:44 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.14.1.1 1993/01/15 15:32:22 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -337,42 +337,62 @@
 	`(%typep ,obj ',(type-specifier type)))))
 
 
-;;; SOURCE-TRANSFORM-STRUCTURE-TYPEP  --  Internal
+;;; SOURCE-TRANSFORM-INSTANCE-TYPEP  --  Internal
 ;;;
-;;;    If not currently defined as a structure to the compiler (must have been
-;;; undefined) or there is no predicate, then we call STRUCTURE-TYPEP.
-;;; Otherwise, we do an EQ test for a direct type match, and if that fails,
-;;; deal with inherited types.  If the type is frozen, we can inline the
-;;; supertype check, otherwise we have to call the predicate.
+;;;    Transform a type test against some instance type.  If not properly
+;;; named, error.  If a structure, call S-T-STRUCTURE-TYPEP.  Otherwise, call
+;;; CLASS-TYPEP at run-time with the layout and class object.
 ;;;
-(defun source-transform-structure-typep (obj desc)
-  (let* ((type (structure-type-name desc))
-	 (def (info type structure-info type)))
+(defun source-transform-instance-typep (obj desc)
+  (let* ((class (instance-type-class desc))
+	 (name (class-name class))
+	 (layout (info type compiler-layout name)))
     (cond
-     ((not def)
-      `(lisp::structure-typep ,obj ',type))
-     ((not (eq (dd-type def) 'structure))
-      (compiler-error "Structure type has :TYPE specified, so it can't ~
-      		       be used as an argument to TYPEP:~%  ~S"
-		      type))
+     ((not (and name (eq (find-class name) class)))
+      (compiler-error "Can't compile TYPEP of anonymous or undefined ~
+		       class:~%  ~S"
+		      class))
+     ((and (structure-class-p class)
+	   layout
+	   (member (layout-invalid layout) '(:compiler nil)))
+      (source-transform-structure-typep obj layout))
      (t
-      (let ((frozen (info type frozen type))
-	    (included (dd-included-by def))
-	    (predicate (dd-predicate def))
-	    (n-name (gensym)))
-	(if (or frozen predicate)
-	    (once-only ((object obj))
-	      `(and (structurep ,object)
-		    (let ((,n-name (structure-ref ,object 0)))
-		      (if (eq ,n-name ',type)
-			  t
-			  ,(if frozen
-			       (when included
-				 `(if (member ,n-name ',included :test #'eq)
-				      t nil))
-			       `(locally (declare (notinline ,predicate))
-				  (,predicate ,object)))))))
-	    `(lisp::structure-typep ,obj ',type)))))))
+      (multiple-value-bind
+	  (pred layout)
+	  (if (funcallable-class-p class)
+	      (values 'funcallable-instance-p 'funcallable-instance-layout)
+	      (values '%instancep '%instance-layout))
+	(once-only ((object obj))
+	  `(and (,pred ,object)
+		(class-typep (,layout ,object) ',class))))))))
+
+
+;;; SOURCE-TRANSFORM-STRUCTURE-TYPEP  --  Internal
+;;;
+;;;    Transform a call to an actual structure type predicate with the
+;;; specified layout.  If sealed and has no subclasses, just test for
+;;; layout-EQ, otherwise do the EQ test and then a general test based on
+;;; layout-inherits.  If safety is important, then we also check if the layout
+;;; for the object is invalid and signal an error if so.
+;;;
+(defun source-transform-structure-typep (obj layout)
+  (let ((class (layout-class layout))
+	(idepth (layout-inheritance-depth layout))
+	(n-layout (gensym)))
+    (once-only ((object obj))
+      `(and (%instancep ,object)
+	    (let ((,n-layout (%instance-layout ,object)))
+	      ,@(when (policy nil (>= safety speed))
+		  `((when (layout-invalid ,n-layout)
+		      (%layout-invalid-error ,object ',layout))))
+	      ,(if (and (eq (class-state class) :sealed)
+			(not (class-subclasses class)))
+		   `(eq ,n-layout ',layout)
+		   `(if (eq ,n-layout ',layout)
+			t
+			(and (> (layout-inheritance-depth ,n-layout) ,idepth)
+			     (eq (svref (layout-inherits ,n-layout) ,idepth)
+				 ',layout)))))))))
 
 
 ;;; Source-Transform-Typep  --  Internal
@@ -406,8 +426,8 @@
 	       (source-transform-union-typep object type))
 	      (member-type
 	       `(member ,object ',(member-type-members type)))
-	      (structure-type
-	       (source-transform-structure-typep object type))
+	      (instance-type
+	       (source-transform-instance-typep object type))
 	      (args-type
 	       (compiler-warning "Illegal type specifier for Typep: ~S."
 				 (cadr spec))