From 975f1932acc3a8e90fb31d2b055bfbdde78ea927 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 26 Sep 2007 16:00:44 +0000 Subject: [PATCH] 1.0.10.7: multiply-used DX LVARS * HANDLE-NESTED-DYNAMIC-EXTENT maps over all the uses of the LVAR, collecting their argument lvars as well. * RECHECK-DYNAMIC-EXTENT-LVARS accepts multiply-used DX LVARs, checking that all uses support stack allocation. * UPDATE-UVL-LIVE-SETS accepts multiply-used DX LVARs, doing that lifetime merging with all uses. * ...and OOPS, move the NEWS entries of .5 and .6 to a new section for 1.0.11... --- NEWS | 15 ++++++++++----- OPTIMIZATIONS | 9 --------- src/compiler/locall.lisp | 17 +++++++++-------- src/compiler/physenvanal.lisp | 16 +++++++++------- src/compiler/stack.lisp | 33 ++++++++++++++++++--------------- tests/dynamic-extent.impure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 7 files changed, 58 insertions(+), 45 deletions(-) diff --git a/NEWS b/NEWS index 6d94097..835caeb 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,14 @@ ;;;; -*- coding: utf-8; -*- +changes in sbcl-1.0.11 relative to sbcl-1.0.10: + * enhancement: CONS can now stack-allocate on x86 and + x86-64. (Earlier LIST and LIST* supported stack-allocation, but + CONS did not.) + * enhancement: nested lists can now be stack allocated on + platforms providing stack allocation support. + * enhancement: dynamic-extent support has been extended to support + cases where there are multiple possible sources for the stack + allocated value. + changes in sbcl-1.0.10 relative to sbcl-1.0.9: * minor incompatible change: the MSI installer on Windows no longer associates .lisp and .fasl files with the installed SBCL. @@ -21,11 +31,6 @@ changes in sbcl-1.0.10 relative to sbcl-1.0.9: * optimization: UNION and NUNION are now O(N+M) for large inputs as long as the :TEST function is one of EQ, EQL, EQUAL, or EQUALP. - * enhancement: CONS can now stack-allocate on x86 and - x86-64. (Earlier LIST and LIST* supported stack-allocation, but - CONS did not:) - * enhancement: nested lists can now be stack allocated on - platforms providing stack allocation support. * enhancement: DEFINE-MODIFY-MACRO lambda-list information is now more readable in environments like Slime which display it. (thanks to Tobias C. Rittweiler) diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS index 47a7e41..0308f85 100644 --- a/OPTIMIZATIONS +++ b/OPTIMIZATIONS @@ -162,15 +162,6 @@ through TYPEP UNBOXED-ARRAY, within the compiler itself. rather than either constant-folding or manipulating NIL-VALUE or NULL-TN directly. -------------------------------------------------------------------------------- -#19 - (let ((dx (if (foo) - (list x) - (list y z)))) - (declare (dynamic-extent dx)) - ...) - -DX is not allocated on stack. --------------------------------------------------------------------------------- #20 (defun-with-dx foo (x) (flet ((make (x) diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 4fe1a0e..f9b8849 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -45,20 +45,21 @@ (defun handle-nested-dynamic-extent-lvars (arg) - (let ((use (lvar-uses arg))) + (let ((uses (lvar-uses arg))) ;; Stack analysis wants DX value generators to end their ;; blocks. Uses of mupltiple used LVARs already end their blocks, ;; so we just need to process used-once LVARs. - (when (node-p use) - (node-ends-block use)) + (when (node-p uses) + (node-ends-block uses) + (setf uses (list uses))) ;; If the function result is DX, so are its arguments... This ;; assumes that all our DX functions do not store their arguments ;; anywhere -- just use, and maybe return. - (if (basic-combination-p use) - (cons arg (funcall (lambda (lists) - (reduce #'append lists)) - (mapcar #'handle-nested-dynamic-extent-lvars (basic-combination-args use)))) - (list arg)))) + (cons arg + (loop for use in uses + when (basic-combination-p use) + nconc (loop for a in (basic-combination-args use) + append (handle-nested-dynamic-extent-lvars a)))))) (defun recognize-dynamic-extent-lvars (call fun) (declare (type combination call) (type clambda fun)) diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp index 481ce2e..af8fec3 100644 --- a/src/compiler/physenvanal.lisp +++ b/src/compiler/physenvanal.lisp @@ -335,14 +335,16 @@ do (etypecase what (lvar (let* ((lvar what) - (use (lvar-uses lvar))) - (if (and (combination-p use) - (eq (basic-combination-kind use) :known) - (awhen (fun-info-stack-allocate-result - (basic-combination-fun-info use)) - (funcall it use))) + (uses (lvar-uses lvar))) + (if (every (lambda (use) + (and (combination-p use) + (eq (basic-combination-kind use) :known) + (awhen (fun-info-stack-allocate-result + (basic-combination-fun-info use)) + (funcall it use)))) + (if (listp uses) uses (list uses))) (real-dx-lvars lvar) - (setf (lvar-dynamic-extent lvar) nil)))) + (setf (lvar-dynamic-extent lvar) nil)))) (node ; DX closure (let* ((call what) (arg (first (basic-combination-args call))) diff --git a/src/compiler/stack.lisp b/src/compiler/stack.lisp index 4ac4c7a..00730cb 100644 --- a/src/compiler/stack.lisp +++ b/src/compiler/stack.lisp @@ -61,6 +61,7 @@ ;;; been changed. (defun merge-uvl-live-sets (early late) (declare (type list early late)) + ;; FIXME: O(N^2) (dolist (e late early) (pushnew e early))) @@ -93,21 +94,23 @@ block (lambda (dx-cleanup) (dolist (lvar (cleanup-info dx-cleanup)) - (let* ((generator (lvar-use lvar)) - (block (node-block generator)) - (2block (block-info block))) - ;; DX objects, living in the LVAR, are - ;; alive in the environment, protected by - ;; the CLEANUP. We also cannot move them - ;; (because, in general, we cannot track - ;; all references to them). Therefore, - ;; everything, allocated deeper than a DX - ;; object, should be kept alive until the - ;; object is deallocated. - (setq new-end (merge-uvl-live-sets - new-end (ir2-block-end-stack 2block))) - (setq new-end (merge-uvl-live-sets - new-end (ir2-block-pushed 2block))))))) + (let ((uses (lvar-uses lvar))) + (dolist (generator (if (listp uses) uses (list uses))) + (let* ((block (node-block generator)) + (2block (block-info block))) + ;; DX objects, living in the LVAR, are + ;; alive in the environment, protected + ;; by the CLEANUP. We also cannot move + ;; them (because, in general, we cannot + ;; track all references to + ;; them). Therefore, everything, + ;; allocated deeper than a DX object, + ;; should be kept alive until the + ;; object is deallocated. + (setq new-end (merge-uvl-live-sets + new-end (ir2-block-end-stack 2block))) + (setq new-end (merge-uvl-live-sets + new-end (ir2-block-pushed 2block))))))))) (setf (ir2-block-end-stack 2block) new-end) diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp index 4ec3d4d..78923f3 100644 --- a/tests/dynamic-extent.impure.lisp +++ b/tests/dynamic-extent.impure.lisp @@ -160,6 +160,16 @@ (true dx) nil)) +;;; multiple uses for dx lvar + +(defun-with-dx multiple-dx-uses () + (let ((dx (if (true t) + (list 1 2 3) + (list 2 3 4)))) + (declare (dynamic-extent dx)) + (true dx) + nil)) + ;;; with-spinlock should use DX and not cons (defvar *slock* (sb-thread::make-spinlock :name "slocklock")) @@ -201,6 +211,7 @@ (assert-no-consing (cons-on-stack 42)) (assert-no-consing (nested-dx-conses)) (assert-no-consing (nested-dx-lists)) + (assert-no-consing (multiple-dx-uses)) ;; Not strictly DX.. (assert-no-consing (test-hash-table)) #+sb-thread diff --git a/version.lisp-expr b/version.lisp-expr index 61760db..a98686c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.10.6" +"1.0.10.7" -- 1.7.10.4