Skip to content

Instantly share code, notes, and snippets.

@Lovesan
Last active March 15, 2022 05:05
Show Gist options
  • Save Lovesan/660866b96a2632b900359333a251cc1c to your computer and use it in GitHub Desktop.
Save Lovesan/660866b96a2632b900359333a251cc1c to your computer and use it in GitHub Desktop.
SBCL SSE operations on single-float vectors
(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)))
@Lovesan
Copy link
Author

Lovesan commented Mar 18, 2020

fix: added :target and :from to %m128+

@Lovesan
Copy link
Author

Lovesan commented Mar 18, 2020

...and to %m128set

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment