From: William Harold Newman Date: Sun, 2 Dec 2001 14:38:13 +0000 (+0000) Subject: 0.pre7.86.flaky7.15: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=dc038a23a34c53e44b6de20b3e391cc05470e4af;p=sbcl.git 0.pre7.86.flaky7.15: 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 --- diff --git a/src/assembly/x86/assem-rtns.lisp b/src/assembly/x86/assem-rtns.lisp index 867b2d9..108acb4 100644 --- a/src/assembly/x86/assem-rtns.lisp +++ b/src/assembly/x86/assem-rtns.lisp @@ -213,7 +213,7 @@ 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 @@ -234,7 +234,8 @@ (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. @@ -253,8 +254,8 @@ (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)))) diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index f509480..f747b65 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -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) @@ -89,12 +88,10 @@ (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)) @@ -103,7 +100,7 @@ ;;; 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. @@ -116,14 +113,14 @@ ;;; 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 @@ -154,10 +151,9 @@ ((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))))) @@ -190,9 +186,12 @@ (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 @@ -218,7 +217,7 @@ ;;; 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)) @@ -241,13 +240,12 @@ (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) @@ -359,7 +357,8 @@ ;; seem a better name than just "". (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)