SBCL SSE operations on single-float vectors

simd-pack-single.lisp

(in-package #:sb-vm)

(eval-when (:compile-toplevel :load-toplevel :execute)

  (defknown %m128+ ((simd-pack single-float) (simd-pack single-float))
      (simd-pack single-float)
      (movable foldable flushable always-translatable)
    :overwrite-fndb-silently t)

  (define-vop (%m128+)
    (:translate %m128+)
    (:args (x :scs (single-sse-reg) :target dest)
           (y :scs (single-sse-reg)))
    (:arg-types simd-pack-single simd-pack-single)
    (:results (dest :scs (single-sse-reg) :from (:argument 0)))
    (:result-types simd-pack-single)
    (:policy :fast-safe)
    (:generator 1
                (move dest x)
                (inst addps dest y)))

  (defknown %m128ref ((simple-array single-float (*))
                      (integer 0 #.most-positive-fixnum))
      (simd-pack single-float)
      (movable foldable flushable always-translatable)
    :overwrite-fndb-silently t)

  (define-vop (%m128ref)
    (:translate %m128ref)
    (:args (v :scs (descriptor-reg))
           (i :scs (any-reg)))
    (:arg-types simple-array-single-float
                tagged-num)
    (:results (dest :scs (single-sse-reg)))
    (:result-types simd-pack-single)
    (:policy :fast-safe)
    (:generator 1
                (inst movups dest (float-ref-ea v i 0 16
                                                :scale (ash 16 (- n-fixnum-tag-bits))))))

  (defknown %m128set ((simple-array single-float (*))
                      (integer 0 #.most-positive-fixnum)
                      (simd-pack single-float))
      (simd-pack single-float)
      (always-translatable)
    :overwrite-fndb-silently t)

  (define-vop (%m128set)
    (:translate %m128set)
    (:args (v :scs (descriptor-reg))
           (i :scs (any-reg))
           (x :scs (single-sse-reg) :target result))
    (:arg-types simple-array-single-float
                tagged-num
                simd-pack-single)
    (:results (result :scs (single-sse-reg) :from (:argument 2)))
    (:result-types simd-pack-single)
    (:policy :fast-safe)
    (:generator 1
                (inst movups (float-ref-ea v i 0 16 :scale (ash 16 (- n-fixnum-tag-bits))) x)
                (move result x))))

(in-package #:cl-user)

(declaim (inline m128+))
(defun m128+ (x y)
  (sb-vm::%m128+ x y))

(declaim (inline m128ref))
(defun m128ref (v i)
  (sb-vm::%m128ref v i))

(declaim (inline (setf m128ref)))
(defun (setf m128ref) (new-value v i)
  (sb-vm::%m128set v i new-value))

(defun m128-vector-add (vres v1 v2)
  (declare  (type (simple-array single-float (*)) vres v1 v2))
  (loop :with len = (min (length v1) (length v2) (length vres))
        :for i :of-type fixnum :below (floor len 4)
        :do (setf (m128ref vres i)
                  (m128+ (m128ref v1 i) (m128ref v2 i)))
        :finally (return vres)))

...and to %m128set