Some SSE stuff

(defmacro define-fast-binary-op ((op-name) &rest define-vop-args)
  (let ((x (gensym))
        (y (gensym)))
    `(progn
       (sb-c::defknown ,op-name
           ((simd-pack single-float)
            (simd-pack single-float))
           (simd-pack single-float)
           (sb-c::flushable sb-c::always-translatable))

       (sb-vm::define-vop (,op-name)
         ,@(append
            `((:translate ,op-name)
              (:policy :fast-safe))
            define-vop-args))

       (declaim (inline ,op-name))
       (defun ,op-name (,x ,y)
         (declare (type (simd-pack single-float) ,x ,y))
         (,op-name ,x ,y)))))

(define-fast-binary-op (sse-v4sf-mul)
  (:args (x :scs (sb-vm::single-sse-reg)
            :target dst)
         (y :scs (sb-vm::single-sse-reg)))
  (:arg-types sb-vm::simd-pack-single sb-vm::simd-pack-single)
  (:results (dst :scs (sb-vm::single-sse-reg) :from (:argument 0)))
  (:result-types sb-vm::simd-pack-single)
  (:generator 0
              (sb-vm::move dst x)
              (sb-vm::inst sb-vm::mulps dst y)))

(define-fast-binary-op (sse-v4sf-div)
  (:args (x :scs (sb-vm::single-sse-reg)
            :target dst)
         (y :scs (sb-vm::single-sse-reg)))
  (:arg-types sb-vm::simd-pack-single sb-vm::simd-pack-single)
  (:results (dst :scs (sb-vm::single-sse-reg) :from (:argument 0)))
  (:result-types sb-vm::simd-pack-single)
  (:generator 0
              (sb-vm::move dst x)
              (sb-vm::inst sb-vm::divps dst y)))

(define-fast-binary-op (sse-v4sf-add)
  (:args (x :scs (sb-vm::single-sse-reg)
            :target dst)
         (y :scs (sb-vm::single-sse-reg)))
  (:arg-types sb-vm::simd-pack-single sb-vm::simd-pack-single)
  (:results (dst :scs (sb-vm::single-sse-reg) :from (:argument 0)))
  (:result-types sb-vm::simd-pack-single)
  (:generator 0
              (sb-vm::move dst x)
              (sb-vm::inst sb-vm::addps dst y)))

(define-fast-binary-op (sse-v4sf-sub)
  (:args (x :scs (sb-vm::single-sse-reg)
            :target dst)
         (y :scs (sb-vm::single-sse-reg)))
  (:arg-types sb-vm::simd-pack-single sb-vm::simd-pack-single)
  (:results (dst :scs (sb-vm::single-sse-reg) :from (:argument 0)))
  (:result-types sb-vm::simd-pack-single)
  (:generator 0
              (sb-vm::move dst x)
              (sb-vm::inst sb-vm::subps dst y)))

(define-fast-binary-op (sse-v4sf-sp)
  (:args (x :scs (sb-vm::single-sse-reg)
            :target dst)
         (y :scs (sb-vm::single-sse-reg)))
  (:arg-types sb-vm::simd-pack-single sb-vm::simd-pack-single)
  (:temporary (:sc sb-vm::single-sse-reg) tmp)
  (:results (dst :scs (sb-vm::single-sse-reg) :from (:argument 0)))
  (:result-types sb-vm::simd-pack-single)
  (:generator 5
              (sb-vm::inst sb-vm::xorps tmp tmp)
              (sb-vm::move dst x)
              (sb-vm::inst sb-vm::movss dst tmp)
              (sb-vm::inst sb-vm::mulps dst y)
              (sb-vm::inst sb-vm::haddps dst dst)
              (sb-vm::inst sb-vm::haddps dst dst)))

(define-fast-binary-op (sse-v4sf-cp)
  (:args (x :scs (sb-vm::single-sse-reg)
            :target tmp-x)
         (y :scs (sb-vm::single-sse-reg)
            :target tmp-y))
  (:arg-types sb-vm::simd-pack-single sb-vm::simd-pack-single)
  (:temporary (:sc sb-vm::single-sse-reg :from (:argument 0)) tmp-x)
  (:temporary (:sc sb-vm::single-sse-reg :from (:argument 1)) tmp-y)
  (:temporary (:sc sb-vm::single-sse-reg) tmp-dst)
  (:results (dst :scs (sb-vm::single-sse-reg)))
  (:result-types sb-vm::simd-pack-single)
  (:generator 6
              (sb-vm::move tmp-x x)
              (sb-vm::move tmp-y y)
              (sb-vm::inst sb-vm::shufps tmp-x tmp-x #b01111000)
              (sb-vm::inst sb-vm::shufps tmp-y tmp-y #b10011100)
              (sb-vm::move dst tmp-x)
              (sb-vm::inst sb-vm::mulps dst tmp-y)

              (sb-vm::inst sb-vm::shufps tmp-x x #b10011000)
              (sb-vm::inst sb-vm::shufps tmp-y y #b01111100)
              (sb-vm::move tmp-dst tmp-x)
              (sb-vm::inst sb-vm::mulps tmp-dst tmp-y)

              (sb-vm::inst sb-vm::subps dst tmp-dst)

              (sb-vm::inst sb-vm::xorps tmp-dst tmp-dst)
              (sb-vm::inst sb-vm::movss dst tmp-dst)))

(defun cp (v1 v2)
  (declare (type (simple-array single-float) v1 v2)
           (optimize (speed 3)))
  (let ((res (make-array 3 :element-type 'single-float)))
    (declare (type (simple-array single-float)))
    (setf (aref res 0) (- (* (aref v1 1)
                             (aref v2 2))
                          (* (aref v1 2)
                             (aref v2 1)))

          (aref res 1) (- (* (aref v1 2)
                             (aref v2 0))
                          (* (aref v1 0)
                             (aref v2 2)))

          (aref res 2) (- (* (aref v1 0)
                             (aref v2 1))
                          (* (aref v1 1)
                             (aref v2 0))))
    res))