- (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)