From: Alexey Dejneka Date: Thu, 21 Nov 2002 14:36:01 +0000 (+0000) Subject: 0.7.9.60: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7f008dde7e2c89187a963444e09a8bc594bd9f91;p=sbcl.git 0.7.9.60: Undone patch from 0.7.9.54 for bugs 115 and 226. --- diff --git a/BUGS b/BUGS index fac411c..e144df9 100644 --- a/BUGS +++ b/BUGS @@ -502,6 +502,56 @@ WORKAROUND: time trying to GC afterwards. Surely there's some more economical way to implement (ROOM T). +115: + reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs + collection: + (in-package :cl-user) + ;;; The following invokes a compiler error. + (declaim (optimize (speed 2) (debug 3))) + (defun tst () + (flet ((m1 () + (unwind-protect nil))) + (if (catch nil) + (m1) + (m1)))) + The error message in sbcl-0.6.12.42 is + internal error, failed AVER: + "(COMMON-LISP:EQ (SB!C::TN-ENVIRONMENT SB!C:TN) SB!C::TN-ENV)" + + This examples better illustrates the problem: + + (defun tst () + (declare (optimize (speed 2) (debug 3))) + (flet ((m1 () + (bar (if (foo) 1 2)) + (let ((x (foo))) + (bar x (list x))))) + (if (catch nil) + (m1) + (m1)))) + + (X is allocated in the physical environment of M1; X is :WRITE in + the call of LET [convert-to-global]; IF makes sure that a block + exists in M1 before this call.) + + Because X is :DEBUG-ENVIRONMENT, it is :LIVE by default in all + blocks in the environment, particularly it is :LIVE in the start of + M1 (where it is not yet :WRITE) [setup-environment-tn-conflicts]. + + Then :LIVE is propagated backwards, i.e. into the caller of M1 + where X does not exist [lifetime-flow-analysis]. + + (CATCH NIL) causes all TNs to be saved; Python fails on saving + non-existent variable; if it is replaced with (FOO), the problem + appears when debugging TST: LIST-LOCALS says + + debugger invoked on condition of type SB-DI:UNKNOWN-DEBUG-VAR: + + # is not in #. + + (in those old versions, in which debugger worked :-(). + 117: When the compiler inline expands functions, it may be that different kinds of return values are generated from different code branches. @@ -1272,7 +1322,24 @@ WORKAROUND: (ignore-errors (progn (values-list (car (list '(1 . 2)))) t))) 226: "AVER failure in COMPILE-FILE of clocc-ansi-test/tests.lisp" - (fixed in 0.7.9.54) + (APD points out that this seems to be another symptom of bug #115.) + sbcl-0.7.9.43 dies with failed AVER "(EQ (TN-PHYSENV TN) TN-ENV)" when + trying to compile clocc-ansi-test/tests.lisp. sbcl-0.7.9.31 was able to + to compile it. A smaller test case exhibiting the same problem is + (declaim (optimize (speed 0) (safety 3) (debug 3))) + (defun c-a-p () + (flet ((safe-format (stream string &rest r) + (unless (ignore-errors (progn + (apply #'format stream string r) + t)) + (format stream "~&foo ~S" string)))) + (cond + ((eq my-result :ERROR) + (cond + ((ignore-errors (typep condition result)) + (safe-format t "~&bar ~S" result)) + (t + (safe-format t "~&baz ~S (~A) ~S" condition condition result))))))) DEFUNCT CATEGORIES OF BUGS diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 3550d8f..afd27fb 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -483,47 +483,41 @@ ;;; We leave the CURRENT-CONFLICT pointing to the conflict for BLOCK1. ;;; The CURRENT-CONFLICT must be initialized to the head of the ;;; GLOBAL-CONFLICTS for the TN between each flow analysis iteration. -;;; -;;; :DEBUG-ENVIRONMENT TN might be :LIVE before being assigned, so we -;;; must be careful to not propagate its liveness into another -;;; environment (see bug 115). (defun propagate-live-tns (block1 block2) (declare (type ir2-block block1 block2)) (let ((live-in (ir2-block-live-in block1)) (did-something nil)) (do ((conf2 (ir2-block-global-tns block2) - (global-conflicts-next-blockwise conf2))) - ((null conf2)) - (let ((tn (global-conflicts-tn conf2))) - (unless (and (not (eq (ir2-block-physenv block1) (ir2-block-physenv block2))) - (member (tn-kind tn) '(:environment :debug-environment))) - (ecase (global-conflicts-kind conf2) - ((:live :read :read-only) - (let* ((tn-conflicts (tn-current-conflict tn)) - (number1 (ir2-block-number block1))) - (aver tn-conflicts) - (do ((current tn-conflicts (global-conflicts-next-tnwise current)) - (prev nil current)) - ((or (null current) - (> (ir2-block-number (global-conflicts-block current)) - number1)) - (setf (tn-current-conflict tn) prev) - (add-global-conflict :live tn block1 nil) - (setq did-something t)) - (when (eq (global-conflicts-block current) block1) - (case (global-conflicts-kind current) - (:live) - (:read-only - (setf (global-conflicts-kind current) :live) - (setf (svref (ir2-block-local-tns block1) - (global-conflicts-number current)) - nil) - (setf (global-conflicts-number current) nil) - (setf (tn-current-conflict tn) current)) - (t - (setf (sbit live-in (global-conflicts-number current)) 1))) - (return))))) - (:write))))) + (global-conflicts-next-blockwise conf2))) + ((null conf2)) + (ecase (global-conflicts-kind conf2) + ((:live :read :read-only) + (let* ((tn (global-conflicts-tn conf2)) + (tn-conflicts (tn-current-conflict tn)) + (number1 (ir2-block-number block1))) + (aver tn-conflicts) + (do ((current tn-conflicts (global-conflicts-next-tnwise current)) + (prev nil current)) + ((or (null current) + (> (ir2-block-number (global-conflicts-block current)) + number1)) + (setf (tn-current-conflict tn) prev) + (add-global-conflict :live tn block1 nil) + (setq did-something t)) + (when (eq (global-conflicts-block current) block1) + (case (global-conflicts-kind current) + (:live) + (:read-only + (setf (global-conflicts-kind current) :live) + (setf (svref (ir2-block-local-tns block1) + (global-conflicts-number current)) + nil) + (setf (global-conflicts-number current) nil) + (setf (tn-current-conflict tn) current)) + (t + (setf (sbit live-in (global-conflicts-number current)) 1))) + (return))))) + (:write))) did-something)) ;;; Do backward global flow analysis to find all TNs live at each diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index bb9e300..b1b81c4 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -138,39 +138,5 @@ #'objs.stale?)) (call-next-method)) -;;; bugs 115, 226: compiler failure in lifetime analysis -(defun bug115-1 () - (declare (optimize (speed 2) (debug 3))) - (flet ((m1 () - (unwind-protect nil))) - (if (catch nil) - (m1) - (m1)))) - -(defun bug115-2 () - (declare (optimize (speed 2) (debug 3))) - (flet ((m1 () - (bar (if (foo) 1 2)) - (let ((x (foo))) - (bar x (list x))))) - (if (catch nil) - (m1) - (m1)))) - -(defun bug226 () - (declare (optimize (speed 0) (safety 3) (debug 3))) - (flet ((safe-format (stream string &rest r) - (unless (ignore-errors (progn - (apply #'format stream string r) - t)) - (format stream "~&foo ~S" string)))) - (cond - ((eq my-result :ERROR) - (cond - ((ignore-errors (typep condition result)) - (safe-format t "~&bar ~S" result)) - (t - (safe-format t "~&baz ~S (~A) ~S" condition condition result))))))) - - (sb-ext:quit :unix-status 104) ; success + diff --git a/version.lisp-expr b/version.lisp-expr index 02d2641..a851108 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.9.59" +"0.7.9.60"