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

ANSI test misc.9 and others

	 => assertion failure in delete-block

	* src/compiler/ir1util.lisp (delete-lambda): Mark blocks of
	lambda-refs for deletion.  Protect the unlink of the bind-block
	against it being marked for deletion.
	(delete-block) <entry>: Mark blocks of exits for deletion.
	Delete the entry from lambda-entries.
parent db41c940
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.96 2003/10/09 13:25:25 gerd Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.97 2003/10/11 10:49:51 gerd Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -760,18 +760,14 @@ ...@@ -760,18 +760,14 @@
(let* ((bind-block (node-block bind)) (let* ((bind-block (node-block bind))
(component (block-component bind-block)) (component (block-component bind-block))
(return (lambda-return leaf))) (return (lambda-return leaf)))
;; DELETE-LAMBDA can now remove a recursive lambda. Check
;; that all calls are from the lambda being deleted.
(dolist (ref (lambda-refs leaf)) (dolist (ref (lambda-refs leaf))
(let ((home (node-home-lambda ref))) (mark-for-deletion (node-block ref)))
(assert (eq home leaf))))
(unless (leaf-ever-used leaf) (unless (leaf-ever-used leaf)
(let ((*compiler-error-context* bind)) (let ((*compiler-error-context* bind))
(compiler-note "Deleting unused function~:[.~;~:*~% ~S~]" (compiler-note "Deleting unused function~:[.~;~:*~% ~S~]"
(leaf-name leaf)))) (leaf-name leaf))))
(unlink-blocks (component-head component) bind-block) (unless (block-delete-p bind-block)
(unlink-blocks (component-head component) bind-block))
(when return (when return
(unlink-blocks (node-block return) (component-tail component))) (unlink-blocks (node-block return) (component-tail component)))
(setf (component-reanalyze component) t) (setf (component-reanalyze component) t)
...@@ -1006,7 +1002,8 @@ ...@@ -1006,7 +1002,8 @@
(do-nodes (node cont block) (do-nodes (node cont block)
(typecase node (typecase node
(ref (delete-ref node)) (ref
(delete-ref node))
(cif (cif
(flush-dest (if-test node))) (flush-dest (if-test node)))
;; ;;
...@@ -1030,10 +1027,12 @@ ...@@ -1030,10 +1027,12 @@
(bind (bind
(let ((lambda (bind-lambda node))) (let ((lambda (bind-lambda node)))
(unless (eq (functional-kind lambda) :deleted) (unless (eq (functional-kind lambda) :deleted)
(assert (member (functional-kind lambda)
'(:let :mv-let :assignment)))
(delete-lambda lambda)))) (delete-lambda lambda))))
(entry (entry
(dolist (exit (entry-exits node))
(mark-for-deletion (node-block exit)))
(let ((home (node-home-lambda node)))
(setf (lambda-entries home) (delq node (lambda-entries home))))
;; ;;
;; Delete stale entries from the block's home lambda, otherwise ;; Delete stale entries from the block's home lambda, otherwise
;; COMPILE-FOR-EVAL stumbles over them. FIXME: There is still ;; COMPILE-FOR-EVAL stumbles over them. FIXME: There is still
......
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