X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=5c3eb5c0390b5cef649341af3f663a9740b37293;hb=aa61c7571b33b86981301f34d3acdb66666f53a3;hp=472e2e45cfe006d6fbf40efc7ee8d9d3885f7115;hpb=bed279acc9bd04eb1bbf56acb0dcaa3b1acf04f0;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 472e2e4..5c3eb5c 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -1164,30 +1164,29 @@
 			  vars types))
        (list ,@vals))))
 (defun create-structure-constructor (dd cons-name arglist vars types values)
-  (let* ((temp (gensym))
-	 (raw-index (dd-raw-index dd))
-	 (n-raw-data (when raw-index (gensym))))
+  (let* ((instance (gensym "INSTANCE"))
+	 (raw-index (dd-raw-index dd)))
     `(defun ,cons-name ,arglist
-       (declare ,@(mapcar #'(lambda (var type) `(type ,type ,var))
+       (declare ,@(mapcar (lambda (var type) `(type ,type ,var))
 			  vars types))
-       (let ((,temp (truly-the ,(dd-name dd)
-			       (%make-instance ,(dd-length dd))))
-	     ,@(when n-raw-data
-		 `((,n-raw-data
-		    (make-array ,(dd-raw-length dd)
-				:element-type '(unsigned-byte 32))))))
-	 (setf (%instance-layout ,temp)
-	       (%delayed-get-compiler-layout ,(dd-name dd)))
-	 ,@(when n-raw-data
-	     `((setf (%instance-ref ,temp ,raw-index) ,n-raw-data)))
+       (let ((,instance (truly-the ,(dd-name dd)
+			  (%make-instance-with-layout
+			   (%delayed-get-compiler-layout ,(dd-name dd))))))
+	 (declare (optimize (safety 0))) ; Suppress redundant slot type checks.
+	 ,@(when raw-index
+	     `((setf (%instance-ref ,instance ,raw-index)
+		     (make-array ,(dd-raw-length dd)
+				 :element-type '(unsigned-byte 32)))))
 	 ,@(mapcar (lambda (dsd value)
-		     ;; (Note that we can't in general use the ordinary
-		     ;; slot accessor function here because the slot
-		     ;; might be :READ-ONLY.)
-		     `(,(slot-setter-lambda-form dd dsd) ,value ,temp))
+		     ;; (Note that we can't in general use the
+		     ;; ordinary named slot setter function here
+		     ;; because the slot might be :READ-ONLY, so we
+		     ;; whip up new LAMBDA representations of slot
+		     ;; setters for the occasion.)
+		     `(,(slot-setter-lambda-form dd dsd) ,value ,instance))
 		   (dd-slots dd)
 		   values)
-	 ,temp))))
+	 ,instance))))
 
 ;;; Create a default (non-BOA) keyword constructor.
 (defun create-keyword-constructor (defstruct creator)