diff --git a/src/cmp/cmpenv-fun.lsp b/src/cmp/cmpenv-fun.lsp index 679fa17db..054b2e57a 100644 --- a/src/cmp/cmpenv-fun.lsp +++ b/src/cmp/cmpenv-fun.lsp @@ -130,7 +130,8 @@ fname-list)) (cmp-env-extend-declaration 'INLINE (loop for name in fname-list - collect (cons name t)))) + collect (cons name t)) + env)) (defun declare-notinline (fname-list &optional (env *cmp-env*)) (unless (every #'si::valid-function-name-p fname-list) @@ -138,7 +139,8 @@ fname-list)) (cmp-env-extend-declaration 'INLINE (loop for name in fname-list - collect (cons name nil)))) + collect (cons name nil)) + env)) (defun inline-possible (fname &optional (env *cmp-env*)) (let* ((x (cmp-env-search-declaration 'inline env)) @@ -149,3 +151,12 @@ ;;(>= *debug* 2) Breaks compilation of STACK-PUSH-VALUES (sys:get-sysprop fname 'CMP-NOTINLINE)))))) +;;; Install inline expansion of function +(defun maybe-install-inline-function (fname form env) + (when (and (let* ((x (cmp-env-search-declaration 'inline env)) + (flag (assoc fname x :test #'same-fname-p))) + (and flag (cdr flag))) + (not (sys:get-sysprop fname 'CMP-NOTINLINE))) + (format t "~&;;; Storing inline form for ~a" fname) + `(eval-when (:compile-toplevel) + (si::put-sysprop ',fname 'inline ',form)))) diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp index 6cdb4ddc7..46a89c3a7 100644 --- a/src/cmp/cmpeval.lsp +++ b/src/cmp/cmpeval.lsp @@ -47,18 +47,18 @@ (defvar *c1t* (make-c1form* 'LOCATION :type (object-type t) :args t)) (defun c1t () *c1t*) -(defun c1call-symbol (fname args &aux fd success) +(defun c1call-symbol (fname args &aux fd success can-inline) (cond ((setq fd (gethash fname *c1-dispatch-table*)) (funcall fd args)) ((c1call-local fname args)) - ((and (setq fd (compiler-macro-function fname)) - (inline-possible fname) + ((and (setq can-inline (inline-possible fname)) + (setq fd (compiler-macro-function fname)) (progn (multiple-value-setq (fd success) (cmp-expand-compiler-macro fd fname args)) success)) (c1expr fd)) - ((and (inline-possible fname) + ((and can-inline (progn (multiple-value-setq (fd success) (clos-compiler-macro-expand fname args)) @@ -66,6 +66,11 @@ (c1expr fd)) ((setq fd (cmp-macro-function fname)) (c1expr (cmp-expand-macro fd (list* fname args)))) + ((and can-inline + (setf fd (si::get-sysprop fname 'inline)) + (<=(cmp-env-optimization 'space) 1)) + (format t "~&;;; Inlining ~a" fname) + (c1expr `(funcall ,fd ,@args))) (t (c1call-global fname args)))) (defun c1call-local (fname args) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index 3bf48da00..5ecc45c5e 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -358,5 +358,6 @@ be deleted if they have been opened with LoadLibrary.") (*values-type-primary-type-cache* (values-type-primary-type-empty-cache)) #+new-cmp (*values-type-to-n-types-cache* (values-type-to-n-types-empty-cache)) + (si::*defun-inline-hook* 'maybe-install-inline-function) ))