X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fstd-class.lisp;h=558d920f3bec45a6f32cac08153b26185031762f;hb=50f728671defadb8f7b1e8691c984cb0e6aba17c;hp=49aaa87b3e98134a3a127b51e21aa8f10b2e9ad6;hpb=95345bb533def44122ad6a1f61f06c3a0be3e9e3;p=sbcl.git diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 49aaa87..558d920 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -327,9 +327,9 @@ (setf (gdefinition 'load-defclass) #'real-load-defclass) (defun ensure-class (name &rest all) - (apply #'ensure-class-using-class name (find-class name nil) all)) + (apply #'ensure-class-using-class (find-class name nil) name all)) -(defmethod ensure-class-using-class (name (class null) &rest args &key) +(defmethod ensure-class-using-class ((class null) name &rest args &key) (multiple-value-bind (meta initargs) (ensure-class-values class args) (set-class-type-translation (class-prototype meta) name) @@ -338,7 +338,7 @@ (set-class-type-translation class name) class)) -(defmethod ensure-class-using-class (name (class pcl-class) &rest args &key) +(defmethod ensure-class-using-class ((class pcl-class) name &rest args &key) (multiple-value-bind (meta initargs) (ensure-class-values class args) (unless (eq (class-of class) meta) (change-class class meta)) @@ -449,7 +449,8 @@ (when (neq supplied-supers unsupplied) (list :direct-superclasses (mapcar #'fix-super supplied-supers))) (when (neq supplied-slots unsupplied) - (list :direct-slots supplied-slots)))))) + (list :direct-slots supplied-slots)) + initargs)))) (defmethod shared-initialize :after ((class std-class) @@ -1166,7 +1167,7 @@ (wrapper-instance-slots-layout owrapper)) (setf (wrapper-class-slots nwrapper) (wrapper-class-slots owrapper)) - (sb-sys:without-interrupts + (with-pcl-lock (update-lisp-class-layout class nwrapper) (setf (slot-value class 'wrapper) nwrapper) (invalidate-wrapper owrapper :flush nwrapper)))))) @@ -1186,7 +1187,7 @@ (wrapper-instance-slots-layout owrapper)) (setf (wrapper-class-slots nwrapper) (wrapper-class-slots owrapper)) - (sb-sys:without-interrupts + (with-pcl-lock (update-lisp-class-layout class nwrapper) (setf (slot-value class 'wrapper) nwrapper) (invalidate-wrapper owrapper :obsolete nwrapper)