;;; has changed.
(declaim (ftype (function (node continuation) (values)) add-continuation-use))
(defun add-continuation-use (node cont)
;;; has changed.
(declaim (ftype (function (node continuation) (values)) add-continuation-use))
(defun add-continuation-use (node cont)
(setf (continuation-block cont) block))
(setf (continuation-kind cont) :inside-block)
(setf (continuation-use cont) node))
(setf (continuation-block cont) block))
(setf (continuation-kind cont) :inside-block)
(setf (continuation-use cont) node))
;;; potential optimization opportunities.
(defun substitute-continuation (new old)
(declare (type continuation old new))
;;; potential optimization opportunities.
(defun substitute-continuation (new old)
(declare (type continuation old new))
(defun %link-blocks (block1 block2)
(declare (type cblock block1 block2) (inline member))
(let ((succ1 (block-succ block1)))
(defun %link-blocks (block1 block2)
(declare (type cblock block1 block2) (inline member))
(let ((succ1 (block-succ block1)))
(declare (type cblock block after))
(let ((next (block-next after))
(comp (block-component after)))
(declare (type cblock block after))
(let ((next (block-next after))
(comp (block-component after)))
(setf (block-component block) comp)
(setf (block-next after) block)
(setf (block-prev block) after)
(setf (block-component block) comp)
(setf (block-next after) block)
(setf (block-prev block) after)
;;; be called on functions that never had any references, since otherwise
;;; DELETE-REF will handle the deletion.
(defun delete-functional (fun)
;;; be called on functions that never had any references, since otherwise
;;; DELETE-REF will handle the deletion.
(defun delete-functional (fun)
(declare (type clambda leaf))
(let ((kind (functional-kind leaf))
(bind (lambda-bind leaf)))
(declare (type clambda leaf))
(let ((kind (functional-kind leaf))
(bind (lambda-bind leaf)))
(setf (functional-kind leaf) :deleted)
(setf (lambda-bind leaf) nil)
(dolist (let (lambda-lets leaf))
(setf (functional-kind leaf) :deleted)
(setf (lambda-bind leaf) nil)
(dolist (let (lambda-lets leaf))
(let* ((bind-block (node-block bind))
(component (block-component bind-block))
(return (lambda-return leaf)))
(let* ((bind-block (node-block bind))
(component (block-component bind-block))
(return (lambda-return leaf)))
(unless (leaf-ever-used leaf)
(let ((*compiler-error-context* bind))
(compiler-note "deleting unused function~:[.~;~:*~% ~S~]"
(unless (leaf-ever-used leaf)
(let ((*compiler-error-context* bind))
(compiler-note "deleting unused function~:[.~;~:*~% ~S~]"
(declare (type optional-dispatch leaf))
(let ((entry (functional-entry-function leaf)))
(unless (and entry (leaf-refs entry))
(declare (type optional-dispatch leaf))
(let ((entry (functional-entry-function leaf)))
(unless (and entry (leaf-refs entry))
;;; people to ignore them, and to cause them to be deleted eventually.
(defun delete-continuation (cont)
(declare (type continuation cont))
;;; people to ignore them, and to cause them to be deleted eventually.
(defun delete-continuation (cont)
(declare (type continuation cont))
-;;; This function does what is necessary to eliminate the code in it from
-;;; the IR1 representation. This involves unlinking it from its predecessors
-;;; and successors and deleting various node-specific semantic information.
+;;; This function does what is necessary to eliminate the code in it
+;;; from the IR1 representation. This involves unlinking it from its
+;;; predecessors and successors and deleting various node-specific
+;;; semantic information.
-;;; We mark the Start as has having no next and remove the last node from
-;;; its Cont's uses. We also flush the DEST for all continuations whose values
-;;; are received by nodes in the block.
+;;; We mark the START as has having no next and remove the last node
+;;; from its CONT's uses. We also flush the DEST for all continuations
+;;; whose values are received by nodes in the block.
(defun delete-return (node)
(declare (type creturn node))
(let ((fun (return-lambda node)))
(defun delete-return (node)
(declare (type creturn node))
(let ((fun (return-lambda node)))
(unless (eq (continuation-kind cont) :deleted)
(delete-continuation-use node)
(when (eq (continuation-kind cont) :unused)
(unless (eq (continuation-kind cont) :deleted)
(delete-continuation-use node)
(when (eq (continuation-kind cont) :unused)
(unlink-blocks block next)
(dolist (pred (block-pred block))
(change-block-successor pred block next))
(unlink-blocks block next)
(dolist (pred (block-pred block))
(change-block-successor pred block next))
(setf (component-kind component) :deleted)
(do-blocks (block component)
(setf (block-delete-p block) t))
(setf (component-kind component) :deleted)
(do-blocks (block component)
(setf (block-delete-p block) t))
;;; Return the COMBINATION node that is the call to the let Fun.
(defun let-combination (fun)
(declare (type clambda fun))
;;; Return the COMBINATION node that is the call to the let Fun.
(defun let-combination (fun)
(declare (type clambda fun))
(continuation-dest (node-cont (first (leaf-refs fun)))))
;;; Return the initial value continuation for a let variable or NIL if none.
(continuation-dest (node-cont (first (leaf-refs fun)))))
;;; Return the initial value continuation for a let variable or NIL if none.
#!-sb-fluid (declaim (inline combination-lambda))
(defun combination-lambda (call)
(declare (type basic-combination call))
#!-sb-fluid (declaim (inline combination-lambda))
(defun combination-lambda (call)
(declare (type basic-combination call))
;;; the source path for the bind node for an arbitrary entry point to
;;; find the source context, then return that as a string.
(declaim (ftype (function (component) simple-string) find-component-name))
(defun find-component-name (component)
(let ((ep (first (block-succ (component-head component)))))
;;; the source path for the bind node for an arbitrary entry point to
;;; find the source context, then return that as a string.
(declaim (ftype (function (component) simple-string) find-component-name))
(defun find-component-name (component)
(let ((ep (first (block-succ (component-head component)))))