mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 14:01:07 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'inline-closure-global' into 'develop'

Browse source 
Fix compiler bug regarding inlining for global functions that are closures

See merge request embeddable-common-lisp/ecl!280
This commit is contained in:
Daniel Kochmański 2023-02-14 21:05:19 +00:00
commit feff551c31
4 changed files with 95 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

40
src/cmp/cmpenv-fun.lsp
View file

@ -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))))

20
src/cmp/cmppass1-call.lsp
View file

@ -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)

9
src/lsp/evalmacros.lsp
View file

@ -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)))
;;;

69
src/tests/normal-tests/compiler.lsp
View file

@ -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)))