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

Fix for compiled test cases of the form (PROGN (FBOUNDP 42) T),

	which don't signal an error in safe code because such calls are
	flushed when the called function is FLUSHABLE and the value of the
	call is not used.

	* src/compiler/ir1opt.lisp (flush-dead-code):
	Suppress flushing of flushable known functions if safety = 3.
parent ce55ee05
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/ir1opt.lisp,v 1.75 2003/04/24 13:59:34 gerd Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.76 2003/04/26 18:39:30 gerd Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -486,10 +486,23 @@ ...@@ -486,10 +486,23 @@
(let ((attr (function-info-attributes info))) (let ((attr (function-info-attributes info)))
(when (and (ir1-attributep attr flushable) (when (and (ir1-attributep attr flushable)
(not (ir1-attributep attr call))) (not (ir1-attributep attr call)))
(flush-dest (combination-fun node)) (if (policy node (= safety 3))
(dolist (arg (combination-args node)) ;; Don't flush calls to flushable functions if
(flush-dest arg)) ;; their value is unused in safe code, because
(unlink-node node)))))) ;; this means something like (PROGN (FBOUNDP 42)
;; T) won't signal an error. KLUDGE: The right
;; thing to do here is probably teaching
;; MAYBE-NEGATE-CHECK and friends to accept nil
;; continuation-dests instead of faking one.
;; Can't be bothered at present.
;; Gerd, 2003-04-26.
(setf (continuation-dest cont)
(continuation-next cont))
(progn
(flush-dest (combination-fun node))
(dolist (arg (combination-args node))
(flush-dest arg))
(unlink-node node))))))))
(mv-combination (mv-combination
(when (eq (basic-combination-kind node) :local) (when (eq (basic-combination-kind node) :local)
(let ((fun (combination-lambda node))) (let ((fun (combination-lambda node)))
...@@ -1146,7 +1159,6 @@ ...@@ -1146,7 +1159,6 @@
(local-call-analyze *current-component*))) (local-call-analyze *current-component*)))
(undefined-value)) (undefined-value))
;;; Constant-Fold-Call -- Internal ;;; Constant-Fold-Call -- Internal
;;; ;;;
;;; Replace a call to a foldable function of constant arguments with the ;;; Replace a call to a foldable function of constant arguments with the
......
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