0.pre7.86.flaky7.15:
authorWilliam Harold Newman <william.newman@airmail.net>
Sun, 2 Dec 2001 14:38:13 +0000 (14:38 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Sun, 2 Dec 2001 14:38:13 +0000 (14:38 +0000)
s/walk-home/scavenge-home/ for consistency with old renamings
DTC's analysis of the regression test bug is that Python is
losing a variable because its home CLAMBDA is in one
COMPONENT while the closing-over CLAMBDA is in another
COMPONENT, and the one-COMPONENT-at-a-time physical
environment analysis isn't up to the challenge. Thus
Python deletes the apparently-unused variable and
things deteriorate from there. He produced a fix
involving special-casing top-level variables so that
physenv analysis never deletes them, but neither he
nor I was convinced that this covers all the bases.
So I'll try another approach, making FIND-INITIAL-DFO
treat the home/closure relationship as just as much
of a physical dependency as a function call, and so
prevent separation of the two CLAMBDAs into different
components. Thus...
...s/call-graph/dependency-graph/ to reflect intended
new behavior

src/assembly/x86/assem-rtns.lisp
src/compiler/dfo.lisp

index 867b2d9..108acb4 100644 (file)
 
   EXIT
 
-  ;; Hear EAX points to catch block containing symbol pointed to by EDX.
+  ;; Here EAX points to catch block containing symbol pointed to by EDX.
   (inst jmp (make-fixup 'unwind :assembly-routine)))
 
 ;;;; non-local exit noise
 
   (load-symbol-value uwp *current-unwind-protect-block*)
 
-  ;; Does *cuwpb* match value stored in argument cuwp slot?
+  ;; Does *CURRENT-UNWIND-PROTECT-BLOCK* match the value stored in
+  ;; argument's CURRENT-UWP-SLOT?
   (inst cmp uwp
        (make-ea-for-object-slot block unwind-block-current-uwp-slot 0))
   ;; If a match, return to context in arg block.
   (loadw ebp-tn block unwind-block-current-cont-slot)
 
   ;; Uwp-entry expects some things in known locations so that they can
-  ;; be saved on the stack: the block in edx-tn; start in ebx-tn; and
-  ;; count in ecx-tn
+  ;; be saved on the stack: the block in edx-tn, start in ebx-tn, and
+  ;; count in ecx-tn.
 
   (inst jmp (make-ea :byte :base block
                     :disp (* unwind-block-entry-pc-slot n-word-bytes))))
index f509480..f747b65 100644 (file)
@@ -25,7 +25,6 @@
           (unless (block-flag ep)
             (find-dfo-aux ep head component)
             (return nil))))))
-
   (let ((num 0))
     (declare (fixnum num))
     (do-blocks-backwards (block component :both)
 (defun find-dfo-aux (block head component)
   (unless (eq (block-component block) component)
     (join-components component (block-component block)))
-       
   (unless (block-flag block)
     (setf (block-flag block) t)
     (dolist (succ (block-succ block))
       (find-dfo-aux succ head component))
-
     (remove-from-dfo block)
     (add-to-dfo block head))
   (values))
 ;;; before it walks the successors. It looks at the home CLAMBDA's
 ;;; BIND block to see whether that block is in some other component:
 ;;; -- If the block is in the initial component, then do
-;;;    DFO-WALK-CALL-GRAPH on the home function to move it
+;;;    DFO-WALK-DEPENDENCY-GRAPH on the home function to move it
 ;;;    into COMPONENT.
 ;;; -- If the block is in some other component, join COMPONENT into
 ;;;    it and return that component.
 ;;; the same component, even when they might not seem reachable from
 ;;; the environment entry. Consider the case of code that is only
 ;;; reachable from a non-local exit.
-(defun walk-home-call-graph (block component)
+(defun scavenge-home-dependency-graph (block component)
   (declare (type cblock block) (type component component))
   (let ((home-lambda (block-home-lambda block)))
     (if (eq (functional-kind home-lambda) :deleted)
        component
        (let ((home-component (lambda-component home-lambda)))
          (cond ((eq (component-kind home-component) :initial)
-                (dfo-scavenge-call-graph home-lambda component))
+                (dfo-scavenge-dependency-graph home-lambda component))
                ((eq home-component component)
                 component)
                (t
      ((block-flag block) component)
      (t
       (setf (block-flag block) t)
-      (let ((current (walk-home-call-graph block component)))
+      (let ((current (scavenge-home-dependency-graph block component)))
        (dolist (succ (block-succ block))
          (setq current (find-initial-dfo-aux succ current)))
-       
        (remove-from-dfo block)
        (add-to-dfo block (component-head current))
        current)))))
          (res home))))
     (res)))
 
-;;; Move the code for FUN and all functions called by it into
-;;; COMPONENT. If FUN is already in COMPONENT, then we just return
-;;; that component.
+;;; If FUN is not already in COMPONENT, just return that component.
+;;; Otherwise, move the code for FUN and all functions it physically
+;;; depends on (either because of calls or because of closure
+;;; relationships) into COMPONENT, or possibly into another COMPONENT
+;;; that we find to be related. Return whatever COMPONENT we actually
+;;; merged into.
 ;;;
 ;;; 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
 ;;; ensures that conversion of a full call to a local call won't
 ;;; result in a need to join components, since the components will
 ;;; already be one.
-(defun dfo-scavenge-call-graph (fun component)
+(defun dfo-scavenge-dependency-graph (fun component)
   (declare (type clambda fun) (type component component))
   (let* ((bind-block (node-block (lambda-bind fun)))
         (old-lambda-component (block-component bind-block))
        (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-call-graph (first remaining-calls) res))
+                 (dfo-scavenge-dependency-graph (first remaining-calls) res))
             (remaining-calls calls (rest remaining-calls)))
            ((null remaining-calls)
             res)
                  ;; seem a better name than just "<unknown>".
                  (component-name-from-functional-debug-name
                   component-lambda)))
-         (let ((res (dfo-scavenge-call-graph component-lambda new-component)))
+         (let ((res (dfo-scavenge-dependency-graph component-lambda
+                                                   new-component)))
            (when (eq res new-component)
              (aver (not (position new-component (components))))
              (components new-component)