projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.8.15.10:
[sbcl.git]
/
src
/
compiler
/
ir1opt.lisp
diff --git
a/src/compiler/ir1opt.lisp
b/src/compiler/ir1opt.lisp
index
3a5b8f1
..
909cd1f
100644
(file)
--- a/
src/compiler/ir1opt.lisp
+++ b/
src/compiler/ir1opt.lisp
@@
-336,12
+336,16
@@
;; thus the control transfer is a non-local exit.
(not (eq (block-home-lambda block)
(block-home-lambda next)))
;; thus the control transfer is a non-local exit.
(not (eq (block-home-lambda block)
(block-home-lambda next)))
- ;; Stack analysis phase wants ENTRY to start a block.
+ ;; Stack analysis phase wants ENTRY to start a block...
(entry-p (block-start-node next))
(let ((last (block-last block)))
(and (valued-node-p last)
(awhen (node-lvar last)
(entry-p (block-start-node next))
(let ((last (block-last block)))
(and (valued-node-p last)
(awhen (node-lvar last)
- (consp (lvar-uses it))))))
+ (or
+ ;; ... and a DX-allocator to end a block.
+ (lvar-dynamic-extent it)
+ ;; FIXME: This is a partial workaround for bug 303.
+ (consp (lvar-uses it)))))))
nil)
(t
(join-blocks block next)
nil)
(t
(join-blocks block next)
@@
-818,10
+822,11
@@
;; called semi-inlining? A more descriptive name would
;; be nice. -- WHN 2002-01-07
(frob ()
;; called semi-inlining? A more descriptive name would
;; be nice. -- WHN 2002-01-07
(frob ()
- (let ((res (ir1-convert-lambda-for-defun
- (defined-fun-inline-expansion leaf)
- leaf t
- #'ir1-convert-inline-lambda)))
+ (let ((res (let ((*allow-instrumenting* t))
+ (ir1-convert-lambda-for-defun
+ (defined-fun-inline-expansion leaf)
+ leaf t
+ #'ir1-convert-inline-lambda))))
(setf (defined-fun-functional leaf) res)
(change-ref-leaf ref res))))
(if ir1-converting-not-optimizing-p
(setf (defined-fun-functional leaf) res)
(change-ref-leaf ref res))))
(if ir1-converting-not-optimizing-p
@@
-977,7
+982,7
@@
(:aborted
(setf (combination-kind node) :error)
(when args
(:aborted
(setf (combination-kind node) :error)
(when args
- (apply #'compiler-warn args))
+ (apply #'warn args))
(remhash node table)
nil)
(:failure
(remhash node table)
nil)
(:failure
@@
-1084,10
+1089,9
@@
(block-next (node-block call)))
(let ((new-fun (ir1-convert-inline-lambda
res
(block-next (node-block call)))
(let ((new-fun (ir1-convert-inline-lambda
res
- :debug-name (debug-namify "LAMBDA-inlined ~A"
- (as-debug-name
- source-name
- "<unknown function>"))))
+ :debug-name (debug-namify "LAMBDA-inlined "
+ source-name
+ "<unknown function>")))
(ref (lvar-use (combination-fun call))))
(change-ref-leaf ref new-fun)
(setf (combination-kind call) :full)
(ref (lvar-use (combination-fun call))))
(change-ref-leaf ref new-fun)
(setf (combination-kind call) :full)
@@
-1311,7
+1315,8
@@
(dest (lvar-dest lvar)))
(when (and
;; Think about (LET ((A ...)) (IF ... A ...)): two
(dest (lvar-dest lvar)))
(when (and
;; Think about (LET ((A ...)) (IF ... A ...)): two
- ;; LVAR-USEs should not be met on one path.
+ ;; LVAR-USEs should not be met on one path. Another problem
+ ;; is with dynamic-extent.
(eq (lvar-uses lvar) ref)
(typecase dest
;; we should not change lifetime of unknown values lvars
(eq (lvar-uses lvar) ref)
(typecase dest
;; we should not change lifetime of unknown values lvars
@@
-1336,7
+1341,9
@@
(eq (node-home-lambda ref)
(lambda-home (lambda-var-home var))))
(setf (node-derived-type ref) *wild-type*)
(eq (node-home-lambda ref)
(lambda-home (lambda-var-home var))))
(setf (node-derived-type ref) *wild-type*)
- (substitute-lvar-uses lvar arg)
+ (substitute-lvar-uses lvar arg
+ ;; Really it is (EQ (LVAR-USES LVAR) REF):
+ t)
(delete-lvar-use ref)
(change-ref-leaf ref (find-constant nil))
(delete-ref ref)
(delete-lvar-use ref)
(change-ref-leaf ref (find-constant nil))
(delete-ref ref)