From: rlaakso Date: Mon, 8 Aug 2005 17:26:08 +0000 (+0000) Subject: .. X-Git-Url: https://repo.or.cz/w/sb-simd.git/commitdiff_plain/c62d652c91997d112d2a6fff053ba86949ad90c6 .. --- diff --git a/example-test.lisp b/example-test.lisp index 6be574d..32ddd56 100644 --- a/example-test.lisp +++ b/example-test.lisp @@ -39,3 +39,55 @@ (format t "After: ~S~%~S~%" arr1 arr2) )) + +(defparameter +sse-highbit-single-float-mask+ (make-array 16 :element-type '(unsigned-byte 8) + :initial-contents '(0 0 0 128 + 0 0 0 128 + 0 0 0 128 + 0 0 0 128))) +(defparameter +sse-lowbits-single-float-mask+ (make-array 16 :element-type '(unsigned-byte 8) + :initial-contents '(255 255 255 127 + 255 255 255 127 + 255 255 255 127 + 255 255 255 127))) + +(defun sign (float-array) + (let ((res (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0))) + + (sb-sys:%primitive sb-vm::%SSE-AND/SIMPLE-ARRAY-SINGLE-FLOAT/SIMPLE-ARRAY-UNSIGNED-BYTE-8-1 + res + float-array + +sse-highbit-single-float-mask+ + 0) + (values-list (mapcar #'(lambda (x) (/= x 0)) (list (aref res 3) (aref res 7) (aref res 11) (aref res 15)))))) + +(defun %neg (float-array) + (let ((res (make-array 4 :element-type 'single-float :initial-element 0f0))) + + (sb-sys:%primitive sb-vm::%SSE-XOR/SIMPLE-ARRAY-SINGLE-FLOAT/SIMPLE-ARRAY-UNSIGNED-BYTE-8-1 + res + float-array + +sse-highbit-single-float-mask+ + 0) + res)) + +(defun %abs (float-array) + (let ((res (make-array 4 :element-type 'single-float :initial-element 0f0))) + + (sb-sys:%primitive sb-vm::%SSE-AND/SIMPLE-ARRAY-SINGLE-FLOAT/SIMPLE-ARRAY-UNSIGNED-BYTE-8-1 + res + float-array + +sse-lowbits-single-float-mask+ + 0) + res)) + +(defun test-sign () + (let ((arr1 (make-array 10 :element-type 'single-float :initial-element 0f0))) + (loop for i from 0 below 10 do (setf (aref arr1 i) + (float (* (expt -1 i) (- (* (1+ i) 10) (* 2 i i)))))) + (format t "array: ~S~%" arr1) + (multiple-value-bind (s1 s2 s3 s4) (sign arr1) + (format t "sign0->3: ~A ~A ~A ~A~%" s1 s2 s3 s4)) + (format t "neg: ~S~%" (%neg arr1)) + (format t "abs: ~S~%" (%abs arr1)) + t)) \ No newline at end of file diff --git a/generate-sse-vops.lisp b/generate-sse-vops.lisp index e091688..eb1a36e 100644 --- a/generate-sse-vops.lisp +++ b/generate-sse-vops.lisp @@ -25,8 +25,8 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(defun vect-ea (vect idx) - `(make-ea :dword :base ,vect :index ,idx +(defun vect-ea (vect &optional (idx nil)) + `(make-ea :dword :base ,vect ,@(if idx `(:index ,idx)) :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) (defun gen-vops-to-file (filename) @@ -43,32 +43,32 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;; single float (add single-float movups addps 4) (addsub single-float movups addsubps 4) - (andnot single-float movups andnps 4) - (and single-float movups andps 4) +;; (andnot single-float movups andnps 4) +;; (and single-float movups andps 4) (div single-float movups divps 4) (hadd single-float movups haddps 4) (hsub single-float movups hsubps 4) (max single-float movups maxps 4) (min single-float movups minps 4) (mul single-float movups mulps 4) - (or single-float movups orps 4) +;; (or single-float movups orps 4) (sub single-float movups subps 4) - (xor single-float movups xorps 4) +;; (xor single-float movups xorps 4) ;; double float (add double-float movupd addpd 8) (addsub double-float movupd addsubpd 8) - (andnot double-float movupd andnpd 8) - (and double-float movupd andpd 8) +;; (andnot double-float movupd andnpd 8) +;; (and double-float movupd andpd 8) (div double-float movupd divpd 8) (hadd double-float movupd haddpd 8) (hsub double-float movupd hsubpd 8) (max double-float movupd maxpd 8) (min double-float movupd minpd 8) (mul double-float movupd mulpd 8) - (or double-float movupd orpd 8) +;; (or double-float movupd orpd 8) (sub double-float movupd subpd 8) - (xor double-float movupd xorpd 8) +;; (xor double-float movupd xorpd 8) ;; unsigned byte 8 (add unsigned-byte-8 movdqu paddb 1) @@ -151,6 +151,61 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1) )))) + ;; TWO-ARG SSE VOPs w/ DIFFERENT ARG TYPES + (loop for (op-name type1 type2 mov-inst1 mov-inst2 op-inst elem-width) in + '( + (andnot single-float unsigned-byte-8 movups movdqu andnps 4) + (and single-float unsigned-byte-8 movups movdqu andps 4) + (or single-float unsigned-byte-8 movups movdqu orps 4) + (xor single-float unsigned-byte-8 movups movdqu xorps 4) + + (andnot double-float unsigned-byte-8 movupd movdqu andnpd 4) + (and double-float unsigned-byte-8 movupd movdqu andpd 4) + (or double-float unsigned-byte-8 movupd movdqu orpd 4) + (xor double-float unsigned-byte-8 movupd movdqu xorpd 4) + ) + do + (format stream "~S~%~%" + `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A/SIMPLE-ARRAY-~A-1" op-name type1 type2))) + (format t "; defining VOP ~A..~%" name) + name))) + + (:policy :fast-safe) + + ;;(:guard (member :sse2 *backend-subfeatures*)) + + (:args + (result :scs (descriptor-reg)) + (vect1 :scs (descriptor-reg)) + (vect2 :scs (descriptor-reg)) + (index :scs (unsigned-reg))) + + (:arg-types + ,(intern (format nil "SIMPLE-ARRAY-~A" type2)) + ,(intern (format nil "SIMPLE-ARRAY-~A" type1)) + ,(intern (format nil "SIMPLE-ARRAY-~A" type2)) + fixnum) + + (:temporary (:sc sse-reg) sse-temp1) + (:temporary (:sc sse-reg) sse-temp2) + + (:generator 10 + + ;; scale index by 4 (size-of single-float) + (inst shl index ,(floor (log elem-width 2))) + + ;; load + (inst ,mov-inst1 sse-temp1 ,(vect-ea 'vect1 'index)) + (inst ,mov-inst2 sse-temp2 ,(vect-ea 'vect2)) + + ;; operate + (inst ,op-inst sse-temp1 sse-temp2) + + ;; store + (inst ,mov-inst2 ,(vect-ea 'result 'index) sse-temp1) + )))) + + ;; SINGLE-ARG SSE VOPs (loop for (op-name type mov-inst op-inst elem-width) in '(