[sb-simd-cvs] CVS update: sb-simd/generate-sse-vops.lisp sb-simd/example-test.lisp
Risto Laakso
rlaakso at common-lisp.net
Mon Aug 8 17:26:09 UTC 2005
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
More information about the Sb-simd-cvs
mailing list