[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

optimizations for CALL-NEXT-METHOD

CALL-NEXT-METHOD is currently implemented with FLET.  The locally
defined function refers lexically to the next method to be executed
and to the list of remaining methods.  This must be done to allow for
methods which take advantage of CALL-NEXT-METHOD's indefinite extent,
e.g. by returning #'CALL-NEXT-METHOD.  Thus in some unusual cases a
closure must actually be created.  Unfortunately some compilers (e.g.
Franz 3.1 & Lucid's development compiler) do not optimize the common
case where a closure need not be created.

For those who prefer code to prose: PCL wraps method bodies which
refer to CALL-NEXT-METHOD with code that looks something like:

(lambda (#:arg1 #:arg2)
  (let ((.next-method. (car *next-methods*))
	(.next-methods. (cdr *next-method*)))
    (flet ((call-next-method ()
	     (if .next-method.
		 (let ((*next-methods* .next-methods.))
		   (funcall .next-method. #:arg1 #:arg2))
		 (error "No next method."))))
      (let ((arg1 #:arg1)
	    (arg2 #:arg2))
	... body containing (CALL-NEXT-METHOD) ...))))

With many compilers every call to this method results in the creation
of closures (over #:arg1 and #:arg2, and over .next-method.  and
.next-methods.).  Not only is this slow, it's also consy.  Until these
compilers get smarter one can use the patch below, which has PCL
perform the optimization for a few common cases.

The trick is to use MACROLET in place of FLET when feasable.  This
renders the above fragment as:

(lambda (#:arg1 #:arg2)
  (let ((.next-method. (car *next-methods*))
	(.next-methods. (cdr *next-methods*)))
    (macrolet ((call-next-method ()
		 '(if .next-method.
		      (let ((*next-methods* .next-methods.))
			(funcall .next-method. #:arg1 #:arg2))
		      (error "No next method."))))
      (let ((arg1 #:arg1)
	    (arg2 #:arg2))
	... body containing (CALL-NEXT-METHOD) ...))))

I've tested this with May Day PCL and achieved an 8x speedup in Franz
Allegro 3.1.13 for a CALL-NEXT-METHOD benchmark.  If I don't recieve
any complaints about this I'll merge it into the PCL sources on
arisia.xerox.com.  It implements the above optimization for methods
without any optional arguments which call CALL-NEXT-METHOD with or
without arguments.

There are intermediate cases which could be optimized and are still
not, e.g. when a method body contains both (CALL-NEXT-METHOD) and
#'CALL-NEXT-METHOD, or when #'CALL-NEXT-METHOD has only dynamic
extent, as in the case where it's the first arg to MAPCAR.

The only disadvantage is that the code size of methods which invoke
CALL-NEXT-METHOD in more than one place may grow somewhat.

(Xerox users: This patch has been installed in /import/pcl/next.)

All the changes are confined to boot.lisp:
> 	     (closurep nil)		;flag indicating that #'call-next-method
> 					;was seen in the body of a method
< 			(setq save-original-args (not (cdr form)))
> 			(unless (cdr form)
> 			  (setq save-original-args t))
> 				    (setq closurep t)
> 				    (setq closurep t)
< 				next-method-p-p)
> 				next-method-p-p
> 				closurep)
< 					       next-method-p-p)
<   (cond ((and (null save-original-args)
> 					       next-method-p-p
> 					       closurep)
>   (cond ((and (null closurep)
> 	      (null applyp)
> 	      (null save-original-args))
> 	 ;; OK to use MACROLET, CALL-NEXT-METHOD is always passed some args, and
> 	 ;; all args are mandatory (else APPLYP would be true).
> 	 `(lambda ,lambda-list
> 	    ,@walked-declarations
> 	    (let ((.next-method. (car *next-methods*))
> 		  (.next-methods. (cdr *next-methods*)))
> 	      (macrolet ((call-next-method ,lambda-list
> 			   '(if .next-method.
> 				(let ((*next-methods* .next-methods.))
> 				  (funcall .next-method. ,@lambda-list))
> 				(error "No next method.")))
> 			 (next-method-p () `(not (null .next-method.))))
> 		,@walked-lambda-body))))
> 	((and (null closurep)
> 	      (null applyp)
> 	      save-original-args)
> 	 ;; OK to use MACROLET.  CALL-NEXT-METHOD is sometimes called in the
> 	 ;; body with zero args, so we have to save the original args.
> 	 (if save-original-args
> 	     ;; CALL-NEXT-METHOD is sometimes called with no args
> 	     `(lambda ,original-args
> 		(let ((.next-method. (car *next-methods*))
> 		      (.next-methods. (cdr *next-methods*)))
> 		  (macrolet ((call-next-method (&rest cnm-args)
> 			       `(if .next-method.
> 				    (let ((*next-methods* .next-methods.))
> 				      (funcall .next-method.
> 					       ,@(if cnm-args cnm-args ',original-args)))
> 				    (error "No next method.")))
> 			     (next-method-p () `(not (null .next-method.))))
> 		    (let* (,@(mapcar #'list lambda-list original-args)
> 			     ,@aux-bindings)
> 		      ,@walked-declarations
> 		      ,@walked-lambda-body))))))
> 	((and (null save-original-args)