;;; that we find to be related. Return whatever COMPONENT we actually
;;; merged into.
;;;
+;;; (Note: The analogous CMU CL code only scavenged call-based
+;;; dependencies, not closure dependencies. That seems to've been by
+;;; oversight, not by design, as per the bug reported by WHN on
+;;; cmucl-imp ca. 2001-11-29 and explained by DTC shortly after.)
+;;;
+;;; FIXME: Very likely we should be scavenging NLX-based dependencies
+;;; here too. OTOH, there's a lot of global weirdness in NLX handling,
+;;; so it might be taken care of some other way that I haven't figured
+;;; out yet. Perhaps the best way to address this would be to try to
+;;; construct a NLX-based test case which fails in the same way as the
+;;; closure-based test case on cmucl-imp 2001-11-29.)
+;;;
;;; If the function is in an initial component, then we move its head
;;; and tail to COMPONENT and add it to COMPONENT's lambdas. It is
;;; harmless to move the tail (even though the return might be
(let ((return-block (node-block return)))
(link-blocks return-block (component-tail component))
(unlink-blocks return-block (component-tail old-lambda-component))))
- (let ((calls (if (eq (functional-kind fun) :external)
- (append (find-reference-funs fun)
- (lambda-calls fun))
- (lambda-calls fun))))
- (do ((res (find-initial-dfo-aux bind-block component)
- (dfo-scavenge-dependency-graph (first remaining-calls) res))
- (remaining-calls calls (rest remaining-calls)))
- ((null remaining-calls)
- res)
- (declare (type component res))))))))
-
-;;; Return true if FUN is either an XEP or has EXITS to some of its
+ (let ((res (find-initial-dfo-aux bind-block component)))
+ (declare (type component res))
+ ;; Scavenge call relationships.
+ (let ((calls (if (eq (functional-kind fun) :external)
+ (append (find-reference-funs fun)
+ (lambda-calls fun))
+ (lambda-calls fun))))
+ (dolist (call calls)
+ (setf res (dfo-scavenge-dependency-graph call res))))
+ ;; TO DO: Scavenge closure-over relationships.
+ (values)
+ ;; Voila.
+ res)))))
+
+;;; Return true if FUN either is an XEP or has EXITS to some of its
;;; ENTRIES.
(defun has-xep-or-nlx (fun)
(declare (type clambda fun))
;;; the LEXENV-LAMBDA may be deleted, we must chain up the
;;; LAMBDA-CALL-LEXENV thread until we find a CLAMBDA that isn't
;;; deleted, and then return its home.
-(declaim (maybe-inline node-home-lambda))
(defun node-home-lambda (node)
(declare (type node node))
(do ((fun (lexenv-lambda (node-lexenv node))
(when (eq (lambda-home fun) fun)
(return fun))))
-#!-sb-fluid (declaim (inline node-block node-tlf-number))
-(declaim (maybe-inline node-physenv))
(defun node-block (node)
(declare (type node node))
(the cblock (continuation-block (node-prev node))))
(defun node-physenv (node)
(declare (type node node))
- #!-sb-fluid (declare (inline node-home-lambda))
(the physenv (lambda-physenv (node-home-lambda node))))
-#!-sb-fluid (declaim (maybe-inline lambda-block))
(defun lambda-block (clambda)
(declare (type clambda clambda))
(node-block (lambda-bind clambda)))
(defun lambda-component (clambda)
- (declare (inline lambda-block))
(block-component (lambda-block clambda)))
;;; Return the enclosing cleanup for environment of the first or last
;;; Return the non-LET LAMBDA that holds BLOCK's code.
(defun block-home-lambda (block)
(declare (type cblock block))
- #!-sb-fluid (declare (inline node-home-lambda))
(if (node-p (block-last block))
;; This is the old CMU CL way of doing it.
(node-home-lambda (block-last block))
;;; Return the IR1 physical environment for BLOCK.
(defun block-physenv (block)
(declare (type cblock block))
- #!-sb-fluid (declare (inline node-home-lambda))
(lambda-physenv (block-home-lambda block)))
;;; Return the Top Level Form number of PATH, i.e. the ordinal number
;;;; flow/DFO/component hackery
;;; Join BLOCK1 and BLOCK2.
-#!-sb-fluid (declaim (inline link-blocks))
(defun link-blocks (block1 block2)
(declare (type cblock block1 block2))
(setf (block-succ block1)
(elt (combination-args (let-combination fun))
(position-or-lose var (lambda-vars fun)))))
-;;; Return the LAMBDA that is called by the local Call.
-#!-sb-fluid (declaim (inline combination-lambda))
+;;; Return the LAMBDA that is called by the local CALL.
(defun combination-lambda (call)
(declare (type basic-combination call))
(aver (eq (basic-combination-kind call) :local))
projects / sbcl.git / commitdiff