From: Alexey Dejneka Date: Thu, 28 Nov 2002 06:00:55 +0000 (+0000) Subject: 0.7.10.4: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e47ffa8855d4139f88f5982fe4b82a05c3498ed3;p=sbcl.git 0.7.10.4: Second try on the bug 115: convert :DEBUG-ENVIRONMENT to :ENVIRONMENT TN in its native environment. This is not efficient, but should not cause any new bugs. --- diff --git a/BUGS b/BUGS index 9da82f2..6587715 100644 --- a/BUGS +++ b/BUGS @@ -502,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. @@ -1322,29 +1272,6 @@ WORKAROUND: (the LOCALY there is not a typo; any unknown function (e.g. FROB) will do). -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))))))) - -227: "compiler bewilderment with adjustable vectors and COPY-SEQ" - (fixed in sbcl-0.7.9.65) - 228: "function-lambda-expression problems" in sbcl-0.7.9.6x, from the REPL: * (progn (declaim (inline foo)) (defun foo (x) x)) @@ -1357,6 +1284,12 @@ WORKAROUND: 229: (subtypep 'function '(function)) => nil, t. +230: + (char= #\a "a") => nil. + + DAA requires it to signal a type error. + + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index afd27fb..6aecbcc 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -124,7 +124,7 @@ (unless (tn-global-conflicts tn) (convert-to-global tn)) (add-global-conflict :read-only tn block ltn-num)) - + (setf (tn-local tn) block) (setf (tn-local-number tn) ltn-num) (setf (svref tns ltn-num) tn) @@ -217,7 +217,7 @@ ;;; local when we scan the block again. ;;; ;;; If there are conflicts, then we set LOCAL to one of the -;;; conflicting blocks. This ensures that Local doesn't hold over +;;; conflicting blocks. This ensures that LOCAL doesn't hold over ;;; BLOCK as its value, causing the subsequent reanalysis to think ;;; that the TN has already been seen in that block. ;;; @@ -444,14 +444,16 @@ (defun convert-to-environment-tn (tn tn-physenv) (declare (type tn tn) (type physenv tn-physenv)) (aver (member (tn-kind tn) '(:normal :debug-environment))) - (when (eq (tn-kind tn) :debug-environment) - (aver (eq (tn-physenv tn) tn-physenv)) - (let ((2env (physenv-info tn-physenv))) - (setf (ir2-physenv-debug-live-tns 2env) - (delete tn (ir2-physenv-debug-live-tns 2env))))) + (ecase (tn-kind tn) + (:debug-environment + (setq tn-physenv (tn-physenv tn)) + (let* ((2env (physenv-info tn-physenv))) + (setf (ir2-physenv-debug-live-tns 2env) + (delete tn (ir2-physenv-debug-live-tns 2env))))) + (:normal + (setf (tn-local tn) nil) + (setf (tn-local-number tn) nil))) (setup-environment-tn-conflicts *component-being-compiled* tn tn-physenv nil) - (setf (tn-local tn) nil) - (setf (tn-local-number tn) nil) (setf (tn-kind tn) :environment) (setf (tn-physenv tn) tn-physenv) (push tn (ir2-physenv-live-tns (physenv-info tn-physenv))) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index c2174a9..605bb4a 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -150,8 +150,8 @@ (local-tns (make-array local-tn-limit) :type local-tn-vector) ;; Bit-vectors used during lifetime analysis to keep track of ;; references to local TNs. When indexed by the LTN number, the - ;; index for a TN is non-zero in Written if it is ever written in - ;; the block, and in Live-Out if the first reference is a read. + ;; index for a TN is non-zero in WRITTEN if it is ever written in + ;; the block, and in LIVE-OUT if the first reference is a read. (written (make-array local-tn-limit :element-type 'bit :initial-element 0) :type local-tn-bit-vector) diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index b1b81c4..cdad366 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -138,5 +138,39 @@ #'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 ef3d3fd..72ead42 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.10.3" +"0.7.10.4"