diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt
index 00416a719369ed48717d4f131d7ea6e1b75e8aae..891b3fec95f76a3cc2a6ce32f70d75ffec31ec8b 100644
--- a/general-info/release-19a.txt
+++ b/general-info/release-19a.txt
@@ -77,6 +77,7 @@ New in this release:
        SLOT-VALUE-USING-CLASS) methods works.
      - DIRECT-SLOT-DEFINITION-CLASS and EFFECTIVE-SLOT-DEFINITION-CLASS
        AMOP compliant.
+     - ALLOCATE-INSTANCE working with structures defined with DEFSTRUCT.
 
   * Improvements to Hemlock, the Emacs-like editor:
 
diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index 6b673caba4b51d00b778b1cf95270ff22cd8fdbc..1b26ccdb6785cba083dddcf2d92a3420f8a42827 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.57 2003/04/29 10:33:51 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.58 2003/04/29 11:57:43 gerd Exp $")
 
 (in-package :pcl)
 
@@ -622,75 +622,82 @@
 			      (make-direct-slotd class pl))
 			    direct-slots)))
 	(setq direct-slots (slot-value class 'direct-slots)))
-    (when defstruct-p
-      (let* ((include (car (slot-value class 'direct-superclasses)))
-	     (conc-name (symbolicate *package*
-				     (if (symbol-package name)
-					 (package-name (symbol-package name))
-					 "")
-				     "::" name " structure class "))
-	     ;;
-	     ;; It's not possible to use a generalized name for the
-	     ;; constructor function.  It shouldn't matter though, I think,
-	     ;; like for the slot names above, because this stuff is not
-	     ;; supposed to be used by users directly.
-	     (constructor
-	       (symbolicate *package* conc-name " constructor"))
-	     (defstruct `(defstruct (,name
-				      ,@(when include
-					  `((:include ,(class-name include))))
-				      (:predicate nil)
-				      (:conc-name ,conc-name)
-				      (:constructor ,constructor ()))
-			   ;;
-			   ;; Use a temporary unbound marker that lets
-			   ;; SHARED-INITIALIZE recognize if a before-method
-			   ;; has written to a slot.
-			   ,@(mapcar (lambda (slot)
-				       `(,(slot-definition-name slot)
-					 '.unbound.))
-			             direct-slots)))
-	     (reader-names (mapcar (lambda (slotd)
-				     (list 'slot-accessor name
-					   (slot-definition-name slotd)
-					   'reader))
-				   direct-slots))
-	     (writer-names (mapcar (lambda (slotd)
-				     (list 'slot-accessor name
-					   (slot-definition-name slotd)
-					   'writer))
-				   direct-slots))
-	     (readers-init 
-	      (mapcar (lambda (slotd reader-name)
-			(let ((accessor 
-			       (slot-definition-defstruct-accessor-symbol slotd)))
-			  `(defun ,reader-name (obj)
-			     (declare (type ,name obj))
-			     (,accessor obj))))
-		      direct-slots reader-names))
-	     (writers-init 
-	      (mapcar (lambda (slotd writer-name)
-			(let ((accessor 
-			       (slot-definition-defstruct-accessor-symbol slotd)))
-			  `(defun ,writer-name (nv obj)
-			     (declare (type ,name obj))
-			     (setf (,accessor obj) nv))))
-		      direct-slots writer-names))
-	     (defstruct-form
-	       `(progn
-		  ,defstruct
-		  ,@readers-init ,@writers-init)))
-	(unless (structure-type-p name) (eval defstruct-form))
-	(mapc (lambda (dslotd reader-name writer-name)
-		(let* ((reader (when (fboundp reader-name)
-				 (gdefinition reader-name)))
-		       (writer (when (fboundp writer-name)
-				 (gdefinition writer-name))))
-		  (setf (slot-value dslotd 'internal-reader-function) reader)
-		  (setf (slot-value dslotd 'internal-writer-function) writer)))
-	      direct-slots reader-names writer-names)
-	(setf (slot-value class 'defstruct-form) defstruct-form)
-	(setf (slot-value class 'defstruct-constructor) constructor))))
+    (if defstruct-p
+	(let* ((include (car (slot-value class 'direct-superclasses)))
+	       (conc-name (symbolicate *package*
+				       (if (symbol-package name)
+					   (package-name (symbol-package name))
+					   "")
+				       "::" name " structure class "))
+	       ;;
+	       ;; It's not possible to use a generalized name for the
+	       ;; constructor function.  It shouldn't matter though, I think,
+	       ;; like for the slot names above, because this stuff is not
+	       ;; supposed to be used by users directly.
+	       (constructor
+		(symbolicate *package* conc-name " constructor"))
+	       (defstruct `(defstruct (,name
+					,@(when include
+					    `((:include ,(class-name include))))
+					(:predicate nil)
+					(:conc-name ,conc-name)
+					(:constructor ,constructor ()))
+			     ;;
+			     ;; Use a temporary unbound marker that lets
+			     ;; SHARED-INITIALIZE recognize if a before-method
+			     ;; has written to a slot.
+			     ,@(mapcar (lambda (slot)
+					 `(,(slot-definition-name slot)
+					    '.unbound.))
+				       direct-slots)))
+	       (reader-names (mapcar (lambda (slotd)
+				       (list 'slot-accessor name
+					     (slot-definition-name slotd)
+					     'reader))
+				     direct-slots))
+	       (writer-names (mapcar (lambda (slotd)
+				       (list 'slot-accessor name
+					     (slot-definition-name slotd)
+					     'writer))
+				     direct-slots))
+	       (readers-init 
+		(mapcar (lambda (slotd reader-name)
+			  (let ((accessor 
+				 (slot-definition-defstruct-accessor-symbol slotd)))
+			    `(defun ,reader-name (obj)
+			       (declare (type ,name obj))
+			       (,accessor obj))))
+			direct-slots reader-names))
+	       (writers-init 
+		(mapcar (lambda (slotd writer-name)
+			  (let ((accessor 
+				 (slot-definition-defstruct-accessor-symbol slotd)))
+			    `(defun ,writer-name (nv obj)
+			       (declare (type ,name obj))
+			       (setf (,accessor obj) nv))))
+			direct-slots writer-names))
+	       (defstruct-form
+		`(progn
+		   ,defstruct
+		   ,@readers-init ,@writers-init)))
+	  (unless (structure-type-p name) (eval defstruct-form))
+	  (mapc (lambda (dslotd reader-name writer-name)
+		  (let* ((reader (when (fboundp reader-name)
+				   (gdefinition reader-name)))
+			 (writer (when (fboundp writer-name)
+				   (gdefinition writer-name))))
+		    (setf (slot-value dslotd 'internal-reader-function) reader)
+		    (setf (slot-value dslotd 'internal-writer-function) writer)))
+		direct-slots reader-names writer-names)
+	  (setf (slot-value class 'defstruct-form) defstruct-form)
+	  (setf (slot-value class 'defstruct-constructor) constructor))
+	;;
+	;; ALLOCATE-INSTANCE is supposed to work with structures
+	;; defined with DEFSTRUCT.
+	(with-slots (defstruct-constructor) class
+	  (setq defstruct-constructor
+		(make-defstruct-allocation-function class)))))
+  ;;
   (add-direct-subclasses class direct-superclasses)
   (setf (slot-value class 'class-precedence-list) 
 	(compute-class-precedence-list class))
@@ -709,6 +716,24 @@
   (make-class-predicate class predicate-name)
   (add-slot-accessors class direct-slots))
 
+;;;
+;;; Return a closure for allocating an uninitialized structure
+;;; instance of class CLASS.
+;;; 
+(defun make-defstruct-allocation-function (class)
+  (let ((dd (get-structure-dd (class-name class))))
+    (lambda ()
+      (let ((instance (kernel::%make-instance (kernel::dd-length dd)))
+	    (raw-index (kernel::dd-raw-index dd)))
+	(setf (kernel::%instance-layout instance)
+	      (kernel::compiler-layout-or-lose (kernel::dd-name dd)))
+	(when raw-index
+	  (setf (kernel::%instance-ref
+		 instance raw-index
+		 (make-array (kernel::dd-raw-length dd)
+			     :element-type '(unsigned-byte 32)))))
+	instance))))
+    
 (defmethod direct-slot-definition-class ((class structure-class)
 					 &rest initargs)
   (declare (ignore initargs))