From ca094620d68447584326dfaac532e7b2f1014d12 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 19 Jul 2008 11:32:53 +0000
Subject: [PATCH] 1.0.18.24: lift node-insertion logic from
 RECOGNIZE-DYNAMIC-EXTENT-LVARS

 * New function INSERT-NODE-BEFORE, makes the action easier to
   understand by separating out the entry/cleanup creation from the
   flow-graph hacking.
---
 src/compiler/ir1tran.lisp | 11 +++++++++++
 src/compiler/locall.lisp  | 21 ++++++---------------
 version.lisp-expr         |  2 +-
 3 files changed, 18 insertions(+), 16 deletions(-)

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index eddc909d8..2497c0689 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -375,6 +375,17 @@
       (error "~S is already a predecessor of ~S." node-block block))
     (push node-block (block-pred block))))
 
+;;; Insert NEW before OLD in the flow-graph.
+(defun insert-node-before (old new)
+  (let ((prev (node-prev old))
+        (temp (make-ctran)))
+    (ensure-block-start prev)
+    (setf (ctran-next prev) nil)
+    (link-node-to-previous-ctran new prev)
+    (use-ctran new temp)
+    (link-node-to-previous-ctran old temp))
+  (values))
+
 ;;; This function is used to set the ctran for a node, and thus
 ;;; determine what receives the value.
 (defun use-lvar (node lvar)
diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 0a463c3a1..66538aec9 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -85,22 +85,13 @@
                   ;; Stack analysis requires that the CALL ends the block, so
                   ;; that MAP-BLOCK-NLXES sees the cleanup we insert here.
                   (node-ends-block call)
-                  (binding* ((before-ctran (node-prev call))
-                             (nil (ensure-block-start before-ctran))
-                             (block (ctran-block before-ctran))
-                             (new-call-ctran (make-ctran :kind :inside-block
-                                                         :next call
-                                                         :block block))
-                             (entry (with-ir1-environment-from-node call
-                                      (make-entry :prev before-ctran
-                                                  :next new-call-ctran)))
-                             (cleanup (make-cleanup :kind :dynamic-extent
-                                                    :mess-up entry
-                                                    :info dx-lvars)))
-                    (setf (node-prev call) new-call-ctran)
-                    (setf (ctran-next before-ctran) entry)
-                    (setf (ctran-use new-call-ctran) entry)
+                  (let* ((entry (with-ir1-environment-from-node call
+                                  (make-entry)))
+                         (cleanup (make-cleanup :kind :dynamic-extent
+                                                :mess-up entry
+                                                :info dx-lvars)))
                     (setf (entry-cleanup entry) cleanup)
+                    (insert-node-before call entry)
                     (setf (node-lexenv call)
                           (make-lexenv :default (node-lexenv call)
                                        :cleanup cleanup))
diff --git a/version.lisp-expr b/version.lisp-expr
index 07f3a232a..0ef7ba18e 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".)
-"1.0.18.23"
+"1.0.18.24"
-- 
2.11.4.GIT