From ba38798a5ca26b90647a1993f348806cb32f2d1b Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 30 Apr 2002 01:23:23 +0000 Subject: [PATCH] 0.7.3.6: merged APD bug 147 fix (sbcl-devel 2002-04-27) --- BUGS | 48 -------------------------------------------- NEWS | 5 +++++ README | 18 +++++++++-------- src/compiler/ir1opt.lisp | 22 +++++++++++++++----- src/compiler/ir1util.lisp | 9 ++++++++- tests/compiler.impure.lisp | 11 ++++++++++ version.lisp-expr | 2 +- 7 files changed, 52 insertions(+), 63 deletions(-) diff --git a/BUGS b/BUGS index 59f4279..fc576e0 100644 --- a/BUGS +++ b/BUGS @@ -1134,54 +1134,6 @@ WORKAROUND: It should be possible to be much more specific (overflow, division by zero, etc.) and of course the "How can this be?" should be fixable. -147: - (reported by Alexey Dejneka sbcl-devel 2002-01-28) - Compiling a file containing - (deftype digit () '(member #\1)) - (defun parse-num (string ind) - (flet ((digs () - (let (old-index) - (if (and (< ind ind) - (typep (char string ind) 'digit)) - nil)))))) - in sbcl-0.7.1 causes the compiler to fail with - internal error, failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)" - This problem seems to have been introduced by the sbcl-0.pre7.* compiler - changes, since 0.pre7.73 and 0.6.13 don't suffer from it. A related - test case is - (defun parse-num (index) - (let (num x) - (flet ((digs () - (setq num index)) - (z () - (let () - (setq x nil)))) - (when (and (digs) (digs)) x)))) - In sbcl-0.7.1, this second test case failed with the same - internal error, failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)" - After the APD patches in sbcl-0.7.1.2 (new consistency check in - TARGET-IF-DESIRABLE, plus a fix in meta-vmdef.lisp to keep the - new consistency check from failing routinely) this second test case - failed in FIND-IN-PHYSENV instead. Fixes in sbcl-0.7.1.3 (not - closing over unreferenced variables) made this second test case - compile without error, but the original test case still fails. - - Another way to get rid of the DEFTYPE without changing the symptom - of the bug is - (defvar *ch*) - (defun parse-num (string ind) - (flet ((digs () - (let () - (if (and (< ind ind) - (sb-int:memq *ch* '(#\1))) - nil)))))) - In sbcl-0.7.1.3, this fails with - internal error, failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)" - The problem occurs while the inline expansion of MEMQ, - # - is being LET-converted after having its second REF deleted, leaving - it with only one entry in LEAF-REFS. - 148: In sbcl-0.7.1.3 on x86, COMPILE-FILE on the file (in-package :cl-user) diff --git a/NEWS b/NEWS index 6986cc1..6d6f336 100644 --- a/NEWS +++ b/NEWS @@ -1102,6 +1102,11 @@ changes in sbcl-0.7.3 relative to sbcl-0.7.2: default supplied-p) for &optional and &key arguments. (thanks to Martin Atzmueller) +changes in sbcl-0.7.4 relative to sbcl-0.7.3: + * bug 147 fixed: The compiler preserves its block link/count + invariants more correctly now so that it doesn't crash. (thanks + to Alexey Dejneka) + planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe later, it might impact TRACE. They both encapsulate functions, and diff --git a/README b/README index f07d4cf..5fed77a 100644 --- a/README +++ b/README @@ -27,11 +27,13 @@ system, please send mail to one of the mailing lists: SYSTEM-SPECIFIC HINTS for OpenBSD: - It's reported for CMU CL (by Darren Bane on the comp.lang.lisp newsgroup, - 2002-04-22) that OpenBSD 3.0 has stricter ulimit values, and/or enforces - them more strictly, than its predecessors, and so CMU CL's initial mmap() - won't work unless you increase the limit on the data segment, e.g. with - ulimit -S -d 524288 - before you run CMU CL. The same is probably true of SBCL, but hasn't been - tested yet. (As of sbcl-0.7.3, SBCL has only been tested on OpenBSD 2.9 - and earlier.) + OpenBSD 3.0 has stricter ulimit values, and/or enforces them more + strictly, than its predecessors. Therefore SBCL's initial mmap() + won't work unless you increase the limit on the data segment from + the OpenBSD defaults, e.g. with + ulimit -S -d 1000000 + before you run SBCL. Otherwise SBCL fails with a message like + "ensure_space: failed to validate xxxxxxx bytes at yyyyy". (SBCL + is just allocating this huge address space, not actually using this + huge memory at this point. OpenBSD <3.0 had no problem with this, + but OpenBSD 3.0 is less hospitable.) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 66df637..3572089 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -239,15 +239,27 @@ (do-blocks (block component) (cond ((or (block-delete-p block) - (null (block-pred block)) - (eq (functional-kind (block-home-lambda block)) :deleted)) + (null (block-pred block))) (delete-block block)) + ((eq (functional-kind (block-home-lambda block)) :deleted) + ;; Preserve the BLOCK-SUCC invariant that almost every block has + ;; one successor (and a block with DELETE-P set is an acceptable + ;; exception). + (labels ((mark-blocks (block) + (dolist (pred (block-pred block)) + (when (and (not (block-delete-p pred)) + (eq (functional-kind (block-home-lambda pred)) + :deleted)) + (setf (block-delete-p pred) t) + (mark-blocks pred))))) + (mark-blocks block) + (delete-block block))) (t (loop (let ((succ (block-succ block))) (unless (and succ (null (rest succ))) (return))) - + (let ((last (block-last block))) (typecase last (cif @@ -257,8 +269,8 @@ (exit (when (maybe-delete-exit last) (return))))) - - (unless (join-successor-if-possible block) + + (unless (join-successor-if-possible block) (return))) (when (and (block-reoptimize block) (block-component block)) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 2e1d354..df17ebd 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -877,7 +877,14 @@ (reoptimize-continuation cont))) (dolist (b (block-pred block)) - (unlink-blocks b block)) + (unlink-blocks b block) + ;; In bug 147 the almost-all-blocks-have-a-successor invariant was + ;; broken when successors were deleted without setting the + ;; BLOCK-DELETE-P flags of their predececessors. Make sure that + ;; doesn't happen again. + (aver (not (and (null (block-succ b)) + (not (block-delete-p b)) + (not (eq b (component-head (block-component b)))))))) (dolist (b (block-succ block)) (unlink-blocks block b)) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 459e522..ce7ef42 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -77,6 +77,17 @@ (defun bug150-test2 () (let () (<))) + +;;; bug 147, fixed by APD 2002-04-28 +;;; +;;; This test case used to crash the compiler, e.g. with +;;; failed AVER: "(= (LENGTH (BLOCK-SUCC CALL-BLOCK)) 1)" +(defun bug147 (string ind) + (flet ((digs () + (let (old-index) + (if (and (< ind ind) + (typep (char string ind) '(member #\1))) + nil)))))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 75d15b1..3609a64 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.3.5" +"0.7.3.6" -- 1.7.10.4