From 3e1fcb7a2c50d6137f5ab06ebbba3df9c59fb76e Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sun, 18 Dec 2011 18:49:27 +0100
Subject: [PATCH] New functions DECLARED-{INLINE,NOTINLINE}-P introduce some
 clarity in the inline process.

---
 src/cmp/cmpenv-fun.lsp | 31 ++++++++++++++-----------------
 src/cmp/cmpeval.lsp    | 10 +++++++---
 2 files changed, 21 insertions(+), 20 deletions(-)

diff --git a/src/cmp/cmpenv-fun.lsp b/src/cmp/cmpenv-fun.lsp
index abb5f0ed8..49453357f 100644
--- a/src/cmp/cmpenv-fun.lsp
+++ b/src/cmp/cmpenv-fun.lsp
@@ -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.
diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp
index 90c48163f..f53d581cd 100644
--- a/src/cmp/cmpeval.lsp
+++ b/src/cmp/cmpeval.lsp
@@ -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)))