From f9336e9b3711794feba99b88faadc82ef8cac7f3 Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Sun, 27 Apr 2003 05:50:40 +0000
Subject: [PATCH] 0.pre8.111:         * fast version of CONSTANT-FOLD-CALL
 flushes dead combination.

---
 src/compiler/ir1opt.lisp  |    8 +++-----
 src/compiler/ir1util.lisp |    9 +++++++++
 version.lisp-expr         |    2 +-
 3 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 2ffc385..d91e2ca 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -520,10 +520,7 @@
                                                   :lossage-fun nil
                                                   :unwinnage-fun nil))
                               (ir1-attributep attr unsafely-flushable)))
-		 (flush-dest (combination-fun node))
-		 (dolist (arg (combination-args node))
-		   (flush-dest arg))
-		 (unlink-node node))))))
+                 (flush-combination node))))))
 	(mv-combination
 	 (when (eq (basic-combination-kind node) :local)
 	   (let ((fun (combination-lambda node)))
@@ -1272,7 +1269,8 @@
                  (setf (continuation-next cont) next)
                  ;; FIXME: type checking?
                  (reoptimize-continuation cont)
-                 (reoptimize-continuation prev))))
+                 (reoptimize-continuation prev)
+                 (flush-combination call))))
             (t (let ((dummies (make-gensym-list (length args))))
                  (transform-call
                   call
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 6805e4f..b331c40 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1247,6 +1247,15 @@
 	  (setf (continuation-asserted-type cont) *wild-type*)
           (setf (continuation-type-to-check cont) *wild-type*)
 	  (values))))))
+
+(defun flush-combination (combination)
+  (declare (type combination combination))
+  (flush-dest (combination-fun combination))
+  (dolist (arg (combination-args combination))
+    (flush-dest arg))
+  (unlink-node combination)
+  (values))
+
 
 ;;;; leaf hackery
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 1d128af..39f7853 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre8.110"
+"0.pre8.111"
-- 
1.7.10.4