From 69ef68ba7393e3492c1b4a756d1140f71c2922bc Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 19 Apr 2005 05:54:17 +0000 Subject: [PATCH] 0.8.21.50: * Changed implementation on ALLOCATE-VECTOR on X86: ... two VOPs: A-V-ON-HEAP and A-V-ON-STACK; ... choice between them is made with LTN-ANALYZEr; ... A-V-ON-STACK always fills vector with zeroes (fixes bug reported by Brian Downing). --- OPTIMIZATIONS | 6 +++ src/compiler/x86/alloc.lisp | 93 +++++++++++++++++++++++++++++--------- tests/dynamic-extent.impure.lisp | 8 ++++ version.lisp-expr | 2 +- 4 files changed, 87 insertions(+), 22 deletions(-) diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS index d8d018f..eb2931f 100644 --- a/OPTIMIZATIONS +++ b/OPTIMIZATIONS @@ -218,3 +218,9 @@ SBCL cannot derive upper bound for I and uses generic arithmetic here: (So the constraint propagator or a possible future SSA-convertor should know the connection between an NLE and its CLEANUP.) +-------------------------------------------------------------------------------- +#27 +Initialization of stack-allocated arrays is inefficient: we always +fill the vector with zeroes, even when it is not needed (as for +platforms with conservative GC or for arrays of unboxed objectes) and +is performed later explicitely. diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index 8d88174..4d2a18d 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -72,20 +72,9 @@ (:variant t)) ;;;; special-purpose inline allocators -(defoptimizer (allocate-vector stack-allocate-result) - ((type length words) node) - (ecase (policy node sb!c::stack-allocate-vector) - (0 nil) - ((1 2) - ;; a vector object should fit in one page - (values-subtypep (sb!c::lvar-derived-type words) - (load-time-value - (specifier-type `(integer 0 ,(- (/ *backend-page-size* - n-word-bytes) - vector-data-offset)))))) - (3 t))) -(define-vop (allocate-vector) +;;; ALLOCATE-VECTOR +(define-vop (allocate-vector-on-heap) (:args (type :scs (unsigned-reg)) (length :scs (any-reg)) (words :scs (any-reg))) @@ -93,6 +82,29 @@ (:arg-types positive-fixnum positive-fixnum positive-fixnum) + (:policy :fast-safe) + (:generator 100 + (inst lea result (make-ea :byte :base words :disp + (+ (1- (ash 1 n-lowtag-bits)) + (* vector-data-offset n-word-bytes)))) + (inst and result (lognot lowtag-mask)) + (pseudo-atomic + (allocation result result) + (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag)) + (storew type result 0 other-pointer-lowtag) + (storew length result vector-length-slot other-pointer-lowtag)))) + +(define-vop (allocate-vector-on-stack) + (:args (type :scs (unsigned-reg)) + (length :scs (any-reg)) + (words :scs (any-reg) :target ecx)) + (:temporary (:sc any-reg :offset ecx-offset :from (:argument 2)) ecx) + (:temporary (:sc any-reg :offset eax-offset :from (:argument 2)) zero) + (:temporary (:sc any-reg :offset edi-offset :from (:argument 0)) res) + (:results (result :scs (descriptor-reg) :from :load)) + (:arg-types positive-fixnum + positive-fixnum + positive-fixnum) (:translate allocate-vector) (:policy :fast-safe) (:node-var node) @@ -101,15 +113,54 @@ (+ (1- (ash 1 n-lowtag-bits)) (* vector-data-offset n-word-bytes)))) (inst and result (lognot lowtag-mask)) - (let ((stack-allocate-p (awhen (sb!c::node-lvar node) - (sb!c::lvar-dynamic-extent it)))) - (maybe-pseudo-atomic stack-allocate-p - ;; FIXME: It would be good to check for stack overflow here. - (allocation result result node stack-allocate-p) - (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag)) - (storew type result 0 other-pointer-lowtag) - (storew length result vector-length-slot other-pointer-lowtag))))) + ;; FIXME: It would be good to check for stack overflow here. + (move ecx words) + (inst shr ecx n-fixnum-tag-bits) + (allocation result result node t) + (inst cld) + (inst lea res + (make-ea :byte :base result :disp (* vector-data-offset n-word-bytes))) + (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag)) + (storew type result 0 other-pointer-lowtag) + (storew length result vector-length-slot other-pointer-lowtag) + (inst xor zero zero) + (inst rep) + (inst stos zero))) + +(in-package :sb!c) +(defoptimizer (allocate-vector stack-allocate-result) + ((type length words) node) + (ecase (policy node stack-allocate-vector) + (0 nil) + ((1 2) + ;; a vector object should fit in one page + (values-subtypep (lvar-derived-type words) + (load-time-value + (specifier-type `(integer 0 ,(- (/ sb!vm::*backend-page-size* + sb!vm:n-word-bytes) + sb!vm:vector-data-offset)))))) + (3 t))) + +(defoptimizer (allocate-vector ltn-annotate) ((type length words) call ltn-policy) + (let ((args (basic-combination-args call)) + (template (template-or-lose (if (awhen (node-lvar call) + (lvar-dynamic-extent it)) + 'sb!vm::allocate-vector-on-stack + 'sb!vm::allocate-vector-on-heap)))) + (dolist (arg args) + (setf (lvar-info arg) + (make-ir2-lvar (primitive-type (lvar-type arg))))) + (unless (is-ok-template-use template call (ltn-policy-safe-p ltn-policy)) + (ltn-default-call call) + (return-from allocate-vector-ltn-annotate-optimizer (values))) + (setf (basic-combination-info call) template) + (setf (node-tail-p call) nil) + + (dolist (arg args) + (annotate-1-value-lvar arg)))) +(in-package :sb!vm) +;;; (define-vop (allocate-code-object) (:args (boxed-arg :scs (any-reg) :target boxed) (unboxed-arg :scs (any-reg) :target unboxed)) diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp index 942be0d..cb436c3 100644 --- a/tests/dynamic-extent.impure.lisp +++ b/tests/dynamic-extent.impure.lisp @@ -145,5 +145,13 @@ ((1 1 1) (1 1 1) (1 1 1)))) 4)) +;;; bug reported by Brian Downing: stack-allocated arrays were not +;;; filled with zeroes. +(defun-with-dx bdowning-2005-iv-16 () + (let ((a (make-array 11 :initial-element 0))) + (declare (dynamic-extent a)) + (assert (every (lambda (x) (eql x 0)) a)))) +(bdowning-2005-iv-16) + (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index fabfdae..b8ef855 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".) -"0.8.21.49" +"0.8.21.50" -- 1.7.10.4