Skip to content
Snippets Groups Projects
Commit bf6b4a00 authored by gerd's avatar gerd
Browse files

* src/compiler/eval-comp.lisp (compile-for-eval): Delete

	unreachable blocks, similar to ir1-optimize, which we don't call.
	This simplifies things by reducing the differences between
	"normal" compilation and compiling for interpretation.

	* src/compiler/ir1util.lisp (block-unreachable-p): New function.
	(delete-lambda): Mark return blocks for deletion again.

	* src/compiler/ir1opt.lisp (ir1-optimize): Use block-unreachable-p.
	Delete unreachable blocks after the loop.
parent 6e3efcdb
No related branches found
No related tags found
No related merge requests found
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval-comp.lisp,v 1.35 2003/08/05 15:50:28 toy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval-comp.lisp,v 1.36 2003/10/26 17:31:25 gerd Rel $")
;;;
;;; **********************************************************************
;;;
......@@ -90,7 +90,7 @@
(*all-components* (list component)))
(local-call-analyze component)))
(multiple-value-bind (components top-components)
(find-initial-dfo lambdas)
(find-initial-dfo lambdas)
(let ((*all-components* (append components top-components)))
(when *check-consistency*
(check-ir1-consistency *all-components*))
......@@ -98,6 +98,13 @@
;; This DOLIST body comes from the beginning of
;; COMPILE-COMPONENT.
(dolist (component *all-components*)
;;
;; Since we don't call IR1-OPTIMIZE, delete
;; unreachable blocks here.
(do-blocks (block component)
(when (block-unreachable-p block)
(delete-block block)))
(ir1-finalize component)
(let ((*compile-component* component))
(environment-analyze component))
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.81 2003/10/13 09:57:10 gerd Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.82 2003/10/26 17:31:25 gerd Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -293,9 +293,7 @@
(setf (component-reoptimize component) nil)
(do-blocks (block component)
(cond
((or (block-delete-p block)
(null (block-pred block))
(eq (functional-kind (block-home-lambda block)) :deleted))
((block-unreachable-p block)
(delete-block block))
(t
(loop
......@@ -306,30 +304,31 @@
(let ((last (block-last block)))
(typecase last
(cif
;;
;; Don't flush an if-test if it requires a type check.
(cond ((memq (continuation-type-check (if-test last))
'(nil :deleted))
(flush-dest (if-test last))
(when (unlink-node last) (return)))
(t
(return))))
(let ((if-test (if-test last)))
;; Don't flush an if-test if it requires a type check.
(unless (memq (continuation-type-check if-test) '(nil :deleted))
(return))
(flush-dest if-test)
(when (unlink-node last)
(return))))
(exit
(when (maybe-delete-exit last) (return)))))
(when (maybe-delete-exit last)
(return)))))
(unless (join-successor-if-possible block)
(return)))
(when (and (block-reoptimize block) (block-component block))
(assert (not (block-delete-p block)))
(ir1-optimize-block block))
(when (and (block-flush-p block) (block-component block))
(assert (not (block-delete-p block)))
(flush-dead-code block)))))
(undefined-value))
;;
;; Block-Component is nil for deleted blocks.
(when (block-component block)
(cond ((block-unreachable-p block)
(delete-block block))
(t
(when (block-reoptimize block)
(ir1-optimize-block block))
(when (and (block-flush-p block)
(block-component block))
(flush-dead-code block))))))))
(values))
;;; IR1-Optimize-Block -- Internal
;;;
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.99 2003/10/21 13:09:23 gerd Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.100 2003/10/26 17:31:25 gerd Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -336,6 +336,15 @@
(lambda-environment (node-home-lambda (block-last block))))
;;;
;;; Value is true if Block in unreachable and thus can be deleted.
;;;
(defun block-unreachable-p (block)
(declare (type cblock block))
(or (block-delete-p block)
(null (block-pred block))
(eq (functional-kind (block-home-lambda block)) :deleted)))
;;; SOURCE-PATH-TLF-NUMBER -- Interface
;;;
;;; Return the Top Level Form number of path, i.e. the ordinal number of
......@@ -772,6 +781,7 @@
(let ((return-block (node-block return)))
(when (and return-block
(not (block-delete-p return-block)))
(mark-for-deletion return-block)
(unlink-blocks return-block (component-tail component)))))
(setf (component-reanalyze component) t)
(let ((tails (lambda-tail-set leaf)))
......
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