\f
(defun allocate-standard-instance (wrapper
&optional (slots-init nil slots-init-p))
- (let ((instance (%make-standard-instance nil))
+ (let ((instance (%make-standard-instance nil (get-instance-hash-code)))
(no-of-slots (wrapper-no-of-instance-slots wrapper)))
(setf (std-instance-wrapper instance) wrapper)
(setf (std-instance-slots instance)
(defun allocate-funcallable-instance (wrapper &optional
(slots-init nil slots-init-p))
- (let ((fin (%make-pcl-funcallable-instance nil nil)))
+ (let ((fin (%make-pcl-funcallable-instance nil nil
+ (get-instance-hash-code))))
(set-funcallable-instance-fun
fin
#'(sb-kernel:instance-lambda (&rest args)
(built-in-class built-in-class-wrapper)
(structure-class structure-class-wrapper)))
(class (or (find-class name nil)
- (allocate-standard-instance wrapper))))
- (when (or (eq meta 'standard-class)
- (eq meta 'funcallable-standard-class))
- (inform-type-system-about-std-class name))
+ (allocate-standard-instance wrapper))))
(setf (find-class name) class)))
(dolist (definition *early-class-definitions*)
(let ((name (ecd-class-name definition))
smc
name
value)))
- (set-slot 'source *load-truename*)
+ (set-slot 'source *load-pathname*)
(set-slot 'type 'standard)
(set-slot 'documentation "The standard method combination.")
(set-slot 'options ()))
(!bootstrap-accessor-definitions1
'slot-object
slot-name
- (list (slot-reader-symbol slot-name))
- (list (slot-writer-symbol slot-name))
- (list (slot-boundp-symbol slot-name)))))))))))
+ (list (slot-reader-name slot-name))
+ (list (slot-writer-name slot-name))
+ (list (slot-boundp-name slot-name)))))))))))
(defun !bootstrap-accessor-definition (class-name accessor-name slot-name type)
(multiple-value-bind (accessor-class make-method-function arglist specls doc)
(sb-kernel:order-layout-inherits
(map 'simple-vector #'class-wrapper
(reverse (rest (class-precedence-list class))))))
- (sb-kernel:register-layout layout :invalidate nil)
+ (sb-kernel:register-layout layout :invalidate t)
;; Subclasses of formerly forward-referenced-class may be
;; unknown to CL:FIND-CLASS and also anonymous. This
~I~_when called with arguments ~2I~_~S.~:>"
generic-function
args))
+
+(defmethod no-next-method ((generic-function standard-generic-function)
+ (method standard-method) &rest args)
+ (error "~@<There is no next method for the generic function ~2I~_~S~
+ ~I~_when called from method ~2I~_~S~I~_with arguments ~2I~_~S.~:>"
+ generic-function
+ method
+ args))
+
+;;; An extension to the ANSI standard: in the presence of e.g. a
+;;; :BEFORE method, it would seem that going through
+;;; NO-APPLICABLE-METHOD is prohibited, as in fact there is an
+;;; applicable method. -- CSR, 2002-11-15
+(defmethod no-primary-method (generic-function &rest args)
+ (error "~@<There is no primary method for the generic function ~2I~_~S~
+ ~I~_when called with arguments ~2I~_~S.~:>"
+ generic-function
+ args))