diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index 9ac6f8750ddb96a8960359eaeb28fdd224c7afbf..ff73a7ec63a64e6c4830e117cab5f6c7a8c41c1f 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -42,10 +42,26 @@
   (let ((instance (%%allocate-instance--class))
 	(no-of-slots (wrapper-no-of-instance-slots wrapper)))
     (setf (std-instance-wrapper instance) wrapper)
+    #-cmu
     (setf (std-instance-slots instance) 
 	  (if slots-init-p
 	      (make-array no-of-slots :initial-contents slots-init)
 	      (make-array no-of-slots :initial-element *slot-unbound*)))
+    #+cmu ; faster version for CMUCL
+    (setf (std-instance-slots instance) 
+	  (cond (slots-init-p
+		 ;; Inline the slots vector allocation and initialisation.
+		 (let ((slots (make-array no-of-slots :initial-element 0)))
+		   (do ((rem-slots slots-init (rest rem-slots))
+			(i 0 (1+ i)))
+		       ((>= i no-of-slots)) ;endp rem-slots))
+		     (declare (list rem-slots)
+			      (type kernel:index i))
+		     (setf (aref slots i) (first rem-slots)))
+		   slots))
+		(t
+		 (make-array no-of-slots
+			     :initial-element pcl::*slot-unbound*))))
     instance)
   #+new-kcl-wrapper
   (apply #'si:make-structure wrapper