;;;; -*- 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.
* 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)
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)
(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))
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)))
;;; 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)))
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)
(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"))
(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
;;; 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"
projects / sbcl.git / commitdiff