(define-vop (allocate-vector-on-heap)
  (:args (type :scs (unsigned-reg immediate))
         (length :scs (any-reg immediate))
         (words :scs (any-reg immediate)))
  (:results (result :scs (descriptor-reg) :from :load))
  (:arg-types positive-fixnum
              positive-fixnum
              positive-fixnum)
  (:policy :fast-safe)
  (:generator 100
    (let ((size (sc-case words
                  (immediate
                   (pad-data-block (+ (tn-value words) vector-data-offset
                                      ;; Pad for aligning data.
                                      (- 4 vector-data-offset))))
                  (t
                   (inst lea result (make-ea :byte :base words :disp
                                             (+ (1- (ash 1 n-lowtag-bits))
                                                (* (+ vector-data-offset
                                                      ;; Pad...
                                                      (- 4 vector-data-offset))
                                                   n-word-bytes))))
                   (inst and result (lognot lowtag-mask))
                   result))))
      (pseudo-atomic
       (allocation result size)
       ;; Align data to 16 bytes.
       (inst lea result (make-ea :byte :base result :disp 15))
       (inst and result #xfffffff0)
       ;; THIS here breaks the build. I'll be damned if I see the problem.
       (inst or result #x8)
       ;; Tag and go.
       (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
       (sc-case type
         (immediate
          (aver (typep (tn-value type) '(unsigned-byte 8)))
          (storeb (tn-value type) result 0 other-pointer-lowtag))
         (t
          (storew type result 0 other-pointer-lowtag)))
       (sc-case length
         (immediate
          (let ((fixnum-length (fixnumize (tn-value length))))
            (typecase fixnum-length
              ((unsigned-byte 8)
               (storeb fixnum-length result
                       vector-length-slot other-pointer-lowtag))
              (t
               (storew fixnum-length result
                       vector-length-slot other-pointer-lowtag)))))
         (t
          (storew length result vector-length-slot other-pointer-lowtag)))))))