From c8cc0137e55e6179f6af344f42e54f514660f68b Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 16 May 2004 07:42:20 +0000 Subject: [PATCH] 0.8.10.25: * Fix bug MISC.362: do not propagate live LVARs from an ENTRY of UNWIND-PROTECT to its NLX-ENTRY. * SB-CLTL2:DECLARATION-INFO supports OPTIMIZE declaration. --- BUGS | 4 ---- NEWS | 3 ++- contrib/sb-cltl2/env.lisp | 13 +++++++++++++ make.sh | 10 +++++----- src/compiler/stack.lisp | 18 +++++++++++++++--- tests/compiler.pure.lisp | 25 +++++++++++++++++++++++++ version.lisp-expr | 2 +- 7 files changed, 61 insertions(+), 14 deletions(-) diff --git a/BUGS b/BUGS index c848583..4535ebf 100644 --- a/BUGS +++ b/BUGS @@ -736,7 +736,6 @@ WORKAROUND: all of the arguments are circular is probably desireable). 213: "Sequence functions and type checking" - a. (fixed in 0.8.4.36) b. MAP, when given a type argument that is SUBTYPEP LIST, does not check that it will return a sequence of the given type. Fixing it along the same lines as the others (cf. work done around @@ -1343,9 +1342,6 @@ WORKAROUND: (probably related to the bug 280.) -313: "source-transforms are Lisp-1" - (fixed in 0.8.10.2) - 314: "LOOP :INITIALLY clauses and scope of initializers" reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP test suite, originally by Thomas F. Burdick. diff --git a/NEWS b/NEWS index 2fc9a8f..8c81f3e 100644 --- a/NEWS +++ b/NEWS @@ -2439,7 +2439,8 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10: ** print/read consistency on floats is now orders of magnitude more likely. (thanks also to Bruno Haible for a similar report and discussions) - + ** removed stack cleaning in the cleanup part of UNWIND-PROTECT. + planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles down, it might impact TRACE. They both encapsulate functions, and diff --git a/contrib/sb-cltl2/env.lisp b/contrib/sb-cltl2/env.lisp index 379de12..2a99b98 100644 --- a/contrib/sb-cltl2/env.lisp +++ b/contrib/sb-cltl2/env.lisp @@ -52,6 +52,19 @@ alist of declarations that apply to the apparent binding of VAR." (type . ,(type-specifier ; XXX local type (info :variable :type var))))))))) +(declaim (ftype (sfunction (symbol &optional (or null lexenv)) t) + declaration-information)) +(defun declaration-information (declaration-name &optional env) + (let ((policy (sb-c::lexenv-policy (or env (make-null-lexenv))))) + (case declaration-name + (optimize (collect ((res)) + (dolist (name sb-c::*policy-qualities*) + (res (list name (cdr (assoc name policy))))) + (loop for (name . nil) in sb-c::*policy-dependent-qualities* + do (res (list name (sb-c::policy-quality policy name)))) + (res))) + (t (error "Unsupported declaration ~S." declaration-name))))) + (defun parse-macro (name lambda-list body &optional env) (declare (ignore env)) (with-unique-names (whole environment) diff --git a/make.sh b/make.sh index 1dd7145..20c03de 100755 --- a/make.sh +++ b/make.sh @@ -101,11 +101,11 @@ sh make-config.sh || exit 1 # Or, if you can set up the files somewhere shared (with NFS, AFS, or # whatever) between the host machine and the target machine, the basic # procedure above should still work, but you can skip the "copy" steps. -sh make-host-1.sh || exit 1 -sh make-target-1.sh || exit 1 -sh make-host-2.sh || exit 1 -sh make-target-2.sh || exit 1 -sh make-target-contrib.sh || exit 1 +time sh make-host-1.sh || exit 1 +time sh make-target-1.sh || exit 1 +time sh make-host-2.sh || exit 1 +time sh make-target-2.sh || exit 1 +time sh make-target-contrib.sh || exit 1 # Sometimes people used to see the "No tests failed." output from the last # DEFTEST in contrib self-tests and think that's all that is. So... diff --git a/src/compiler/stack.lisp b/src/compiler/stack.lisp index 6ab9bfd..121f98b 100644 --- a/src/compiler/stack.lisp +++ b/src/compiler/stack.lisp @@ -96,12 +96,24 @@ ;; We cannot delete unused UVLs during NLX, so all UVLs live at ;; ENTRY will be actually live at NLE. + ;; + ;; BUT, UNWIND-PROTECTor is called in the environment, which has + ;; nothing in common with the environment of its entry. So we + ;; fictively compute its stack from the containing cleanups, but + ;; do not propagate additional LVARs from the entry, thus + ;; preveting bogus stack cleanings. + ;; + ;; TODO: Insert a check that no values are discarded in UWP. Or, + ;; maybe, we just don't need to create NLX-ENTRY for UWP? (when (and (eq (component-head (block-component block)) (first (block-pred block))) (not (bind-p (block-start-node block)))) - (let* ((entry-block (nle-block-entry-block block)) - (entry-stack (ir2-block-start-stack (block-info entry-block)))) - (setq start (merge-uvl-live-sets start entry-stack)))) + (let* ((nlx-info (nle-block-nlx-info block)) + (cleanup (nlx-info-cleanup nlx-info))) + (unless (eq (cleanup-kind cleanup) :unwind-protect) + (let* ((entry-block (node-block (cleanup-mess-up cleanup))) + (entry-stack (ir2-block-start-stack (block-info entry-block)))) + (setq start (merge-uvl-live-sets start entry-stack)))))) (when *check-consistency* (aver (subsetp original-start start))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index dcf5fb5..28b3242 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1234,6 +1234,31 @@ (assert (equal (non-continuous-stack-test t) '(11 12 13 14 1 2 3 4 5 6 7 8 :ext))) (assert (equal (non-continuous-stack-test nil) '(:b1 :b2 :b3 :b4 :a1 :a2 :a3 :a4 :int))) +;;; MISC.362: environment of UNWIND-PROTECTor is different from that +;;; if ENTRY. +(assert (equal (multiple-value-list (funcall + (compile + nil + '(lambda (b g h) + (declare (optimize (speed 3) (space 3) (safety 2) + (debug 2) (compilation-speed 3))) + (catch 'ct5 + (unwind-protect + (labels ((%f15 (f15-1 f15-2 f15-3) + (rational (throw 'ct5 0)))) + (%f15 0 + (apply #'%f15 + 0 + h + (progn + (progv '(*s2* *s5*) (list 0 (%f15 0 g 0)) b) + 0) + nil) + 0)) + (common-lisp:handler-case 0))))) + 1 2 3)) + '(0))) + ;;; MISC.275 (assert diff --git a/version.lisp-expr b/version.lisp-expr index 466d441..9f01424 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.10.24" +"0.8.10.25" -- 1.7.10.4