From: Alexey Dejneka Date: Sat, 15 Nov 2003 18:34:34 +0000 (+0000) Subject: 0.8.5.40: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d18903c82a4856d5a65549b2913c0ee098c34f7e;p=sbcl.git 0.8.5.40: * Fix PFD bug MISC.172: restart IR1-OPTIMIZE-RETURN after assignment-convertion; * fix PFD bug MISC.173: in FIND-DFO-AUX skip blocks to be deleted. --- diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index 6d5d6a7..18dcaec 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -22,7 +22,7 @@ (let ((head (component-head component))) (do () ((dolist (ep (block-succ head) t) - (unless (block-flag ep) + (unless (or (block-flag ep) (block-delete-p ep)) (find-dfo-aux ep head component) (return nil)))))) (let ((num 0)) @@ -89,7 +89,7 @@ (defun find-dfo-aux (block head component) (unless (eq (block-component block) component) (join-components component (block-component block))) - (unless (block-flag block) + (unless (or (block-flag block) (block-delete-p block)) (setf (block-flag block) t) (dolist (succ (block-succ block)) (find-dfo-aux succ head component)) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index d7bdf0e..3c67e0f 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -456,7 +456,7 @@ (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))))) + (return-from find-result-type t)))) (t (use-union (node-derived-type use)))))) (let ((int @@ -466,7 +466,7 @@ ;; ) )) (setf (return-result-type node) int)))) - (values)) + nil) ;;; Do stuff to realize that something has changed about the value ;;; delivered to a return node. Since we consider the return values of @@ -482,22 +482,25 @@ ;;; results of the calls. (defun ir1-optimize-return (node) (declare (type creturn node)) - (let* ((tails (lambda-tail-set (return-lambda node))) - (funs (tail-set-funs tails))) - (collect ((res *empty-type* values-type-union)) - (dolist (fun funs) - (let ((return (lambda-return fun))) - (when return - (when (node-reoptimize return) - (setf (node-reoptimize return) nil) - (find-result-type return)) - (res (return-result-type return))))) - - (when (type/= (res) (tail-set-type tails)) - (setf (tail-set-type tails) (res)) - (dolist (fun (tail-set-funs tails)) - (dolist (ref (leaf-refs fun)) - (reoptimize-lvar (node-lvar ref))))))) + (tagbody + :restart + (let* ((tails (lambda-tail-set (return-lambda node))) + (funs (tail-set-funs tails))) + (collect ((res *empty-type* values-type-union)) + (dolist (fun funs) + (let ((return (lambda-return fun))) + (when return + (when (node-reoptimize return) + (setf (node-reoptimize return) nil) + (when (find-result-type return) + (go :restart))) + (res (return-result-type return))))) + + (when (type/= (res) (tail-set-type tails)) + (setf (tail-set-type tails) (res)) + (dolist (fun (tail-set-funs tails)) + (dolist (ref (leaf-refs fun)) + (reoptimize-lvar (node-lvar ref)))))))) (values)) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 37698fa..0b07cfc 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -868,3 +868,75 @@ (multiple-value-call #'%f15 (values -519354 a 121 c -1905)))))) 0 0 -5) -16)) + +;;; MISC.172 +(assert (eql (funcall + (compile + nil + '(lambda (a b c) + (declare (notinline list apply)) + (declare (optimize (safety 3))) + (declare (optimize (speed 0))) + (declare (optimize (debug 0))) + (labels ((%f12 (f12-1 f12-2) + (labels ((%f2 (f2-1 f2-2) + (flet ((%f6 () + (flet ((%f18 + (f18-1 + &optional (f18-2 a) + (f18-3 -207465075) + (f18-4 a)) + (return-from %f12 b))) + (%f18 -3489553 + -7 + (%f18 (%f18 150 -64 f12-1) + (%f18 (%f18 -8531) + 11410) + b) + 56362666)))) + (labels ((%f7 + (f7-1 f7-2 + &optional (f7-3 (%f6))) + 7767415)) + f12-1)))) + (%f2 b -36582571)))) + (apply #'%f12 (list 774 -4413))))) + 0 1 2) + 774)) + +;;; MISC.173 +(assert (eql (funcall + (compile + nil + '(lambda (a b c) + (declare (notinline values)) + (declare (optimize (safety 3))) + (declare (optimize (speed 0))) + (declare (optimize (debug 0))) + (flet ((%f11 + (f11-1 f11-2 + &optional (f11-3 c) (f11-4 7947114) + (f11-5 + (flet ((%f3 (f3-1 &optional (f3-2 b) (f3-3 5529)) + 8134)) + (multiple-value-call #'%f3 + (values (%f3 -30637724 b) c))))) + (setq c 555910))) + (if (and nil (%f11 a a)) + (if (%f11 a 421778 4030 1) + (labels ((%f7 + (f7-1 f7-2 + &optional + (f7-3 + (%f11 -79192293 + (%f11 c a c -4 214720) + b + b + (%f11 b 985))) + (f7-4 a)) + b)) + (%f11 c b -25644)) + 54) + -32326608)))) + 1 2 3) + -32326608)) diff --git a/version.lisp-expr b/version.lisp-expr index 04d36c9..58201ba 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".) -"0.8.5.39" +"0.8.5.40"