X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmacros.lisp;h=4a41a287b49fe5929f538cc09dec28dc387b19cb;hb=d63d80e637e9058ff5db7a10c267796ff7970ba1;hp=a9a657fd48ed0f23009b97eb2d3a8b8797d6e097;hpb=4f7161165647d655392713a0d95c951e4e1749ea;p=sbcl.git diff --git a/src/pcl/macros.lisp b/src/pcl/macros.lisp index a9a657f..4a41a28 100644 --- a/src/pcl/macros.lisp +++ b/src/pcl/macros.lisp @@ -144,19 +144,20 @@ (with-single-package-locked-error (:symbol name "Using ~A as the class-name argument in ~ (SETF FIND-CLASS)")) - (let ((cell (find-classoid-cell name :create new-value))) - (cond (new-value - (setf (classoid-cell-pcl-class cell) new-value) - (when (eq *boot-state* 'complete) - (let ((classoid (class-classoid new-value))) - (setf (find-classoid name) classoid) - (set-class-type-translation new-value classoid)))) - (cell - (clear-classoid name cell))) - (when (or (eq *boot-state* 'complete) - (eq *boot-state* 'braid)) - (update-ctors 'setf-find-class :class new-value :name name)) - new-value)) + (with-world-lock () + (let ((cell (find-classoid-cell name :create new-value))) + (cond (new-value + (setf (classoid-cell-pcl-class cell) new-value) + (when (eq *boot-state* 'complete) + (let ((classoid (class-classoid new-value))) + (setf (find-classoid name) classoid) + (%set-class-type-translation new-value classoid)))) + (cell + (%clear-classoid name cell))) + (when (or (eq *boot-state* 'complete) + (eq *boot-state* 'braid)) + (update-ctors 'setf-find-class :class new-value :name name)) + new-value))) (t (error "~S is not a legal class name." name))))