Skip to content
This repository
Browse code

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).
  • Loading branch information...
commit 69ef68ba7393e3492c1b4a756d1140f71c2922bc 1 parent 343ef95
Alexey Dejneka authored
6 OPTIMIZATIONS
@@ -218,3 +218,9 @@ SBCL cannot derive upper bound for I and uses generic arithmetic here:
218 218
219 219 (So the constraint propagator or a possible future SSA-convertor
220 220 should know the connection between an NLE and its CLEANUP.)
  221 +--------------------------------------------------------------------------------
  222 +#27
  223 +Initialization of stack-allocated arrays is inefficient: we always
  224 +fill the vector with zeroes, even when it is not needed (as for
  225 +platforms with conservative GC or for arrays of unboxed objectes) and
  226 +is performed later explicitely.
93 src/compiler/x86/alloc.lisp
@@ -72,20 +72,9 @@
72 72 (:variant t))
73 73
74 74 ;;;; special-purpose inline allocators
75   -(defoptimizer (allocate-vector stack-allocate-result)
76   - ((type length words) node)
77   - (ecase (policy node sb!c::stack-allocate-vector)
78   - (0 nil)
79   - ((1 2)
80   - ;; a vector object should fit in one page
81   - (values-subtypep (sb!c::lvar-derived-type words)
82   - (load-time-value
83   - (specifier-type `(integer 0 ,(- (/ *backend-page-size*
84   - n-word-bytes)
85   - vector-data-offset))))))
86   - (3 t)))
87 75
88   -(define-vop (allocate-vector)
  76 +;;; ALLOCATE-VECTOR
  77 +(define-vop (allocate-vector-on-heap)
89 78 (:args (type :scs (unsigned-reg))
90 79 (length :scs (any-reg))
91 80 (words :scs (any-reg)))
@@ -93,6 +82,29 @@
93 82 (:arg-types positive-fixnum
94 83 positive-fixnum
95 84 positive-fixnum)
  85 + (:policy :fast-safe)
  86 + (:generator 100
  87 + (inst lea result (make-ea :byte :base words :disp
  88 + (+ (1- (ash 1 n-lowtag-bits))
  89 + (* vector-data-offset n-word-bytes))))
  90 + (inst and result (lognot lowtag-mask))
  91 + (pseudo-atomic
  92 + (allocation result result)
  93 + (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
  94 + (storew type result 0 other-pointer-lowtag)
  95 + (storew length result vector-length-slot other-pointer-lowtag))))
  96 +
  97 +(define-vop (allocate-vector-on-stack)
  98 + (:args (type :scs (unsigned-reg))
  99 + (length :scs (any-reg))
  100 + (words :scs (any-reg) :target ecx))
  101 + (:temporary (:sc any-reg :offset ecx-offset :from (:argument 2)) ecx)
  102 + (:temporary (:sc any-reg :offset eax-offset :from (:argument 2)) zero)
  103 + (:temporary (:sc any-reg :offset edi-offset :from (:argument 0)) res)
  104 + (:results (result :scs (descriptor-reg) :from :load))
  105 + (:arg-types positive-fixnum
  106 + positive-fixnum
  107 + positive-fixnum)
96 108 (:translate allocate-vector)
97 109 (:policy :fast-safe)
98 110 (:node-var node)
@@ -101,15 +113,54 @@
101 113 (+ (1- (ash 1 n-lowtag-bits))
102 114 (* vector-data-offset n-word-bytes))))
103 115 (inst and result (lognot lowtag-mask))
104   - (let ((stack-allocate-p (awhen (sb!c::node-lvar node)
105   - (sb!c::lvar-dynamic-extent it))))
106   - (maybe-pseudo-atomic stack-allocate-p
107   - ;; FIXME: It would be good to check for stack overflow here.
108   - (allocation result result node stack-allocate-p)
109   - (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
110   - (storew type result 0 other-pointer-lowtag)
111   - (storew length result vector-length-slot other-pointer-lowtag)))))
  116 + ;; FIXME: It would be good to check for stack overflow here.
  117 + (move ecx words)
  118 + (inst shr ecx n-fixnum-tag-bits)
  119 + (allocation result result node t)
  120 + (inst cld)
  121 + (inst lea res
  122 + (make-ea :byte :base result :disp (* vector-data-offset n-word-bytes)))
  123 + (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
  124 + (storew type result 0 other-pointer-lowtag)
  125 + (storew length result vector-length-slot other-pointer-lowtag)
  126 + (inst xor zero zero)
  127 + (inst rep)
  128 + (inst stos zero)))
  129 +
  130 +(in-package :sb!c)
  131 +(defoptimizer (allocate-vector stack-allocate-result)
  132 + ((type length words) node)
  133 + (ecase (policy node stack-allocate-vector)
  134 + (0 nil)
  135 + ((1 2)
  136 + ;; a vector object should fit in one page
  137 + (values-subtypep (lvar-derived-type words)
  138 + (load-time-value
  139 + (specifier-type `(integer 0 ,(- (/ sb!vm::*backend-page-size*
  140 + sb!vm:n-word-bytes)
  141 + sb!vm:vector-data-offset))))))
  142 + (3 t)))
  143 +
  144 +(defoptimizer (allocate-vector ltn-annotate) ((type length words) call ltn-policy)
  145 + (let ((args (basic-combination-args call))
  146 + (template (template-or-lose (if (awhen (node-lvar call)
  147 + (lvar-dynamic-extent it))
  148 + 'sb!vm::allocate-vector-on-stack
  149 + 'sb!vm::allocate-vector-on-heap))))
  150 + (dolist (arg args)
  151 + (setf (lvar-info arg)
  152 + (make-ir2-lvar (primitive-type (lvar-type arg)))))
  153 + (unless (is-ok-template-use template call (ltn-policy-safe-p ltn-policy))
  154 + (ltn-default-call call)
  155 + (return-from allocate-vector-ltn-annotate-optimizer (values)))
  156 + (setf (basic-combination-info call) template)
  157 + (setf (node-tail-p call) nil)
  158 +
  159 + (dolist (arg args)
  160 + (annotate-1-value-lvar arg))))
  161 +(in-package :sb!vm)
112 162
  163 +;;;
113 164 (define-vop (allocate-code-object)
114 165 (:args (boxed-arg :scs (any-reg) :target boxed)
115 166 (unboxed-arg :scs (any-reg) :target unboxed))
8 tests/dynamic-extent.impure.lisp
@@ -145,5 +145,13 @@
145 145 ((1 1 1) (1 1 1) (1 1 1))))
146 146 4))
147 147
  148 +;;; bug reported by Brian Downing: stack-allocated arrays were not
  149 +;;; filled with zeroes.
  150 +(defun-with-dx bdowning-2005-iv-16 ()
  151 + (let ((a (make-array 11 :initial-element 0)))
  152 + (declare (dynamic-extent a))
  153 + (assert (every (lambda (x) (eql x 0)) a))))
  154 +(bdowning-2005-iv-16)
  155 +
148 156
149 157 (sb-ext:quit :unix-status 104)
2  version.lisp-expr
@@ -17,4 +17,4 @@
17 17 ;;; checkins which aren't released. (And occasionally for internal
18 18 ;;; versions, especially for internal versions off the main CVS
19 19 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
20   -"0.8.21.49"
  20 +"0.8.21.50"

0 comments on commit 69ef68b

Please sign in to comment.
Something went wrong with that request. Please try again.