[armedbear-cvs] r12411 - trunk/abcl/src/org/armedbear/lisp

[Alessio Stalla]

Author: astalla
Date: Sun Jan 31 15:13:07 2010
New Revision: 12411

Log:
Lambda call inlining: fixed nasty bug that made the compiler go into
infinite recursion when compiling an invalid lambda call.


Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Sun Jan 31 15:13:07 2010
@@ -1238,8 +1238,8 @@
 		   (declare (ignorable , at ignorables))
 		   , at body)))
 	  (lambda-list-mismatch (x)
-	    (warn "Invalid function call: ~S (mismatch type: ~A)"
-		  form (lambda-list-mismatch-type x))
+	    (compiler-warn "Invalid function call: ~S (mismatch type: ~A)"
+			   form (lambda-list-mismatch-type x))
 	    form))
 	(if (unsafe-p args)
 	    (let ((arg1 (car args)))
@@ -1302,6 +1302,10 @@
              (setf (compiland-%single-valued-p *current-compiland*) nil)))))
   (p1-default form))
 
+(defun %funcall (fn &rest args)
+  "Dummy FUNCALL wrapper to force p1 not to optimize the call."
+  (apply fn args))
+
 (defknown p1 (t) t)
 (defun p1 (form)
   (cond ((symbolp form)
@@ -1369,7 +1373,10 @@
                         (t
                          (p1-function-call form))))
                  ((and (consp op) (eq (%car op) 'LAMBDA))
-                  (p1 (rewrite-function-call form)))
+		  (let ((maybe-optimized-call (rewrite-function-call form)))
+		    (if (eq maybe-optimized-call form)
+			(p1 `(%funcall (function ,op) ,@(cdr form)))
+			(p1 maybe-optimized-call))))
                  (t
                   form))))))