Skip to content
Browse files

0.7.9.54:

        * Remove bug entry 54.
        * Do not propagate liveness of :DEBUG-ENVIRONMENT TNs into
          another environment.
  • Loading branch information...
1 parent 237ecea commit 5326948a9a50eda06a789a60ba9d0e312115f25c Alexey Dejneka committed Nov 18, 2002
Showing with 74 additions and 108 deletions.
  1. +2 −76 BUGS
  2. +36 −30 src/compiler/life.lisp
  3. +35 −1 tests/compiler-1.impure-cload.lisp
  4. +1 −1 version.lisp-expr
View
78 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:
-
- #<SB-DI::COMPILED-DEBUG-VAR X 0
- {905FF7D}> is not in #<SB-DI::COMPILED-DEBUG-FUNCTION TST>.
-
- (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
View
66 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
View
36 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
View
2 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"

0 comments on commit 5326948

Please sign in to comment.
Something went wrong with that request. Please try again.