Update of /project/sb-simd/cvsroot/sb-simd In directory common-lisp.net:/tmp/cvs-serv14620
Modified Files: generate-sse-vops.lisp example-test.lisp Log Message: ..
Date: Mon Aug 8 19:26:08 2005 Author: rlaakso
Index: sb-simd/generate-sse-vops.lisp diff -u sb-simd/generate-sse-vops.lisp:1.2 sb-simd/generate-sse-vops.lisp:1.3 --- sb-simd/generate-sse-vops.lisp:1.2 Mon Aug 8 18:23:22 2005 +++ sb-simd/generate-sse-vops.lisp Mon Aug 8 19:26:08 2005 @@ -25,8 +25,8 @@ 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 @@ ;; 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) @@ -150,6 +150,61 @@ ;; store (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
Index: sb-simd/example-test.lisp diff -u sb-simd/example-test.lisp:1.2 sb-simd/example-test.lisp:1.3 --- sb-simd/example-test.lisp:1.2 Mon Aug 8 17:56:01 2005 +++ sb-simd/example-test.lisp Mon Aug 8 19:26:08 2005 @@ -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