(values))
;;; Replace all uses of OLD with uses of NEW, where NEW has an
-;;; arbitary number of uses.
-(defun substitute-lvar-uses (new old)
+;;; arbitary number of uses. NEW is supposed to be "later" than OLD.
+(defun substitute-lvar-uses (new old propagate-dx)
(declare (type lvar old)
- (type (or lvar null) new))
-
- (cond (new (do-uses (node old)
- (%delete-lvar-use node)
- (add-lvar-use node new))
- (reoptimize-lvar new))
+ (type (or lvar null) new)
+ (type boolean propagate-dx))
+
+ (cond (new
+ (do-uses (node old)
+ (%delete-lvar-use node)
+ (add-lvar-use node new))
+ (reoptimize-lvar new)
+ (awhen (and propagate-dx (lvar-dynamic-extent old))
+ (setf (lvar-dynamic-extent old) nil)
+ (unless (lvar-dynamic-extent new)
+ (setf (lvar-dynamic-extent new) it)
+ (setf (cleanup-info it) (substitute new old (cleanup-info it)))))
+ (when (lvar-dynamic-extent new)
+ (do-uses (node new)
+ (node-ends-block node))))
(t (flush-dest old)))
+
(values))
\f
;;;; block starting/creation
(when (and (basic-combination-p use)
(eq (basic-combination-kind use) :local))
(merges use))))
+ (substitute-lvar-uses lvar value
+ (and lvar (eq (lvar-uses lvar) node)))
(%delete-lvar-use node)
- (substitute-lvar-uses lvar value)
(prog1
(unlink-node node)
(dolist (merge (merges))
(defun node-dest (node)
(awhen (node-lvar node) (lvar-dest it)))
+#!-sb-fluid (declaim (inline node-stack-allocate-p))
+(defun node-stack-allocate-p (node)
+ (awhen (node-lvar node)
+ (lvar-dynamic-extent it)))
+
(declaim (inline block-to-be-deleted-p))
(defun block-to-be-deleted-p (block)
(or (block-delete-p block)
type-restrictions
(lambda (lexenv-lambda default))
(cleanup (lexenv-cleanup default))
+ (handled-conditions (lexenv-handled-conditions default))
+ (disabled-package-locks
+ (lexenv-disabled-package-locks default))
(policy (lexenv-policy default)))
(macrolet ((frob (var slot)
`(let ((old (,slot default)))
(frob blocks lexenv-blocks)
(frob tags lexenv-tags)
(frob type-restrictions lexenv-type-restrictions)
- lambda cleanup policy)))
+ lambda cleanup handled-conditions
+ disabled-package-locks policy)))
;;; Makes a LEXENV, suitable for using in a MACROLET introduced
;;; macroexpander
(lexenv-type-restrictions lexenv) ; XXX
nil
nil
+ (lexenv-handled-conditions lexenv)
+ (lexenv-disabled-package-locks lexenv)
(lexenv-policy lexenv))))
\f
;;;; flow/DFO/component hackery
;;; end. The tricky thing is a special cleanup block; all its nodes
;;; have the same cleanup info, corresponding to the start, so the
;;; same approach returns safe result.
-(defun map-block-nlxes (fun block)
+(defun map-block-nlxes (fun block &optional dx-cleanup-fun)
(loop for cleanup = (block-end-cleanup block)
then (node-enclosing-cleanup (cleanup-mess-up cleanup))
while cleanup
(aver (combination-p mess-up))
(let* ((arg-lvar (first (basic-combination-args mess-up)))
(nlx-info (constant-value (ref-leaf (lvar-use arg-lvar)))))
- (funcall fun nlx-info)))))))
+ (funcall fun nlx-info)))
+ ((:dynamic-extent)
+ (when dx-cleanup-fun
+ (funcall dx-cleanup-fun cleanup)))))))
;;; Set the FLAG for all the blocks in COMPONENT to NIL, except for
;;; the head and tail which are set to T.
;; There's no reason to accept this kind of equivocation
;; when compiling our own code, though.
#+sb-xc-host
- (compiler-warn "The variable ~S is defined but never used."
- (leaf-debug-name var)))
+ (warn "The variable ~S is defined but never used."
+ (leaf-debug-name var)))
(setf (leaf-ever-used var) t)))) ; to avoid repeated warnings? -- WHN
(values))
;; arbitrarily huge blocks of code. -- WHN)
(let ((*compiler-error-context* node))
(compiler-notify "*INLINE-EXPANSION-LIMIT* (~W) was exceeded, ~
- probably trying to~% ~
- inline a recursive function."
+ probably trying to~% ~
+ inline a recursive function."
*inline-expansion-limit*))
nil)
(t t))))