From fdcf5e7effe84202c2a030ab1d66fbb0d16e1fcc Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Fri, 7 Oct 2022 21:20:26 +0200 Subject: [PATCH] cmp: disable inlining for global functions that are closures For functions already compiled and loaded, we simply check if the definition is a closure. For functions defined in the same file, we don't store their definition in the compiler environment but instead use *global-funs*. The advantage is that this directly allows us to determine whether a function is a closure or not and we don't have to run the first compiler pass again each time we inline the function. This commit also fixes some minor issues with the inline policy, described in detail as follows: 1. The inline policy differed subtly between `proclaim` and `declaim`. If a file like (eval-when (:compile-toplevel) (proclaim '(inline f))) (defun f ...) was compiled (but not loaded), subsequent compilations would inline `f` but for (declaim (inline f)) (defun f ...) the function `f` would only get inlined if the file was compiled _and_ loaded. We now use the latter approach for both cases. Thus, calling `compile-file` without `load` has no side-effects regarding whether functions are inlined or not. 2. We did not distinguish between functions which were declared inline at a global versus local level such that e.g. in (locally (declare (inline f)) (defun f ...)) the function f would get inlined outside the scope of the `locally` form. This is changed now such that local inline declarations only apply to the scope in which they are made. 3. Inline declarations were made by expanding into statements like (eval-when (:compile-toplevel) (c::declare-inline ...)) during the macroexpansion of `defun`. However this only works if the `defun` appears at the toplevel and hence in code like (declaim (inline f)) (let (...) (defun f ...)) the function `f` could not get inlined later on in the same file. This is fixed now by calling the code which should run during compilation directly when macro expanding defun. --- src/cmp/cmpenv-fun.lsp | 40 ++++++++--------- src/cmp/cmppass1-call.lsp | 20 ++++++--- src/lsp/evalmacros.lsp | 9 ++-- src/tests/normal-tests/compiler.lsp | 69 ++++++++++++++++++++++++----- 4 files changed, 95 insertions(+), 43 deletions(-) diff --git a/src/cmp/cmpenv-fun.lsp b/src/cmp/cmpenv-fun.lsp index 681602d60..479d31ab9 100644 --- a/src/cmp/cmpenv-fun.lsp +++ b/src/cmp/cmpenv-fun.lsp @@ -11,7 +11,7 @@ ;;;; ;;;; See file '../Copyright' for full details. ;;;; -;;;; CMPTYPE-PROP -- Type propagation basic routines and database +;;;; CMPENV-FUN -- Declarations concerning function types and inlining ;;;; (in-package "COMPILER") @@ -159,25 +159,21 @@ (defun inline-possible (fname &optional (env *cmp-env*)) (not (declared-notinline-p fname env))) -;;; Install inline expansion of function. If the function is -;;; PROCLAIMED inline, then we keep a copy of the definition as a -;;; symbol property. If the function is DECLAIMED inline, then we keep -;;; the definition in the compiler environment during compilation and -;;; install it as a symbol property during loading of the compiled -;;; file. -(defun maybe-install-inline-function (fname form env) - (let* ((x (cmp-env-search-declaration 'inline env)) - (flag (assoc fname x :test #'same-fname-p)) - (declared (and flag (cdr flag))) - (proclaimed (sys:get-sysprop fname 'inline))) - `(progn - ,(when declared - `(progn - (eval-when (:compile-toplevel) - (c::declare-inline ',fname *cmp-env-root* ',form)) - (eval-when (:load-toplevel :execute) - (si:put-sysprop ',fname 'inline ',form)))) - ,(when proclaimed - `(eval-when (:compile-toplevel :load-toplevel :execute) - (si:put-sysprop ',fname 'inline ',form)))))) +;;; Install inline expansion of function. +(defun maybe-install-inline-function (fname form) + (when (declared-inline-p fname *cmp-env-root*) + ;; The function was already PROCLAIMED inline and might be + ;; redefined in the file we are currently compiling. Declare it as + ;; inline in the compiler environment and remove the symbol + ;; property so that if we can't inline the new definition (e.g. + ;; because it is a closure) we don't accidentally inline an old + ;; definition from the symbol property. + (declare-inline fname *cmp-env-root*) + (si:rem-sysprop fname 'inline) + ;; If the function is PROCLAIMED or DECLAIMED inline, then we + ;; install the definition as a symbol property during loading of + ;; the compiled file. If the function was only DECLARED inline + ;; locally we don't keep the definition. + `(eval-when (:load-toplevel :execute) + (si:put-sysprop ',fname 'inline ',form)))) diff --git a/src/cmp/cmppass1-call.lsp b/src/cmp/cmppass1-call.lsp index 85f618868..6685d633b 100644 --- a/src/cmp/cmppass1-call.lsp +++ b/src/cmp/cmppass1-call.lsp @@ -116,6 +116,10 @@ (t (default-apply fun arguments)))))) +(defun not-a-closure-p (fname) + (declare (si::c-local)) + (not (and (fboundp fname) (nth-value 1 (function-lambda-expression (fdefinition fname)))))) + (defun c1call (fname args macros-allowed &aux fd success can-inline) (cond ((> (length args) si::c-arguments-limit) (if (and macros-allowed @@ -147,13 +151,19 @@ (setq fd (macro-function fname))) (cmp-expand-macro fd (list* fname args))) ((and (setq can-inline (declared-inline-p fname)) - (consp can-inline) - (eq (first can-inline) 'function) (plusp *inline-max-depth*) (<= (cmp-env-optimization 'space) 1)) - (let ((*inline-max-depth* (1- *inline-max-depth*))) - (cmpnote "Inlining ~a" fname) - `(funcall ,can-inline ,@args))) + (cond ((and (setq fd (find fname *global-funs* :key #'fun-name :test #'same-fname-p)) + (not (fun-closure fd))) + (cmpnote "Inlining ~a" fname) + (inline-local (fun-lambda-expression fd) fd args)) + ((and (consp can-inline) + (not-a-closure-p fname) + (eq (first can-inline) 'function)) + (let ((*inline-max-depth* (1- *inline-max-depth*))) + (cmpnote "Inlining ~a" fname) + `(funcall ,can-inline ,@args))) + (t (c1call-global fname args)))) (t (c1call-global fname args)))) (defun inline-local (lambda fun args) diff --git a/src/lsp/evalmacros.lsp b/src/lsp/evalmacros.lsp index d01350ff1..d66315c31 100644 --- a/src/lsp/evalmacros.lsp +++ b/src/lsp/evalmacros.lsp @@ -90,18 +90,17 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)." ',var)) (defparameter *defun-inline-hook* - #'(lambda (fname form env) + #'(lambda (fname form) ;; To prevent inlining of stale function definitions by the native ;; compiler after a new definition has been established by the ;; bytecodes compiler, we save function definitions in the global ;; environment when the function has been proclaimed inline. - (declare (ignore env)) (let ((proclaimed (si:get-sysprop fname 'inline))) (when proclaimed - `(eval-when (:compile-toplevel :load-toplevel :execute) + `(eval-when (:load-toplevel :execute) (si:put-sysprop ',fname 'inline ',form)))))) -(defmacro defun (&whole whole name vl &body body &environment env &aux doc-string) +(defmacro defun (&whole whole name vl &body body &aux doc-string) ;; Documentation in help.lsp (multiple-value-setq (body doc-string) (remove-documentation body)) (let* ((function `#'(ext::lambda-block ,name ,vl ,@body)) @@ -115,7 +114,7 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)." ,(ext:register-with-pde whole `(si::fset ',name ,global-function)) ,@(si::expand-set-documentation name 'function doc-string) ,(let ((hook *defun-inline-hook*)) - (and hook (funcall hook name global-function env))) + (and hook (funcall hook name global-function))) ',name))) ;;; diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index 07918293f..c73211e2d 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -1874,24 +1874,48 @@ ;; global function in same file, declaimed inline (load (with-compiler ("inline-closure.lsp") '(in-package #:cl-test) - '(declaim (inline set-b.0079 get-b.0079)) + '(declaim (inline set-b.0079a get-b.0079a)) '(let ((b 123)) - (defun set-b.0079 (x) - (setf b x)) - (defun get-b.0079 () b)) - '(defun foo.0079 () + (defun set-b.0079a (x) + (setf b x)) + (defun get-b.0079a () b)) + '(defun foo.0079a () (let (results) - (push (get-b.0079) results) + (push (get-b.0079a) results) (let ((b 345)) - (push (get-b.0079) results) + (push (get-b.0079a) results) (push b results) - (set-b.0079 0) - (push (get-b.0079) results) + (set-b.0079a 0) + (push (get-b.0079a) results) (push b results)) - (push (get-b.0079) results) + (push (get-b.0079a) results) (nreverse results))))) (is (equal - (funcall 'foo.0079) + (funcall 'foo.0079a) + '(123 123 345 0 345 0))) + ;; global function in different file, proclaimed inline + (proclaim '(inline set-b.0079b get-b.0079b)) + (load (with-compiler ("inline-closure-1.lsp") + '(in-package #:cl-test) + '(let ((b 123)) + (defun set-b.0079b (x) + (setf b x)) + (defun get-b.0079b () b)))) + (load (with-compiler ("inline-closure-2.lsp") + '(in-package #:cl-test) + '(defun foo.0079b () + (let (results) + (push (get-b.0079b) results) + (let ((b 345)) + (push (get-b.0079b) results) + (push b results) + (set-b.0079b 0) + (push (get-b.0079b) results) + (push b results)) + (push (get-b.0079b) results) + (nreverse results))))) + (is (equal + (funcall 'foo.0079b) '(123 123 345 0 345 0)))) ;;; Date 2020-05-08 @@ -2112,3 +2136,26 @@ '(eq '#7=((#7# . a) . b) '#8=((#8# . a) . b)) '(eq '#9=((a . #9#) . b) '#10=((a . #10#) . b)) '(eq '#11=(#11# . #11#) '#12=(#12# . #12#))))) + +;;; Date 2022-12-30 +;;; Description +;;; +;;; Check that function redefinitions for functions which are +;;; declared as inline are picked up correctly even if we can't +;;; inline the new definition (e.g. because it is a closure). +;;; +(test cmp.0092.inline-redefinition + (setf (compiler-macro-function 'foo) nil) + (finishes (with-compiler ("inline-redefinition-1.lsp" :load t) + '(declaim (inline foo)) + '(defun foo () 1) + '(defun bar () (foo)))) + (is (eql (bar) 1)) + (finishes (with-compiler ("inline-redefinition-2.lsp" :load t) + '(let ((a 2)) + (defun ensure-compiler-cannot-optimize-away-the-let-statement (x) + (setf a x)) + (defun foo () + a)) + '(defun bar () (foo)))) + (is (eql (bar) 2)))