X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fstd-class.lisp;h=41b439009d258a0f492023543ea53ea8642dbdfa;hb=f3f677703e37f5a335b3be7fa64f7748ad969517;hp=89815b99bb87536520e77bd7528b9233b66a4cff;hpb=ae47ad0774edd8cb376772ae7e615428295f979e;p=sbcl.git diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 89815b9..41b4390 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -349,15 +349,17 @@ (defun ensure-class-values (class initargs) (let (metaclass metaclassp reversed-plist) (doplist (key val) initargs - (cond ((eq key :metaclass) - (setf metaclass val - metaclassp key)) - (t - (when (eq key :direct-superclasses) - (setf val (mapcar #'fix-super val))) - (setf reversed-plist (list* val key reversed-plist))))) + (cond ((eq key :metaclass) + (setf metaclass val + metaclassp key)) + (t + (when (eq key :direct-superclasses) + (setf val (mapcar #'fix-super val))) + (setf reversed-plist (list* val key reversed-plist))))) (values (cond (metaclassp - (find-class metaclass)) + (if (classp metaclass) + metaclass + (find-class metaclass))) ((or (null class) (forward-referenced-class-p class)) *the-class-standard-class*) (t @@ -648,15 +650,8 @@ (defun make-defstruct-allocation-function (class) (let ((dd (get-structure-dd (class-name class)))) (lambda () - (let ((instance (%make-instance (dd-length dd))) - (raw-index (dd-raw-index dd))) - (setf (%instance-layout instance) - (sb-kernel::compiler-layout-or-lose (dd-name dd))) - (when raw-index - (setf (%instance-ref instance raw-index) - (make-array (dd-raw-length dd) - :element-type '(unsigned-byte 32)))) - instance)))) + (sb-kernel::%make-instance-with-layout + (sb-kernel::compiler-layout-or-lose (dd-name dd)))))) (defmethod shared-initialize :after ((class structure-class)