+;;; ALLOCATE-VECTOR
+(define-vop (allocate-vector-on-heap)
+ (:args (type :scs (unsigned-reg))
+ (length :scs (any-reg))
+ (words :scs (any-reg)))
+ (:arg-types positive-fixnum
+ positive-fixnum
+ positive-fixnum)
+ (:temporary (:sc non-descriptor-reg) bytes)
+ (:results (result :scs (descriptor-reg) :from :load))
+ (:policy :fast-safe)
+ (:generator 100
+ (inst addi (+ lowtag-mask
+ (* vector-data-offset n-word-bytes)) words bytes)
+ (inst dep 0 31 n-lowtag-bits bytes)
+ (pseudo-atomic ()
+ (set-lowtag other-pointer-lowtag alloc-tn result)
+ (inst add bytes alloc-tn alloc-tn)
+ (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)))
+ (:arg-types positive-fixnum
+ positive-fixnum
+ positive-fixnum)
+ (:temporary (:sc non-descriptor-reg) bytes temp)
+ (:results (result :scs (descriptor-reg) :from :load))
+ (:policy :fast-safe)
+ (:generator 100
+ (inst addi (+ lowtag-mask
+ (* vector-data-offset n-word-bytes)) words bytes)
+ (inst dep 0 31 n-lowtag-bits bytes)
+ ;; FIXME: It would be good to check for stack overflow here.
+ (pseudo-atomic ()
+ (align-csp temp)
+ (set-lowtag other-pointer-lowtag csp-tn result)
+ (inst addi (* vector-data-offset n-word-bytes) csp-tn temp)
+ (inst add bytes csp-tn csp-tn)
+ (storew type result 0 other-pointer-lowtag)
+ (storew length result vector-length-slot other-pointer-lowtag)
+ (let ((loop (gen-label)))
+ (emit-label loop)
+ (inst comb :<> temp csp-tn loop :nullify t)
+ (inst stwm zero-tn n-word-bytes temp)))))