From: Alexey Dejneka Date: Mon, 18 Nov 2002 05:52:18 +0000 (+0000) Subject: 0.7.9.54: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5326948a9a50eda06a789a60ba9d0e312115f25c;p=sbcl.git 0.7.9.54: * Remove bug entry 54. * Do not propagate liveness of :DEBUG-ENVIRONMENT TNs into another environment. --- diff --git a/BUGS b/BUGS index 3a0c0bf..fac411c 100644 --- a/BUGS +++ b/BUGS @@ -283,10 +283,6 @@ WORKAROUND: need to document exactly what metaobject protocol specification we're following -- the current code is just inherited from PCL.) -54: - The implementation of #'+ returns its single argument without - type checking, e.g. (+ "illegal") => "illegal". - 60: The debugger LIST-LOCATIONS command doesn't work properly. @@ -506,56 +502,6 @@ 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. @@ -1091,7 +1037,7 @@ WORKAROUND: (progn (the real (list 1)) t) This situation may appear during optimizing away degenerate cases of - certain functions: see bugs 54, 192b. + certain functions: see bug 192b. 205: "environment issues in cross compiler" (These bugs have no impact on user code, but should be fixed or @@ -1325,28 +1271,8 @@ WORKAROUND: (localy (declare (optimize (safety 3))) (ignore-errors (progn (values-list (car (list '(1 . 2)))) t))) -225: - (fixed in 0.7.9.42) - 226: "AVER failure in COMPILE-FILE of clocc-ansi-test/tests.lisp" - (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))))))) + (fixed in 0.7.9.54) DEFUNCT CATEGORIES OF BUGS diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index afd27fb..3550d8f 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -483,41 +483,47 @@ ;;; 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)) - (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))) + (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))))) 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 b1b81c4..bb9e300 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -138,5 +138,39 @@ #'objs.stale?)) (call-next-method)) -(sb-ext:quit :unix-status 104) ; success +;;; 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 963f73d..cbc55fc 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.53" +"0.7.9.54"