diff --git a/docs/cmu-user/extensions.tex b/docs/cmu-user/extensions.tex index 1755a178bd902cdfb3f0c0dbaa88f830548e9241..b653693ae228cc1849c3ee63e4ad2f3b90730448 100644 --- a/docs/cmu-user/extensions.tex +++ b/docs/cmu-user/extensions.tex @@ -2101,6 +2101,59 @@ itself, PCL will then print a warning that the method must be recompiled manually when classes are changed. + +\subsection{Inlineing Methods in Effective Methods} +\cindex{effective method} +\cpsubindex{methods}{inlineing in effective methods} +\cpsubindex{effective method}{inlineing of methods} +\cindex{inline} + +When a generic function is called, an effective method is constructed +from applicable methods. The effective method is called with the +original arguments, and itself calls applicable methods according to +the generic function's method combination. Some of the function call +overhead in effective methods can be removed by inlineing methods in +effective methods, at the expense of increased code size. + +Inlineing of methods is controlled by the usual \code{inline} +declaration. In the following example, both \code{foo} methods shown +will be inlined in effective methods: + +\begin{example} +(declaim (inline (method foo (foo)) + (method foo :before (foo)))) +(defmethod foo ((x foo)) ...) +(defmethod foo :before ((x foo)) ...) +\end{example} + +Please note that this form of inlineing has no noticeable effect for +effective methods that consist of a primary method only, which doesn't +have keyword arguments. In such cases, PCL uses the primary method +directly for the effective method. + +When the definition of an inlined method is changed, effective methods +are \textbf{not} automatically updated to reflect the change. This is +just as it is when inlineing normal functions. Different from the +normal case is that users do not have direct access to effective +methods, as it would be the case when a function is inlined somewhere +else. Because of this, the function \code{pcl:flush-emf-cache} is +provided for forcing such an update of effective methods. + +\begin{defun}{pcl:}{flush-emf-cache}{\&optional gf} + Flush cached effective method functions. If \code{gf} is supplied, + it should be a generic function metaobject or the name of a generic + function, and this function flushes all cached effective methods for + the given generic function. If \code{gf} is not supplied, all + cached effective methods are flushed. +\end{defun} + +\begin{defvar}{pcl::}{inline-methods-in-emfs} + If true, the default, perform method inlineing as described above. + If false, don't. +\end{defvar} + + + \subsection{Sealing} \cindex{sealing} \cpsubindex{sealing}{subclasses} diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index c071b51dc343f8c94cd15e58665859dd21bd7542..bc3b737790d726842db6c68e7bc20bd162e4a969 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -132,6 +132,8 @@ New in this release: in other implementations. - The declaration identifiers SLOTS, AUTO-COMPILE, NOT-AUTO-COMPILE have been moved from PCL to EXT. + - Support for inlineing methods in effective methods; see the + CMU User Manual. * Improvements to Hemlock, the Emacs-like editor: diff --git a/pcl/boot.lisp b/pcl/boot.lisp index c7b0e330140b0757d9267c9542f06de93a604a5e..1f1e872fb9c4715270318338cacea36d4429d440 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.61 2003/05/25 16:54:40 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.62 2003/05/28 10:41:47 gerd Exp $") (in-package :pcl) @@ -378,6 +378,9 @@ work during bootstrapping. (defvar *inline-access*) (defvar *method-source-info*) +(defvar *inline-methods-in-emfs* t + "If true, allow inlining of methods in effective methods.") + (defun expand-defmethod (name proto-gf proto-method qualifiers lambda-list body env) (let ((*inline-access* ())) @@ -402,12 +405,35 @@ work during bootstrapping. non-null lexical environment means that it cannot be ~ automatically recompiled.~@:>" name qualifiers lambda-list)) - (let ((initargs-form (make-method-initargs-form + (let* ((method-name `(method ,name ,@qualifiers ,specializers)) + (initargs-form (make-method-initargs-form proto-gf proto-method method-function-lambda initargs env))) (tell-compiler-about-gf name unspecialized-lambda-list) `(progn (proclaim-defgeneric ',name ',unspecialized-lambda-list) + ;; + ;; Set inlining information in the global enviroment + ;; for the fast function if there is an INLINE + ;; declaration for the method name, which is the name + ;; of the "slow" function. FIXME: Maybe the function + ;; names should be METHOD and SLOW-METHOD. + ,@(let ((inline (and *inline-methods-in-emfs* + (info function inlinep method-name)))) + (when inline + (let ((fast-name (cons 'fast-method (cdr method-name))) + (lambda (getf (cdr initargs-form) :fast-function))) + `((setf (info function inlinep ',fast-name) + ',inline + (info function inline-expansion ',fast-name) + ',lambda))))) + ;; + ;; This expands to a LOAD-DEFMETHOD with compiled or + ;; interpreted lambdas for the method functions. The + ;; LOAD-DEFMETHOD will construct the method metaobject + ;; with initargs from INITARGS-FORM etc. FIXME: We + ;; could as well produce DEFUNs here, now that we have + ;; generalized function names. ,(make-defmethod-form name qualifiers specializers unspecialized-lambda-list (if proto-method @@ -522,7 +548,7 @@ work during bootstrapping. (defmethod make-method-initargs-form ((proto-gf standard-generic-function) (proto-mothed standard-method) method-lambda initargs env) - (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) + (unless (eq (car-safe method-lambda) 'lambda) (error "The method-lambda argument to make-method-function, ~S,~ is not a lambda form" method-lambda)) (make-method-initargs-form-internal method-lambda initargs env)) diff --git a/pcl/combin.lisp b/pcl/combin.lisp index 01fd38b9f76ec48438e67958937bd05e6ec4c0d8..5a12fbd3be84223be2fb2b864c7f9b9946db3921 100644 --- a/pcl/combin.lisp +++ b/pcl/combin.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.16 2003/05/25 14:33:50 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.17 2003/05/28 10:41:47 gerd Exp $") (in-package "PCL") @@ -466,37 +466,129 @@ ,@check-applicable-keywords ,body)))))) +;;; +;;; Return a method function name of METHOD. If FAST-FUNCTION +;;; is true, return the fast method function name, otherwise +;;; return the slow method function name. +;;; +(defun method-function-name (method &optional (fast-function t)) + (let ((name (nth-value 2 (parse-method-or-spec method)))) + (if fast-function + (cons 'fast-method (cdr name)) + name))) + +;;; +;;; Return a form for calling METHOD's fast function. METATYPES is a +;;; list of metatypes, whose length is used to figure out the names of +;;; required emf parameters. APPLY? true means the method has a &rest +;;; arg. CALLABLE-VAR is the name of a closed-over variable +;;; containing a FAST-METHOD-CALL instance corresponding to the +;;; method invocation. +;;; +(defun make-direct-call (method metatypes rest? callable-var) + (let* ((fn-name (method-function-name method)) + (fn `(the function #',fn-name)) + (cell `(fast-method-call-pv-cell ,callable-var)) + (next `(fast-method-call-next-method-call ,callable-var)) + (req (dfun-arg-symbol-list metatypes))) + (assert (fboundp fn-name)) + `(funcall ,fn ,cell ,next ,@req ,@(when rest? `(.dfun-rest-arg.))))) + +;;; +;;; Return a form for successive calls to the fast functions of +;;; the methods in METHODS. LIST-VAR is the name of a +;;; variable containing a list of FAST-METHOD-CALL structures +;;; corresponding to the method function calls. +;;; +(defun make-direct-calls (methods metatypes apply? list-var) + (collect ((calls)) + (dolist (method methods) + (calls `(let ((.call. (pop .list.))) + ,(make-direct-call method metatypes apply? '.call.)))) + `(let ((.list. ,list-var)) + (declare (ignorable .list.)) + ,@(calls)))) + +;;; +;;; Return the list of methods from a CALL-METHOD-LIST form. +;;; +(defun call-method-list-methods (call-method-list) + (mapcar (lambda (call-method) (cadr call-method)) + (cdr call-method-list))) + +;;; +;;; Compute a key from FORM. This function is called via the +;;; GET-FUNCTION mechanism on forms of an emf lambda. Values returned +;;; that are not EQ to FORM are considered keys. All keys are +;;; collected and serve GET-FUNCTION as a key in its table of already +;;; computed functions. That is, if two emf lambdas produce the same +;;; key, a previously compiled function can be used. +;;; (defun memf-test-converter (form gf method-alist-p wrappers-p) (case (car-safe form) + ;; (call-method (case (get-method-call-type gf form method-alist-p wrappers-p) - (fast-method-call '.fast-call-method.) + (fast-method-call + (let ((method (cadr form))) + (if (and (eq *boot-state* 'complete) *inline-methods-in-emfs*) + (method-function-name method) + '.fast-call-method.))) (t '.call-method.))) + ;; (call-method-list (case (get-method-list-call-type gf form method-alist-p wrappers-p) - (fast-method-call '.fast-call-method-list.) + (fast-method-call + (if (and (eq *boot-state* 'complete) *inline-methods-in-emfs*) + (mapcar #'method-function-name (call-method-list-methods form)) + '.fast-call-method-list.)) (t '.call-method-list.))) + ;; (check-applicable-keywords 'check-applicable-keywords) (t (default-test-converter form)))) +;;; +;;; This function is called via the GET-FUNCTION mechanism on forms of +;;; an emf lambda. First value returned replaces FORM in the emf +;;; lambda. Second value is a list of variable names that become +;;; closure variables. +;;; (defun memf-code-converter (form gf metatypes applyp method-alist-p wrappers-p) (case (car-safe form) + ;; + ;; (CALL-METHOD <method-object> &optional <next-methods>) (call-method - (let ((gensym (gensym "MEMF"))) - (values (make-emf-call metatypes applyp gensym - (get-method-call-type gf form method-alist-p - wrappers-p)) - (list gensym)))) - (call-method-list - (let ((gensym (gensym "MEMF")) - (type (get-method-list-call-type gf form method-alist-p + (let ((method (cadr form)) + (callable-var (gensym)) + (call-type (get-method-call-type gf form method-alist-p wrappers-p))) - (values `(dolist (emf ,gensym nil) - ,(make-emf-call metatypes applyp 'emf type)) - (list gensym)))) + (if (and (eq call-type 'fast-method-call) + (eq *boot-state* 'complete) + *inline-methods-in-emfs*) + (values (make-direct-call method metatypes applyp callable-var) + (list callable-var)) + (values (make-emf-call metatypes applyp callable-var call-type) + (list callable-var))))) + ;; + ;; (CALL-METHOD-LIST <call-method-form>*) + ;; where each CALL-METHOD form is (CALL-METHOD <method>) + (call-method-list + (let ((list-var (gensym)) + (call-type (get-method-list-call-type gf form method-alist-p + wrappers-p))) + (if (and (eq call-type 'fast-method-call) + (eq *boot-state* 'complete) + *inline-methods-in-emfs*) + (let ((methods (call-method-list-methods form))) + (values (make-direct-calls methods metatypes applyp list-var) + (list list-var))) + (values `(dolist (.tem. ,list-var) + ,(make-emf-call metatypes applyp '.tem. call-type)) + (list list-var))))) + ;; (check-applicable-keywords (values `(check-applicable-keywords .dfun-rest-arg. .keyargs-start. .valid-keys.) @@ -576,24 +668,13 @@ (defun make-callable (gf methods generator method-alist wrappers) (let* ((*applicable-methods* methods) (callable (function-funcall generator method-alist wrappers))) - (set-emf-name gf methods callable))) - -;;; -;;; When *NAME-EMFS-P* is true, give the effective method represented -;;; by CALLABLE a suitable global name of the form (EFFECTIVE-METHOD -;;; ...). GF is the generic function the effective method is for, and -;;; METHODS is the list of applicable methods. -;;; -(defun set-emf-name (gf methods callable) - (when *named-emfs-p* - (let ((function (typecase callable - (fast-method-call (fast-method-call-function callable)) - (method-call (method-call-function callable)) - (t callable))) - (name (make-emf-name gf methods))) - (setf (fdefinition name) function) - (set-function-name function name))) - callable) + (when *named-emfs-p* + (let ((fn (etypecase callable + (fast-method-call (fast-method-call-function callable)) + (method-call (method-call-function callable)) + (function callable)))) + (setf (fdefinition (make-emf-name gf methods)) fn))) + callable)) ;;; ;;; Return a name for an effective method of generic function GF, diff --git a/pcl/fngen.lisp b/pcl/fngen.lisp index c8ac3be7cd78eb0c1daaad94130f6253b3fef898..7aadb29af55dc58729c5cbd7c85cb1f646cc70d3 100644 --- a/pcl/fngen.lisp +++ b/pcl/fngen.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fngen.lisp,v 1.11 2003/05/04 13:11:21 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fngen.lisp,v 1.12 2003/05/28 10:41:47 gerd Exp $") (in-package :pcl) @@ -206,3 +206,21 @@ (defun load-function-generator (test gensyms generator generator-lambda system) (store-fgen (make-fgen test gensyms generator generator-lambda system))) +(defun flush-emf-cache (&optional gf) + "Flush cached emf functions. If GF is supplied, it should be a + generic function metaobject or the name of a generic function, and + this function flushes all cached emfs for the given generic + function. If GF is not supplied, all cached emfs are flushed." + (let ((gf-name (if (generic-function-p gf-name) + (generic-function-name gf) + gf))) + (collect ((new)) + (dolist (f *fgens* (setq *fgens* (new))) + (when (notany (lambda (x) + (and (consp x) + (eq (car x) 'fast-method) + (or (null gf-name) + (equal gf-name (cadr x))))) + (fgen-test f)) + (new f)))))) + diff --git a/pcl/pkg.lisp b/pcl/pkg.lisp index f45b6c6ff65ac4cc208aea7038ae9c52502ad9f4..a1b0259625cd3c37628572bca8927a6a64f764e2 100644 --- a/pcl/pkg.lisp +++ b/pcl/pkg.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.26 2003/05/04 13:11:21 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.27 2003/05/28 10:41:47 gerd Exp $") ;;; ;;; CMUCL 18a: Jan-1998 -- Changing to DEFPACKAGE. @@ -97,6 +97,8 @@ ;; Function names. (:export "EFFECTIVE-METHOD" "FAST-METHOD" "SLOT-ACCESSOR" "CLASS-PREDICATE") + + (:export "FLUSH-EMF-CACHE") (:export "STANDARD-INSTANCE" "FUNCALLABLE-STANDARD-INSTANCE"