..
authorrlaakso <rlaakso>
Mon, 8 Aug 2005 17:26:08 +0000 (8 17:26 +0000)
committerrlaakso <rlaakso>
Mon, 8 Aug 2005 17:26:08 +0000 (8 17:26 +0000)
example-test.lisp
generate-sse-vops.lisp

index 6be574d..32ddd56 100644 (file)
     (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
index e091688..eb1a36e 100644 (file)
@@ -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
        '(