From: Alexey D. <ade...@us...> - 2003-09-17 06:45:51
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1:/tmp/cvs-serv8040/src/compiler Modified Files: ir1tran-lambda.lisp ir1util.lisp node.lisp Log Message: 0.8.3.73: * DELETE-LAMBDA: delete also contained lambdas. Index: ir1tran-lambda.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran-lambda.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- ir1tran-lambda.lisp 16 Sep 2003 07:45:08 -0000 1.12 +++ ir1tran-lambda.lisp 17 Sep 2003 06:45:45 -0000 1.13 @@ -293,6 +293,10 @@ (result-ctran (make-ctran)) (result-lvar (make-lvar))) + (awhen (lexenv-lambda *lexenv*) + (push lambda (lambda-children it)) + (setf (lambda-parent lambda) it)) + ;; just to check: This function should fail internal assertions if ;; we didn't set up a valid debug name above. ;; Index: ir1util.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1util.lisp,v retrieving revision 1.75 retrieving revision 1.76 diff -u -d -r1.75 -r1.76 --- ir1util.lisp 16 Sep 2003 09:45:15 -0000 1.75 +++ ir1util.lisp 17 Sep 2003 06:45:45 -0000 1.76 @@ -772,12 +772,12 @@ (clambda (delete-lambda fun))) (values)) -;;; Deal with deleting the last reference to a CLAMBDA. Since there is -;;; only one way into a CLAMBDA, deleting the last reference to a -;;; CLAMBDA ensures that there is no way to reach any of the code in -;;; it. So we just set the FUNCTIONAL-KIND for FUN and its LETs to -;;; :DELETED, causing IR1 optimization to delete blocks in that -;;; CLAMBDA. +;;; Deal with deleting the last reference to a CLAMBDA. It is called +;;; in two situations: when the lambda is unreachable (so that its +;;; body mey be deleted), and when it is an effectless LET (in this +;;; case its body is reachable and is not completely "its"). We set +;;; FUNCTIONAL-KIND to :DELETED and rely on IR1-OPTIMIZE to delete its +;;; blocks. (defun delete-lambda (clambda) (declare (type clambda clambda)) (let ((original-kind (functional-kind clambda)) @@ -786,6 +786,16 @@ (aver (not (functional-has-external-references-p clambda))) (setf (functional-kind clambda) :deleted) (setf (lambda-bind clambda) nil) + + (when bind ; CLAMBDA is deleted due to unreachability + (labels ((delete-children (lambda) + (dolist (child (lambda-children lambda)) + (if (eq (functional-kind child) :deleted) + (delete-children child) + (delete-lambda child)) + (setf (lambda-children lambda) nil)) + (setf (lambda-parent lambda) nil))) + (delete-children clambda))) (dolist (let (lambda-lets clambda)) (setf (lambda-bind let) nil) (setf (functional-kind let) :deleted)) Index: node.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/node.lisp,v retrieving revision 1.44 retrieving revision 1.45 diff -u -d -r1.44 -r1.45 --- node.lisp 16 Sep 2003 07:45:10 -0000 1.44 +++ node.lisp 17 Sep 2003 06:45:45 -0000 1.45 @@ -918,7 +918,10 @@ ;; retain it so that if the LET is deleted (due to a lack of vars), ;; we will still have caller's lexenv to figure out which cleanup is ;; in effect. - (call-lexenv nil :type (or lexenv null))) + (call-lexenv nil :type (or lexenv null)) + ;; list of embedded lambdas + (children nil :type list) + (parent nil :type (or clambda null))) (defprinter (clambda :conc-name lambda- :identity t) %source-name %debug-name |