;; 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)
- (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)
;; 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
(:aborted
(setf (combination-kind node) :error)
(when args
- (apply #'compiler-warn args))
+ (apply #'warn args))
(remhash node table)
nil)
(:failure
(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)
(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 (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)
(unless next-block
(when ctran (ensure-block-start ctran))
(setq next-block (first (block-succ (node-block cast))))
- (ensure-block-start (node-prev cast)))
+ (ensure-block-start (node-prev cast))
+ (reoptimize-lvar lvar)
+ (setf (lvar-%derived-type value) nil))
(%delete-lvar-use use)
(add-lvar-use use lvar)
(unlink-blocks (node-block use) (node-block cast))