Skip to content
Snippets Groups Projects
Commit 6b89089d authored by ram's avatar ram
Browse files

Link NLX points to the component tail, instead of leaving them with

no successors.
parent 9b1d4d0f
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.17 1991/09/23 14:17:41 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.18 1991/11/09 22:07:01 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -173,9 +173,10 @@ ...@@ -173,9 +173,10 @@
;;; passed the NLX-Info as an argument so that the back end knows what entry is ;;; passed the NLX-Info as an argument so that the back end knows what entry is
;;; being done. ;;; being done.
;;; ;;;
;;; The link from the Exit block to the entry stub is changed to be a lonk to ;;; The link from the Exit block to the entry stub is changed to be a link to
;;; the component head. This leaves the entry stub reachable, but makes the ;;; the component head. Similarly, the Exit block is linked to the component
;;; flow graph less confusing to flow analysis. ;;; tail. This leaves the entry stub reachable, but makes the flow graph less
;;; confusing to flow analysis.
;;; ;;;
;;; If a catch or an unwind-protect, then we set the Lexenv for the last node ;;; If a catch or an unwind-protect, then we set the Lexenv for the last node
;;; in the cleanup code to be the enclosing environment, to represent the fact ;;; in the cleanup code to be the enclosing environment, to represent the fact
...@@ -195,9 +196,11 @@ ...@@ -195,9 +196,11 @@
(new-block (insert-cleanup-code exit-block next-block (new-block (insert-cleanup-code exit-block next-block
entry entry
`(%nlx-entry ',info) `(%nlx-entry ',info)
(entry-cleanup entry)))) (entry-cleanup entry)))
(component (block-component new-block)))
(unlink-blocks exit-block new-block) (unlink-blocks exit-block new-block)
(link-blocks (component-head (block-component new-block)) new-block) (link-blocks exit-block (component-tail component))
(link-blocks (component-head component) new-block)
(setf (nlx-info-target info) new-block) (setf (nlx-info-target info) new-block)
(push info (environment-nlx-info env)) (push info (environment-nlx-info env))
...@@ -215,7 +218,7 @@ ...@@ -215,7 +218,7 @@
;;; Env. This is called for each non-local exit node, of which there may be ;;; Env. This is called for each non-local exit node, of which there may be
;;; several per exit continuation. This is what we do: ;;; several per exit continuation. This is what we do:
;;; -- If there isn't any NLX-Info entry in the environment, make an entry ;;; -- If there isn't any NLX-Info entry in the environment, make an entry
;;; stub, otherwise just unlink the exit block from its successor. ;;; stub, otherwise just move the exit block link to the component tail.
;;; -- Close over the NLX-Info in the exit environment. ;;; -- Close over the NLX-Info in the exit environment.
;;; -- If the exit is from an :Escape function, then substitute a constant ;;; -- If the exit is from an :Escape function, then substitute a constant
;;; reference to NLX-Info structure for the escape function reference. This ;;; reference to NLX-Info structure for the escape function reference. This
...@@ -234,7 +237,8 @@ ...@@ -234,7 +237,8 @@
(if (find-nlx-info entry cont) (if (find-nlx-info entry cont)
(let ((block (node-block exit))) (let ((block (node-block exit)))
(assert (= (length (block-succ block)) 1)) (assert (= (length (block-succ block)) 1))
(unlink-blocks block (first (block-succ block)))) (unlink-blocks block (first (block-succ block)))
(link-blocks block (component-tail (block-component block))))
(insert-nlx-entry-stub exit env)) (insert-nlx-entry-stub exit env))
(let ((info (find-nlx-info entry cont))) (let ((info (find-nlx-info entry cont)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment