;; System lock because interrupts need to be disabled as
;; well: it would be bad to unwind and leave the gf in an
;; inconsistent state.
- (sb-thread::with-recursive-system-spinlock (lock)
+ (sb-thread::with-recursive-system-lock (lock)
(let ((existing (get-method generic-function
qualifiers
specializers
(warn "~@<Invalid qualifiers for ~S method combination ~
in method ~S:~2I~_~S.~@:>"
mc-name method qualifiers))))))
-
(unless skip-dfun-update-p
(update-ctors 'add-method
:generic-function generic-function
;; System lock because interrupts need to be disabled as well:
;; it would be bad to unwind and leave the gf in an inconsistent
;; state.
- (sb-thread::with-recursive-system-spinlock (lock)
+ (sb-thread::with-recursive-system-lock (lock)
(let* ((specializers (method-specializers method))
(methods (generic-function-methods generic-function))
(new-methods (remove method methods)))
(remove-duplicates
(nconc
(mapcan #'function-keywords methods)
- (mapcar #'keywordicate gf.keys))))))
+ (mapcar #'keyword-spec-name gf.keys))))))
(when all-keys
(setq keysp t)
`(&key ,@all-keys))))
(make-dfun-lambda-list nargs applyp)
(make-fast-method-call-lambda-list nargs applyp))))
(multiple-value-bind (cfunction constants)
- (get-fun1 `(lambda
+ (get-fun1 `(named-lambda (gf-dispatch ,name)
,arglist
,@(unless function-p
`((declare (ignore .pv. .next-method-call.))))
(defun slot-value-using-class-dfun (class object slotd)
(declare (ignore class))
- (function-funcall (slot-definition-reader-function slotd) object))
+ (funcall (slot-info-reader (slot-definition-info slotd)) object))
(defun setf-slot-value-using-class-dfun (new-value class object slotd)
(declare (ignore class))
- (function-funcall (slot-definition-writer-function slotd) new-value object))
+ (funcall (slot-info-writer (slot-definition-info slotd)) new-value object))
(defun slot-boundp-using-class-dfun (class object slotd)
(declare (ignore class))
- (function-funcall (slot-definition-boundp-function slotd) object))
+ (funcall (slot-info-boundp (slot-definition-info slotd)) object))
(defun special-case-for-compute-discriminating-function-p (gf)
(or (eq gf #'slot-value-using-class)
;; PARSE-LAMBDA-LIST to something handier.
(multiple-value-bind (required optional restp rest keyp keys allowp
auxp aux morep more-context more-count)
- (parse-lambda-list lambda-list)
+ (parse-lambda-list lambda-list :silent t)
(declare (ignore restp keyp auxp aux morep))
(declare (ignore more-context more-count))
(values required optional rest keys allowp)))