;;; ...and one lock to rule them. Spinlock because for certain (rare)
;;; cases this lock might be grabbed in the course of method dispatch
;;; ...and one lock to rule them. Spinlock because for certain (rare)
;;; cases this lock might be grabbed in the course of method dispatch
(%intern-pv-table (mapcar #'intern-slot-names slot-name-lists)))))
\f
(defun optimize-slot-value-by-class-p (class slot-name type)
(%intern-pv-table (mapcar #'intern-slot-names slot-name-lists)))))
\f
(defun optimize-slot-value-by-class-p (class slot-name type)
(let* ((rebound? (caddr (var-declaration '%variable-rebinding var env)))
(parameter-or-nil (car (memq (or rebound? var)
required-parameters))))
(let* ((rebound? (caddr (var-declaration '%variable-rebinding var env)))
(parameter-or-nil (car (memq (or rebound? var)
required-parameters))))
new-value &optional safep)
(let ((class (if (consp sparameter) (cdr sparameter) *the-class-t*))
(parameter (if (consp sparameter) (car sparameter) sparameter)))
new-value &optional safep)
(let ((class (if (consp sparameter) (cdr sparameter) *the-class-t*))
(parameter (if (consp sparameter) (car sparameter) sparameter)))
(classp class)
(memq *the-class-structure-object* (class-precedence-list class)))
(let ((slotd (find-slot-definition class slot-name)))
(classp class)
(memq *the-class-structure-object* (class-precedence-list class)))
(let ((slotd (find-slot-definition class slot-name)))
(let ((class (and (constantp class-form) (constant-form-value class-form)))
(slot-name (and (constantp slot-name-form)
(constant-form-value slot-name-form))))
(let ((class (and (constantp class-form) (constant-form-value class-form)))
(slot-name (and (constantp slot-name-form)
(constant-form-value slot-name-form))))
(standard-class-p class)
(not (eq class *the-class-t*)) ; shouldn't happen, though.
(let ((slotd (find-slot-definition class slot-name)))
(standard-class-p class)
(not (eq class *the-class-t*)) ; shouldn't happen, though.
(let ((slotd (find-slot-definition class slot-name)))
(let ((class (and (constantp class-form) (constant-form-value class-form)))
(slot-name (and (constantp slot-name-form)
(constant-form-value slot-name-form))))
(let ((class (and (constantp class-form) (constant-form-value class-form)))
(slot-name (and (constantp slot-name-form)
(constant-form-value slot-name-form))))
(standard-class-p class)
(not (eq class *the-class-t*)) ; shouldn't happen, though.
;; FIXME: Is this really right? "Don't skip if there is
(standard-class-p class)
(not (eq class *the-class-t*)) ; shouldn't happen, though.
;; FIXME: Is this really right? "Don't skip if there is
;; Quietly remove IGNORE declarations on
;; args when a next-method is involved, to
;; prevent compiler warnings about ignored
;; Quietly remove IGNORE declarations on
;; args when a next-method is involved, to
;; prevent compiler warnings about ignored
;; Given a valid lambda list, extract the parameter names.
(loop for x in lambda-list
with res = nil
;; Given a valid lambda list, extract the parameter names.
(loop for x in lambda-list
with res = nil