From b71200f349d72df2596c56e8b07f23ea7a5da0d0 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Mon, 13 Oct 2003 09:57:10 +0000 Subject: [PATCH] (compile nil '(lambda (a c) (if nil (unwind-protect (max 521739 (unwind-protect c))) (logandc2 3942 a)))) => nil is not of type ref * src/compiler/ir1opt.lisp (find-result-type): Ignore uses whose home lambda or block is deleted. From SBCL. --- compiler/ir1opt.lisp | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp index 543795800..6bbfb2d29 100644 --- a/compiler/ir1opt.lisp +++ b/compiler/ir1opt.lisp @@ -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.80 2003/10/11 11:58:28 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.81 2003/10/13 09:57:10 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -563,19 +563,22 @@ (let ((result (return-result node))) (collect ((use-union *empty-type* values-type-union)) (do-uses (use result) - (cond ((and (basic-combination-p use) - (eq (basic-combination-kind use) :local)) - (assert (eq (lambda-tail-set (node-home-lambda use)) - (lambda-tail-set (combination-lambda use)))) - (when (combination-p use) - (when (nth-value 1 (maybe-convert-tail-local-call use)) - (return-from find-result-type (undefined-value))))) - (t - (use-union (node-derived-type use))))) + (let ((use-home (node-home-lambda use))) + (cond ((or (eq (functional-kind use-home) :deleted) + (block-delete-p (node-block use)))) + ((and (basic-combination-p use) + (eq (basic-combination-kind use) :local)) + (assert (eq (lambda-tail-set use-home) + (lambda-tail-set (combination-lambda use)))) + (when (combination-p use) + (when (nth-value 1 (maybe-convert-tail-local-call use)) + (return-from find-result-type (values))))) + (t + (use-union (node-derived-type use)))))) (let ((int (values-type-intersection (continuation-asserted-type result) (use-union)))) (setf (return-result-type node) int)))) - (undefined-value)) + (values)) ;;; IR1-Optimize-Return -- Internal -- GitLab