diff --git a/src/cmp/cmpenv-fun.lsp b/src/cmp/cmpenv-fun.lsp index 543002508..abb5f0ed8 100644 --- a/src/cmp/cmpenv-fun.lsp +++ b/src/cmp/cmpenv-fun.lsp @@ -142,21 +142,50 @@ collect (cons name nil)) env)) +(defun proclaim-inline (fname) + (dolist (fun fname-list) + (unless (si::valid-function-name-p fun) + (error "Not a valid function name ~s in INLINE proclamation" fun)) + (sys:put-sysprop fun 'INLINE t) + (sys:rem-sysprop fun 'NOTINLINE))) + +(defun proclaim-notinline (fname-list) + (dolist (fun fname-list) + (unless (si::valid-function-name-p fun) + (error "Not a valid function name ~s in NOTINLINE proclamation" fun)) + (sys:rem-sysprop fun 'INLINE) + (sys:put-sysprop fun 'NOTINLINE t))) + (defun inline-possible (fname &optional (env *cmp-env*)) + ;; This function determines whether FNAME can be inlined in one + ;; of various forms: via compiler macros, via inline functions, + ;; via C code, etc. + ;; + ;; First investigate the compiler environment looking for an INLINE + ;; declaration or DECLAIM field (let* ((x (cmp-env-search-declaration 'inline env)) (flag (assoc fname x :test #'same-fname-p))) - (if flag - (cdr flag) - (not (or ;; (compiler-= *debug* 2) Breaks compilation of STACK-PUSH-VALUES - (sys:get-sysprop fname 'CMP-NOTINLINE)))))) + (cond (flag + (cdr flag)) + ;; Then look up the global environment for some NOTINLINE + ;; declaration. + ((sys:get-sysprop fname 'NOTINLINE) + nil) + ;; Finally, return any possible INLINE expansion + ((sys:get-sysprop fname 'INLINE)) + ;; or default to T + (t)))) -;;; Install inline expansion of function +;;; Install inline expansion of function. If the function is DECLAIMED +;;; inline, then we only keep the definition in the compiler environment. +;;; If the function is PROCLAIMED inline, then we also keep a copy as +;;; a symbol property. (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))) - (cmpnote "~&;;; Storing inline form for ~a" fname) - `(eval-when (:compile-toplevel) - (si::put-sysprop ',fname 'inline ',form)))) + (let* ((x (cmp-env-search-declaration 'inline env)) + (flag (assoc fname x :test #'same-fname-p))) + (when (and flag (cdr flag)) + (rplacd flag form)) + (when (sys:get-sysprop fname 'inline) + (cmpnote "Storing inline form for ~a" fname) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (si::put-sysprop ',fname 'inline ',form))))) diff --git a/src/cmp/cmpenv-proclaim.lsp b/src/cmp/cmpenv-proclaim.lsp index 4630ca3ee..45efe5bef 100644 --- a/src/cmp/cmpenv-proclaim.lsp +++ b/src/cmp/cmpenv-proclaim.lsp @@ -63,15 +63,9 @@ (error "In an FTYPE proclamation, found ~A which is not a function type." (second decl)))))) (INLINE - (dolist (fun (cdr decl)) - (if (si::valid-function-name-p fun) - (rem-sysprop fun 'CMP-NOTINLINE) - (error "Not a valid function name ~s in proclamation ~s" fun decl)))) + (proclaim-inline (cdr decl))) (NOTINLINE - (dolist (fun (cdr decl)) - (if (si::valid-function-name-p fun) - (put-sysprop fun 'CMP-NOTINLINE t) - (error "Not a valid function name ~s in proclamation ~s" fun decl)))) + (proclaim-notinline (cdr decl))) ((OBJECT IGNORE DYNAMIC-EXTENT IGNORABLE) ;; FIXME! IGNORED! (dolist (var (cdr decl)) diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp index 40b66074b..8f16ba487 100644 --- a/src/cmp/cmpeval.lsp +++ b/src/cmp/cmpeval.lsp @@ -67,10 +67,11 @@ ((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)) - (cmpnote "~&;;; Inlining ~a" fname) - (c1expr `(funcall ,fd ,@args))) + (consp can-inline) + (eq (first can-inline) 'function) + (<= (cmp-env-optimization 'space) 1)) + (cmpnote "Inlining ~a" fname) + (c1expr `(funcall ,can-inline ,@args))) (t (c1call-global fname args)))) (defun c1call-local (fname args) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index 5ecc45c5e..18abf0e20 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -59,7 +59,7 @@ progress. The default value is T.") "This alternative list of features contains keywords that were gathered from running the compiler. It may be updated by running ") -(defvar *suppress-compiler-messages* 'compiler-note +(defvar *suppress-compiler-messages* #+ecl-min nil #-ecl-min 'compiler-note "A type denoting which compiler messages and conditions are _not_ displayed.") (defvar *suppress-compiler-notes* nil) ; Deprecated