From: William Harold Newman Date: Sat, 8 Dec 2001 15:44:23 +0000 (+0000) Subject: 0.pre7.86.flaky7.25: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a574765d57a2a288d292dec59b9429e01be37052;p=sbcl.git 0.pre7.86.flaky7.25: (This passes regression tests, and seems to be a good thing in principle, but alas the generalization to include ENTRYs still doesn't fix the debugger restart problem.) generalized LAMBDA-CALLS-OR-CLOSES to include ENTRYs --- diff --git a/BUGS b/BUGS index 2f5f538..3231df6 100644 --- a/BUGS +++ b/BUGS @@ -1315,6 +1315,17 @@ Error in function C::GET-LAMBDA-TO-COMPILE: types manually, allowing the special case (VALUES) but still excluding all more-complex VALUES types. +134: + (reported by Alexey Dejneka sbcl-devel 2001-12-07) + (let ((s '((1 2 3)))) + (eval (eval ``(vector ,@',@s)))) + + should return #(1 2 3), instead of this it causes a reader error. + + Interior call of BACKQUOTIFY erroneously optimizes ,@': it immediately + splices the temporal representation of ,@S. + + KNOWN BUGS RELATED TO THE IR1 INTERPRETER (Now that the IR1 interpreter has gone away, these should be diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index a135cd5..8cd45d4 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -256,28 +256,41 @@ (let ((res (find-initial-dfo-aux bind-block component))) (declare (type component res)) ;; Scavenge related lambdas. - (flet (;; Scavenge call relationship. - (scavenge-call (call) - (let ((call-home (lambda-home call))) - (setf res (dfo-scavenge-dependency-graph call-home res)))) - ;; Scavenge closure-over relationship: if FUN refers to a - ;; variable whose home lambda is not FUN, then the home lambda - ;; should be in the same component as FUN. (sbcl-0.6.13, and - ;; CMU CL, didn't do this, leading to the occasional failure - ;; when physenv analysis, which is local to each component, - ;; would bogusly conclude that a closed-over variable was - ;; unused and thus delete it. See e.g. cmucl-imp 2001-11-29.) - (scavenge-closure-var (var) - (unless (null (lambda-var-refs var)) ; i.e. unless deleted - (let ((var-home-home (lambda-home (lambda-var-home var)))) - (unless (eql (lambda-kind var-home-home) :deleted) - (setf res - (dfo-scavenge-dependency-graph var-home-home - res))))))) + (labels ((scavenge-lambda (clambda) + (setf res + (dfo-scavenge-dependency-graph (lambda-home clambda) + res))) + (scavenge-possibly-deleted-lambda (clambda) + (unless (eql (lambda-kind clambda) :deleted) + (scavenge-lambda clambda))) + ;; Scavenge call relationship. + (scavenge-call (called-lambda) + (scavenge-lambda called-lambda)) + ;; Scavenge closure over a variable: if CLAMBDA + ;; refers to a variable whose home lambda is not + ;; CLAMBDA, then the home lambda should be in the + ;; same component as CLAMBDA. (sbcl-0.6.13, and CMU + ;; CL, didn't do this, leading to the occasional + ;; failure when physenv analysis, which is local to + ;; each component, would bogusly conclude that a + ;; closed-over variable was unused and thus delete + ;; it. See e.g. cmucl-imp 2001-11-29.) + (scavenge-closure-var (var) + (unless (null (lambda-var-refs var)) ; unless var deleted + (let ((var-home-home (lambda-home (lambda-var-home var)))) + (scavenge-possibly-deleted-lambda var-home-home)))) + ;; Scavenge closure over an entry for nonlocal exit. + ;; This is basically parallel to closure over a + ;; variable above. + (scavenge-entry (entry) + (declare (type entry entry)) + (let ((entry-home (node-home-lambda entry))) + (scavenge-possibly-deleted-lambda entry-home)))) (dolist (cc (lambda-calls-or-closes clambda)) (etypecase cc (clambda (scavenge-call cc)) - (lambda-var (scavenge-closure-var cc)))) + (lambda-var (scavenge-closure-var cc)) + (entry (scavenge-entry cc)))) (when (eq (lambda-kind clambda) :external) (mapc #'scavenge-call (find-reference-funs clambda)))) ;; Voila. diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 8b0f852..63bc884 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -85,8 +85,7 @@ (ir1-convert-progn-body dummy cont forms)))) -(def-ir1-translator return-from ((name &optional value) - start cont) +(def-ir1-translator return-from ((name &optional value) start cont) #!+sb-doc "Return-From Block-Name Value-Form Evaluate the Value-Form, returning its values from the lexically enclosing @@ -117,6 +116,9 @@ (setf (continuation-dest value-cont) exit) (ir1-convert start value-cont value) (prev-link exit value-cont) + (let ((home-lambda (continuation-home-lambda-or-null start))) + (when home-lambda + (push entry (lambda-calls-or-closes home-lambda)))) (use-continuation exit (second found)))) ;;; Return a list of the segments of a TAGBODY. Each segment looks @@ -197,11 +199,15 @@ is constrained to be used only within the dynamic extent of the TAGBODY." (continuation-starts-block cont) (let* ((found (or (lexenv-find tag tags :test #'eql) - (compiler-error "Go to nonexistent tag: ~S." tag))) + (compiler-error "attempt to GO to nonexistent tag: ~S" + tag))) (entry (first found)) (exit (make-exit :entry entry))) (push exit (entry-exits entry)) (prev-link exit start) + (let ((home-lambda (continuation-home-lambda-or-null start))) + (when home-lambda + (push entry (lambda-calls-or-closes home-lambda)))) (use-continuation exit (second found)))) ;;;; translators for compiler-magic special forms diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 484ba63..c6bba14 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -1241,12 +1241,12 @@ ;;; original exit continuation is the exit node's CONT. (defstruct (exit (:include node) (:copier nil)) - ;; The Entry node that this is an exit for. If null, this is a + ;; the ENTRY node that this is an exit for. If null, this is a ;; degenerate exit. A degenerate exit is used to "fill" an empty ;; block (which isn't allowed in IR1.) In a degenerate exit, Value ;; is always also null. (entry nil :type (or entry null)) - ;; The continuation yeilding the value we are to exit with. If NIL, + ;; the continuation yielding the value we are to exit with. If NIL, ;; then no value is desired (as in GO). (value nil :type (or continuation null))) (defprinter (exit :identity t) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index 0353031..1a40424 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -515,7 +515,7 @@ ;; the type constraint as a Lisp function type. ;; ;; If RESULT-TYPES is :CONDITIONAL, then this is an IF-FOO style - ;; conditional that yeilds its result as a control transfer. The + ;; conditional that yields its result as a control transfer. The ;; emit function takes two info arguments: the target label and a ;; boolean flag indicating whether to negate the sense of the test. (arg-types nil :type list) diff --git a/version.lisp-expr b/version.lisp-expr index c166669..350fa31 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.86.flaky7.24" +"0.pre7.86.flaky7.25"