(%intern-pv-table (mapcar #'intern-slot-names slot-name-lists)))))
\f
(defun optimize-slot-value-by-class-p (class slot-name type)
- (or (not (eq *boot-state* 'complete))
+ (or (not (eq **boot-state** 'complete))
(let ((slotd (find-slot-definition class slot-name)))
(and slotd
(slot-accessor-std-p slotd type)))))
parameter-or-nil
env)))
(class (find-class class-name nil)))
- (when (or (not (eq *boot-state* 'complete))
+ (when (or (not (eq **boot-state** 'complete))
(and class (not (class-finalized-p class))))
(setq class nil))
(when (and class-name (not (eq class-name t)))
new-value &optional safep)
(let ((class (if (consp sparameter) (cdr sparameter) *the-class-t*))
(parameter (if (consp sparameter) (car sparameter) sparameter)))
- (if (and (eq *boot-state* 'complete)
+ (if (and (eq **boot-state** 'complete)
(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))))
- (and (eq *boot-state* 'complete)
+ (and (eq **boot-state** 'complete)
(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))))
- (and (eq *boot-state* 'complete)
+ (and (eq **boot-state** 'complete)
(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
(declare ,(make-pv-type-declaration '.pv.))
,@forms)))
-(defun split-declarations (body args maybe-reads-params-p)
+(defun split-declarations (body args req-args cnm-p parameters-setqd)
(let ((inner-decls nil)
(outer-decls nil)
decl)
;; args when a next-method is involved, to
;; prevent compiler warnings about ignored
;; args being read.
- (unless (and (eq 'ignore name) maybe-reads-params-p)
+ (unless (and (eq 'ignore name) (member var req-args :test #'eq) (or cnm-p (member var parameters-setqd)))
(push var outers))
(push var inners)))
(when outers
(outer-parameters req-args)
;; The lambda-list used by BIND-ARGS
(bind-list lambda-list)
- (setq-p (getf (cdr lmf-params) :setq-p))
+ (parameters-setqd (getf (cdr lmf-params) :parameters-setqd))
(auxp (member '&aux bind-list))
(call-next-method-p (getf (cdr lmf-params) :call-next-method-p)))
;; Try to use the normal function call machinery instead of BIND-ARGS
bind-list req-args))
(multiple-value-bind (outer-decls inner-decls body-sans-decls)
(split-declarations
- body outer-parameters (or call-next-method-p setq-p))
+ body outer-parameters req-args call-next-method-p parameters-setqd)
(let* ((rest-arg (when restp
'.rest-arg.))
(fmf-lambda-list (if rest-arg