* Remove bug entry 54.
* Do not propagate liveness of :DEBUG-ENVIRONMENT TNs into
another environment.
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.
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.
(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
(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
;;; 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
#'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
;;; 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"
projects / sbcl.git / commitdiff