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

New functions DECLARED-{INLINE,NOTINLINE}-P introduce some clarity in the inline process.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-12-18 18:49:27 +01:00
parent d4f3d0d330
commit 3e1fcb7a2c
2 changed files with 21 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -156,25 +156,22 @@
(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
(defun declared-inline-p (fname &optional (env *cmp-env*))
(let* ((x (cmp-env-search-declaration 'inline env))
(flag (assoc fname x :test #'same-fname-p)))
(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))))
(if flag
(cdr flag)
(sys:get-sysprop fname 'INLINE))))
(defun declared-notinline-p (fname &optional (env *cmp-env*))
(let* ((x (cmp-env-search-declaration 'inline env))
(flag (assoc fname x :test #'same-fname-p)))
(if flag
(null (cdr flag))
(sys:get-sysprop fname 'NOTINLINE))))
(defun inline-possible (fname &optional (env *cmp-env*))
(not (declared-notinline-p fname env)))
;;; Install inline expansion of function. If the function is DECLAIMED
;;; inline, then we only keep the definition in the compiler environment.

10
src/cmp/cmpeval.lsp
View file

@ -66,7 +66,7 @@
(c1expr fd))
((setq fd (cmp-macro-function fname))
(c1expr (cmp-expand-macro fd (list* fname args))))
((and can-inline
((and (setq can-inline (declared-inline-p fname))
(consp can-inline)
(eq (first can-inline) 'function)
(<= (cmp-env-optimization 'space) 1))
@ -83,8 +83,12 @@
(when (> (length args) si::c-arguments-limit)
(return-from c1call-local (unoptimized-long-call `#',fname args)))
(let ((lambda (fun-lambda-expression fun)))
(when (and lambda (inline-possible fname))
(return-from c1call-local (c1expr `(funcall #',lambda ,@args)))))
(when (and lambda (declared-inline-p fname))
(when (member fname *inlined-functions* :test #'eq)
(cmperr "Recursive function ~A declared inline." fname))
(return-from c1call-local
(let ((*inlined-functions* (cons fname *inlined-functions*)))
(c1expr `(funcall #',lambda ,@args))))))
(let* ((forms (c1args* args))
(return-type (or (get-local-return-type fun) 'T))
(arg-types (get-local-arg-types fun)))