+ (defclass effective-special-slot-definition (standard-effective-slot-definition)
+ ()))
+
+(defvar *unbound-marker* (gensym "UNBOUND-MARKER-"))
+
+(defun most-specific-slot-value (instances slot &optional (default *unbound-marker*))
+ (let ((object (find-if
+ #'(lambda (ob)
+ (and (slot-exists-p ob slot) (slot-boundp ob slot)))
+ instances)))
+ (if object
+ (slot-value object slot)
+ default)))
+
+(defmethod initialize-instance ((slotd effective-special-slot-definition) &rest initargs)
+ (declare (ignore initargs))
+ (call-next-method)
+ (setf (slot-value slotd 'allocation) :instance))
+