(allocate-standard-funcallable-instance-slots
wrapper slots-init-p slots-init))
fin))
-
-(defun allocate-structure-instance (wrapper &optional
- (slots-init nil slots-init-p))
- (let* ((class (wrapper-class wrapper))
- (constructor (class-defstruct-constructor class)))
- (if constructor
- (let ((instance (funcall constructor))
- (slots (class-slots class)))
- (when slots-init-p
- (dolist (slot slots)
- (setf (slot-value-using-class class instance slot)
- (pop slots-init))))
- instance)
- (error "can't allocate an instance of class ~S" (class-name class)))))
\f
;;;; BOOTSTRAP-META-BRAID
;;;;
class name class-eq-specializer-wrapper source
direct-supers direct-subclasses cpl wrapper))))))))
+ (setq **standard-method-classes**
+ (mapcar (lambda (name)
+ (symbol-value (make-class-symbol name)))
+ *standard-method-class-names*))
+
(let* ((smc-class (find-class 'standard-method-combination))
(smc-wrapper (!bootstrap-get-slot 'standard-class
smc-class
(let ((class (classoid-pcl-class classoid)))
(cond (class
(ensure-non-standard-class (class-name class) classoid class))
- ((eq 'complete *boot-state*)
+ ((eq 'complete **boot-state**)
(ensure-non-standard-class (classoid-name classoid) classoid)))))
(pushnew 'ensure-deffoo-class sb-kernel::*defstruct-hooks*)
;;; FIXME: only needed during bootstrap
(defun make-class-predicate (class name)
(let* ((gf (ensure-generic-function name :lambda-list '(object)))
- (mlist (if (eq *boot-state* 'complete)
+ (mlist (if (eq **boot-state** 'complete)
(early-gf-methods gf)
(generic-function-methods gf))))
(unless mlist
;;; Set the inherits from CPL, and register the layout. This actually
;;; installs the class in the Lisp type system.
-(defun update-lisp-class-layout (class layout)
+(defun %update-lisp-class-layout (class layout)
+ ;; Protected by *world-lock* in callers.
(let ((classoid (layout-classoid layout))
(olayout (class-wrapper class)))
(unless (eq (classoid-layout classoid) layout)
(when (and name (symbolp name) (eq name (classoid-name classoid)))
(setf (find-classoid name) classoid))))))
-(defun set-class-type-translation (class classoid)
+(defun %set-class-type-translation (class classoid)
(when (not (typep classoid 'classoid))
(setq classoid (find-classoid classoid nil)))
(etypecase classoid
(aver (eq class lclass-pcl-class))
(setf (classoid-pcl-class lclass) class))
- (update-lisp-class-layout class layout)
+ (%update-lisp-class-layout class layout)
(cond (olclass
(aver (eq lclass olclass)))
(t
(setf (find-classoid name) lclass)))
- (set-class-type-translation class name))))
+ (%set-class-type-translation class name))))
-(setq *boot-state* 'braid)
+(setq **boot-state** 'braid)
(defmethod no-applicable-method (generic-function &rest args)
(error "~@<There is no applicable method for the generic function ~2I~_~S~