-(defun (setf find-class) (new-value symbol)
- (if (legal-class-name-p symbol)
- (let ((cell (find-class-cell symbol)))
- (setf (find-class-cell-class cell) new-value)
- (when (or (eq *boot-state* 'complete)
- (eq *boot-state* 'braid))
- (when (and new-value (class-wrapper new-value))
- (setf (find-class-cell-predicate cell)
- (fdefinition (class-predicate-name new-value))))
- (when (and new-value (not (forward-referenced-class-p new-value)))
-
- (dolist (keys+aok (find-class-cell-make-instance-function-keys
- cell))
- (update-initialize-info-internal
- (initialize-info new-value (car keys+aok) nil (cdr keys+aok))
- 'make-instance-function))))
- new-value)
- (error "~S is not a legal class name." symbol)))
+(defun (setf find-class) (new-value name &optional errorp environment)
+ (declare (ignore errorp environment))
+ (cond ((legal-class-name-p name)
+ (with-single-package-locked-error
+ (:symbol name "using ~A as the class-name argument in ~
+ (SETF FIND-CLASS)"))
+ (let ((cell (find-class-cell name)))
+ (setf (find-class-cell-class cell) new-value)
+ (when (and (eq *boot-state* 'complete) (null new-value))
+ (setf (find-classoid name) nil))
+ (when (or (eq *boot-state* 'complete)
+ (eq *boot-state* 'braid))
+ (when (and new-value (class-wrapper new-value)
+ (class-predicate-name new-value))
+ (setf (find-class-cell-predicate cell)
+ (fdefinition (class-predicate-name new-value))))
+ (update-ctors 'setf-find-class :class new-value :name name))
+ new-value))
+ (t
+ (error "~S is not a legal class name." name))))