(when (and (null *precompiling-lap*) *emit-function-p*)
(return-from emit-default-only
(emit-default-only-function metatypes applyp))))
- (let* ((dlap-lambda-list (make-dlap-lambda-list metatypes applyp))
- (args (remove '&rest dlap-lambda-list))
- (restl (when applyp '(.lap-rest-arg.))))
+ (multiple-value-bind (lambda-list args rest-arg more-arg)
+ (make-dlap-lambda-list metatypes applyp)
(generating-lisp '(emf)
- dlap-lambda-list
+ lambda-list
`(invoke-effective-method-function emf
,applyp
- ,@args
- ,@restl))))
+ :required-args ,args
+ :more-arg ,more-arg
+ :rest-arg ,rest-arg))))
;;; --------------------------------
(defun generating-lisp (closure-variables args form)
- (let* ((rest (memq '&rest args))
- (ldiff (and rest (ldiff args rest)))
- (args (if rest (append ldiff '(&rest .lap-rest-arg.)) args))
- (lambda `(lambda ,closure-variables
- ,@(when (member 'miss-fn closure-variables)
- `((declare (type function miss-fn))))
- #'(instance-lambda ,args
- (let ()
- (declare #.*optimize-speed*)
- ,form)))))
+ (let ((lambda `(lambda ,closure-variables
+ ,@(when (member 'miss-fn closure-variables)
+ `((declare (type function miss-fn))))
+ #'(lambda ,args
+ (let ()
+ (declare #.*optimize-speed*)
+ ,form)))))
(values (if *precompiling-lap*
`#',lambda
(compile nil lambda))
(fsc-instance-wrapper ,instance)))))
(block access
(when (and wrapper
- (/= (wrapper-cache-number-vector-ref wrapper ,field) 0)
+ (/= (layout-clos-hash wrapper ,field) 0)
,@(if (eql 1 1-or-2-class)
`((eq wrapper wrapper-0))
`((or (eq wrapper wrapper-0)
cached-index-p
class-slot-p))))
-(defun emit-miss (miss-fn args &optional applyp)
- (let ((restl (when applyp '(.lap-rest-arg.))))
- (if restl
- `(apply ,miss-fn ,@args ,@restl)
- `(funcall ,miss-fn ,@args ,@restl))))
+(defun emit-miss (miss-fn args applyp)
+ (if applyp
+ `(multiple-value-call ,miss-fn ,@args
+ (sb-c::%more-arg-values .more-context.
+ 0
+ .more-count.))
+ `(funcall ,miss-fn ,@args)))
(defun emit-checking-or-caching (cached-emf-p return-value-p metatypes applyp)
(unless *optimize-cache-functions-p*
(return-from emit-checking-or-caching
(emit-checking-or-caching-function
cached-emf-p return-value-p metatypes applyp))))
- (let* ((dlap-lambda-list (make-dlap-lambda-list metatypes applyp))
- (args (remove '&rest dlap-lambda-list))
- (restl (when applyp '(.lap-rest-arg.))))
+ (multiple-value-bind (lambda-list args rest-arg more-arg)
+ (make-dlap-lambda-list metatypes applyp)
(generating-lisp
`(cache ,@(unless cached-emf-p '(emf)) miss-fn)
- dlap-lambda-list
+ lambda-list
`(let (,@(when cached-emf-p '(emf)))
,(emit-dlap args
metatypes
(if return-value-p
(if cached-emf-p 'emf t)
`(invoke-effective-method-function
- emf ,applyp ,@args ,@restl))
+ emf ,applyp
+ :required-args ,args
+ :more-arg ,more-arg
+ :rest-arg ,rest-arg))
(emit-miss 'miss-fn args applyp)
(when cached-emf-p 'emf))))))
(go ,miss-label)))))))
(defun emit-1-wrapper-compute-primary-cache-location (wrapper miss-label)
- `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref ,wrapper field)))
+ `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field)))
(declare (fixnum wrapper-cache-no))
(when (zerop wrapper-cache-no) (go ,miss-label))
,(let ((form `(logand mask wrapper-cache-no)))
,@(let ((adds 0) (len (length wrappers)))
(declare (fixnum adds len))
(mapcar (lambda (wrapper)
- `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref
- ,wrapper field)))
+ `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field)))
(declare (fixnum wrapper-cache-no))
(when (zerop wrapper-cache-no) (go ,miss-label))
(setq primary (the fixnum (+ primary wrapper-cache-no)))
(go ,miss-label))))
(class
(when slot (error "can't do a slot reg for this metatype"))
- `(wrapper-of-macro ,argument))
+ `(wrapper-of ,argument))
((built-in-instance structure-instance)
(when slot (error "can't do a slot reg for this metatype"))
`(built-in-or-structure-wrapper