diff --git a/bootfiles/18e/boot10.lisp b/bootfiles/18e/boot10.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..6695de8cab817e9a3bc9faae575f44c3c732f30f
--- /dev/null
+++ b/bootfiles/18e/boot10.lisp
@@ -0,0 +1,102 @@
+;;;
+;;; Bootstrap.lisp for changing slot %NAME of DEFSTRUCT-SLOT-DESCRIPTION
+;;; to NAME, and making NAME hold the slot name symbol instead
+;;; of a string.  This is necessary for a conforming SLOT-EXISTS-P
+;;; and MAKE-LOAD-FORM-SAVING-SLOTS.
+;;;
+;;; The build is unusual in that it requires two full builds with the
+;;; same bootstrap file in a row, that is:
+;;;
+;;; 1. Copy this file to target:bootstrap.lisp and do a full build.
+;;;    Choose the CLOBBER-IT restart when asked.  For an unknown
+;;;    reason, it doesn't work to do this programatically.
+;;;
+;;; 2. Leave the bootstrap file where it is and do a full build with
+;;;    the Lisp produced by step 1.
+;;;
+;;; 3. Remove the bootstrap file, and build again.
+;;;
+
+(in-package :kernel)
+
+;;;
+;;; Like DEFSTRUCT, but silently clobber old definitions.
+;;;
+(defmacro defstruct! (name &rest stuff)
+  `(handler-bind ((error (lambda (c)
+			   (declare (ignore c))
+			   (invoke-restart 'kernel::clobber-it))))
+     (defstruct ,name ,@stuff)))
+
+(defstruct (defstruct-slot-description
+             (:conc-name dsd-)
+             (:print-function print-defstruct-slot-description)
+	     (:pure t)
+	     (:make-load-form-fun :just-dump-it-normally))
+  name
+  (index (required-argument) :type fixnum)
+  (accessor nil)
+  default
+  (type t)
+  (raw-type t :type (member t single-float double-float #+long-float long-float
+			    complex-single-float complex-double-float
+			    #+long-float complex-long-float
+			    unsigned-byte))
+  (read-only nil :type (member t nil)))
+
+(setf (info type compiler-layout 'defstruct-slot-description)
+      (%class-layout (find-class 'defstruct-slot-description)))
+
+(let ((*setf-fdefinition-hook* nil))
+  (setf (fdefinition 'dsd-name)
+	(lambda (dsd)
+	  (let ((name (%instance-ref dsd 1)))
+	    (if (stringp name)
+		(intern name (symbol-package (dsd-accessor dsd)))
+		name)))))
+
+(defun dsd-%name (dsd)
+  (symbol-name (dsd-name dsd)))
+
+(defun parse-1-dsd (defstruct spec &optional
+		     (islot (make-defstruct-slot-description
+			     :name nil :index 0 :type t)))
+  (multiple-value-bind (name default default-p type type-p read-only ro-p)
+      (cond ((listp spec)
+	     (destructuring-bind (name &optional (default nil default-p)
+				       &key (type nil type-p)
+				       (read-only nil ro-p))
+		 spec
+	       (values name default default-p type type-p read-only ro-p)))
+	    (t
+	     (when (keywordp spec)
+	       (warn "Keyword slot name indicates probable syntax ~
+		      error in DEFSTRUCT -- ~S."
+		     spec))
+	     spec))
+    (when (find name (dd-slots defstruct) :test #'string= :key #'dsd-%name)
+      (error 'simple-program-error
+	     :format-control "Duplicate slot name ~S."
+	     :format-arguments (list name)))
+    (setf (dsd-name islot) name)
+    (setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list islot)))
+    (setf (dsd-accessor islot) (concat-pnames (dd-conc-name defstruct) name))
+    (when default-p
+      (setf (dsd-default islot) default))
+    (when type-p
+      (setf (dsd-type islot)
+	    (if (eq (dsd-type islot) 't)
+		type
+		`(and ,(dsd-type islot) ,type))))
+    (when ro-p
+      (if read-only
+	  (setf (dsd-read-only islot) t)
+	  (when (dsd-read-only islot)
+	    (error "Slot ~S must be read-only in subtype ~S." name
+		   (dsd-name islot)))))
+    islot))
+
+(defun compare-slots (old new)
+  (values nil nil nil))
+
+;;; end of file
diff --git a/code/defstruct.lisp b/code/defstruct.lisp
index 83b709d8b162cbbb88d88c7afce3565eb89ab5eb..4971320ae80bbaee59acada27d1cc16354f8ac0f 100644
--- a/code/defstruct.lisp
+++ b/code/defstruct.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/defstruct.lisp,v 1.86 2003/05/12 21:54:57 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.87 2003/05/20 18:39:36 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -266,6 +266,9 @@
    ;; a list of (NAME . INDEX) pairs for accessors of included structures
    (inherited-accessor-alist () :type list))
 
+(defun print-defstruct-description (structure stream depth)
+  (declare (ignore depth))
+  (format stream "#<Defstruct-Description for ~S>" (dd-name structure)))
 
 ;;; DEFSTRUCT-SLOT-DESCRIPTION  holds compile-time information about structure
 ;;; slots.
@@ -275,7 +278,9 @@
              (:print-function print-defstruct-slot-description)
 	     (:pure t)
 	     (:make-load-form-fun :just-dump-it-normally))
-  %name				; string name of slot
+  ;;
+  ;; The name of the slot, a symbol.
+  name
   ;;
   ;; its position in the implementation sequence
   (index (required-argument) :type fixnum)
@@ -292,10 +297,12 @@
 			    unsigned-byte))
   (read-only nil :type (member t nil)))
 
-(defun print-defstruct-description (structure stream depth)
+(defun print-defstruct-slot-description (structure stream depth)
   (declare (ignore depth))
-  (format stream "#<Defstruct-Description for ~S>" (dd-name structure)))
+  (format stream "#<Defstruct-Slot-Description for ~S>" (dsd-name structure)))
 
+(defun dsd-%name (dsd)
+  (symbol-name (dsd-name dsd)))
 
 ;;; CLASS-STRUCTURE-P  --  Internal
 ;;;
@@ -317,20 +324,6 @@
 	   (error "Class is not a structure class: ~S" name))
 	  (t res))))
 
-
-;;; DSD-Name  --  External
-;;;
-;;;    Return the name of a defstruct slot as a symbol.  We store it
-;;; as a string to avoid creating lots of worthless symbols at load time.
-;;;
-(defun dsd-name (dsd)
-  (intern (string (dsd-%name dsd))
-	  (symbol-package (dsd-accessor dsd))))
-
-(defun print-defstruct-slot-description (structure stream depth)
-  (declare (ignore depth))
-  (format stream "#<Defstruct-Slot-Description for ~S>" (dsd-name structure)))
-
 (defun dd-maybe-make-print-method (defstruct)
   ;; Maybe generate CLOS DEFMETHOD forms for :print-function/:print-object.
   (let ((print-function-value (dd-print-function defstruct)))
@@ -674,30 +667,27 @@
 ;;;
 (defun parse-1-dsd (defstruct spec &optional
 		     (islot (make-defstruct-slot-description
-			     :%name "" :index 0 :type t)))
-  (multiple-value-bind
-      (name default default-p type type-p read-only ro-p)
-      (cond
-       ((listp spec)
-	(destructuring-bind (name &optional (default nil default-p)
-				  &key (type nil type-p) (read-only nil ro-p))
-			    spec
-	  (values name default default-p type type-p read-only ro-p)))
-       (t
-	(when (keywordp spec)
-	  (warn "Keyword slot name indicates probable syntax ~
-		 error in DEFSTRUCT -- ~S."
-		spec))
-	spec))
+			     :name nil :index 0 :type t)))
+  (multiple-value-bind (name default default-p type type-p read-only ro-p)
+      (cond ((listp spec)
+	     (destructuring-bind (name &optional (default nil default-p)
+				       &key (type nil type-p)
+				       (read-only nil ro-p))
+		 spec
+	       (values name default default-p type type-p read-only ro-p)))
+	    (t
+	     (when (keywordp spec)
+	       (warn "Keyword slot name indicates probable syntax ~
+		      error in DEFSTRUCT -- ~S."
+		     spec))
+	     spec))
     (when (find name (dd-slots defstruct) :test #'string= :key #'dsd-%name)
       (error 'simple-program-error
 	     :format-control "Duplicate slot name ~S."
 	     :format-arguments (list name)))
-    (setf (dsd-%name islot) (string name))
+    (setf (dsd-name islot) name)
     (setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list islot)))
-
     (setf (dsd-accessor islot) (concat-pnames (dd-conc-name defstruct) name))
-
     (when default-p
       (setf (dsd-default islot) default))
     (when type-p
diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt
index 9a6224977cf27bbc1a44b3227a814c39e1481386..16a4d257c023d589dfc569a0f7d9e333c01ac72f 100644
--- a/general-info/release-19a.txt
+++ b/general-info/release-19a.txt
@@ -81,6 +81,7 @@ New in this release:
      - Standard methods for STANDARD-OBJECT and STRUCTURE-OBJECT
        defined on MAKE-LOAD-FORM.
      - Compliant MAKE-LOAD-FORM-SAVING-SLOTS.
+     - DEFSTRUCT recording slot-names as specified by users.
 
   * Numerous bugfixes:
      - NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR
diff --git a/pcl/methods.lisp b/pcl/methods.lisp
index fd7086eca04a2d0c2cd80dde8953f601fd399aee..1c2169fe297d9a16526dd6e6c06198ab46e2ce75 100644
--- a/pcl/methods.lisp
+++ b/pcl/methods.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.31 2003/05/12 11:27:47 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.32 2003/05/20 18:39:36 gerd Exp $")
 
 (in-package :pcl)
 
@@ -225,10 +225,16 @@
       "is not a non-null atom"))
 
 (defmethod legal-slot-name-p ((object standard-method) x)
-  (cond ((not (symbolp x)) "is not a symbol and so cannot be bound")
-	((keywordp x)      "is a keyword and so cannot be bound")
-	((memq x '(t nil)) "cannot be bound")
-	((constantp x)     "is a constant and so cannot be bound")
+  (cond ((not (symbolp x))
+	 "is not a symbol and so cannot be bound")
+	((keywordp x)
+	 (if *allow-keyword-slot-names*
+	     t
+	     "is a keyword and so cannot be bound"))
+	((memq x '(t nil))
+	 "cannot be bound")
+	((constantp x)
+	 "is a constant and so cannot be bound")
 	(t t)))
 
 (defmethod legal-specializers-p ((object standard-method) x)
diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index 3a36e173dd1cd4df8df985dc4f064f45d259ea91..fb012a6705c8b15b8b85dca9f573db381d27a486 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.65 2003/05/11 11:30:34 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.66 2003/05/20 18:39:36 gerd Exp $")
 
 (in-package :pcl)
 
@@ -1064,6 +1064,13 @@
     (mapc #'initialize-internal-slot-functions eslotds)
     eslotds))
 
+(defvar *allow-keyword-slot-names* nil)
+
+(defmethod initialize-internal-slot-functions :around
+    ((slotd structure-effective-slot-definition))
+  (let ((*allow-keyword-slot-names* t))
+    (call-next-method)))
+  
 (defmethod compute-effective-slot-definition
     ((class slot-class) slot-name dslotds)
   (declare (ignore slot-name))