..
authorrlaakso <rlaakso>
Mon, 8 Aug 2005 15:56:01 +0000 (8 15:56 +0000)
committerrlaakso <rlaakso>
Mon, 8 Aug 2005 15:56:01 +0000 (8 15:56 +0000)
.cvsignore
example-test.lisp
generate-sse-vops.lisp [new file with mode: 0644]
load.lisp [new file with mode: 0644]
sse-vop.lisp [deleted file]

index a15c332..f503226 100644 (file)
@@ -1,3 +1,4 @@
 .emacs.desktop
 *.fasl
 sse-insts.lisp
+sse-vops.lisp
index 222f522..6be574d 100644 (file)
              (aref arr2 i) (float i)))
 
     (format t "Before: ~S~%~S~%" arr1 arr2)
+    (format t "b <- a + b, idx 0~%")
 
-    (sb-sys:%primitive sb-vm::%sse-sqrt/simple-array-single-float-1 arr2 arr1 4)
+    (sb-sys:%primitive sb-vm::%sse-add/simple-array-single-float-1 arr2 arr2 arr1 0)
 
     (format t "After: ~S~%~S~%" arr1 arr2)
 
-    (sb-sys:%primitive sb-vm::%sse-recip/simple-array-single-float-1 arr1 arr2 4)
+    (format t "a <- sqrt(b), idx 4~%")
+
+    (sb-sys:%primitive sb-vm::%sse-sqrt/simple-array-single-float-1 arr1 arr2 4)
 
     (format t "After: ~S~%~S~%" arr1 arr2)
 
     ))
 
+(defun test-2 ()
+  (let ((arr1 (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0))
+       (arr2 (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)))
+    
+    (loop for i from 0 below 16 do (setf (aref arr1 i) (* (1+ i) 10)
+                                        (aref arr2 i) (1+ i)))
+
+    (format t "Before: ~S~%~S~%" arr1 arr2)
+    (format t "b <- a+b, idx 4~%")
+
+    (sb-sys:%primitive sb-vm::%sse-add/simple-array-unsigned-byte-8-1 arr2 arr1 arr2 4)
+
+    (format t "After: ~S~%~S~%" arr1 arr2)
+    
+    ))
diff --git a/generate-sse-vops.lisp b/generate-sse-vops.lisp
new file mode 100644 (file)
index 0000000..4823b1b
--- /dev/null
@@ -0,0 +1,223 @@
+(defun vect-ea (vect idx)
+  `(make-ea :dword :base ,vect :index ,idx
+    :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))
+
+(defun gen-vops-to-file (filename)
+  (with-open-file (stream filename :direction :output :if-exists :supersede)
+    (gen-vops stream)))
+
+(defun gen-vops (&optional (stream t))
+
+  (format stream "(in-package :sb-vm)~%~%")
+
+  ;; TWO-ARG SSE VOPs
+  (loop for (op-name type mov-inst op-inst elem-width) in
+       '(
+         ;; 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)
+         (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)
+         (sub    single-float movups subps    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)
+         (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)
+         (sub    double-float movupd subpd    8)
+         (xor    double-float movupd xorpd    8)
+
+         ;; unsigned byte 8
+         (add    unsigned-byte-8 movdqu paddb  1)
+         (avg    unsigned-byte-8 movdqu pavgb  1)
+         (max    unsigned-byte-8 movdqu pmaxub 1)
+         (min    unsigned-byte-8 movdqu pminub 1)
+         (sub    unsigned-byte-8 movdqu psubb  1)
+
+         (and    unsigned-byte-8 movdqu pand   1)
+         (andn   unsigned-byte-8 movdqu pandn  1)
+         (or     unsigned-byte-8 movdqu por    1)
+         (xor    unsigned-byte-8 movdqu pxor   1)
+
+         ;; unsigned byte 16
+         (add    unsigned-byte-16 movdqu paddw 2)
+         (avg    unsigned-byte-16 movdqu pavgw 2)
+         (sub    unsigned-byte-16 movdqu psubw 2)
+
+         (and    unsigned-byte-16 movdqu pand  2)
+         (andn   unsigned-byte-16 movdqu pandn 2)
+         (or     unsigned-byte-16 movdqu por   2)
+         (xor    unsigned-byte-16 movdqu pxor  2)
+
+         (shl    unsigned-byte-16 movdqu psllw 2)
+         (shr    unsigned-byte-16 movdqu psrlw 2)
+
+         ;; signed byte 16
+         (add    signed-byte-16 movdqu paddw   2)
+         (max    signed-byte-16 movdqu pmaxsw  2)
+         (min    signed-byte-16 movdqu pminsw  2)
+         (sub    signed-byte-16 movdqu psubw   2)
+
+         (and    signed-byte-16 movdqu pand    2)
+         (andn   signed-byte-16 movdqu pandn   2)
+         (or     signed-byte-16 movdqu por     2)
+         (xor    signed-byte-16 movdqu pxor    2)
+
+         (shl    signed-byte-16 movdqu psllw   2)
+         (shr    signed-byte-16 movdqu psraw   2)
+         )
+       do
+
+       (format stream "~S~%~%"      
+               `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
+                                        (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" type))
+                  ,(intern (format nil "SIMPLE-ARRAY-~A" type))
+                  ,(intern (format nil "SIMPLE-ARRAY-~A" type))
+                  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-inst sse-temp1 ,(vect-ea 'vect1 'index))
+                  (inst ,mov-inst sse-temp2 ,(vect-ea 'vect2 'index))
+
+                  ;; operate
+                  (inst ,op-inst sse-temp1 sse-temp2)
+
+                  ;; store
+                  (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1)
+                  ))))
+
+  ;; SINGLE-ARG SSE VOPs
+  (loop for (op-name type mov-inst op-inst elem-width) in
+       '(
+         (recip  single-float movups rcpps   4)
+         (rsqrt  single-float movups rsqrtps 4)
+         (sqrt   single-float movups sqrtps  4)
+         (sqrt   double-float movupd sqrtpd  8)
+         )
+       do
+       (format stream "~S~%~%"
+               `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
+                                        (format t "; defining VOP ~A..~%" name)
+                                        name)))
+                 (:policy :fast-safe)
+
+                 ;;(:guard (member :sse2 *backend-subfeatures*))
+
+                 (:args 
+                  (result :scs (descriptor-reg))
+                  (vect1 :scs (descriptor-reg))
+                  (index :scs (unsigned-reg)))
+
+                 (:arg-types 
+                  ,(intern (format nil "SIMPLE-ARRAY-~A" type))
+                  ,(intern (format nil "SIMPLE-ARRAY-~A" type))
+                  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-inst sse-temp1 ,(vect-ea 'vect1 'index))
+
+                  ;; operate
+                  (inst ,op-inst sse-temp2 sse-temp1)
+
+                  ;; store
+                  (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp2)
+                  ))))
+
+  ;; COMPARE
+  (loop for (op-name type mov-inst op-inst elem-width) in
+       '(
+         (cmp    single-float movups cmpps 4)
+         (cmp    double-float movupd cmppd 8)
+         )
+       do
+       (format stream "~S~%~%"      
+               `(define-vop (,(intern (let ((name (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
+                                        (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)))
+
+                 (:info cond)
+
+                 (:arg-types 
+                  ,(intern (format nil "SIMPLE-ARRAY-~A" type))
+                  ,(intern (format nil "SIMPLE-ARRAY-~A" type))
+                  ,(intern (format nil "SIMPLE-ARRAY-~A" type))
+                  fixnum
+                  (:constant keyword)
+                  )
+
+                 (: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-inst sse-temp1 ,(vect-ea 'vect1 'index))
+                  (inst ,mov-inst sse-temp2 ,(vect-ea 'vect2 'index))
+
+                  ;; operate
+                  (inst ,op-inst sse-temp1 sse-temp2 cond)
+
+                  ;; store
+                  (inst ,mov-inst ,(vect-ea 'result 'index) sse-temp1)
+                  ))))
+
+  )
diff --git a/load.lisp b/load.lisp
new file mode 100644 (file)
index 0000000..d85b1d2
--- /dev/null
+++ b/load.lisp
@@ -0,0 +1,6 @@
+(if t
+    (progn 
+      (load (compile-file "sse-vops.lisp"))
+      (load (compile-file "example-test.lisp"))
+      ))
+      
\ No newline at end of file
diff --git a/sse-vop.lisp b/sse-vop.lisp
deleted file mode 100644 (file)
index 07550d0..0000000
+++ /dev/null
@@ -1,116 +0,0 @@
-(in-package :sb-vm)
-
-(defmacro vect-ea (vect idx)
-  `(make-ea :dword :base ,vect :index ,idx
-    :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))
-
-;; TWO-ARG SSE VOPs
-(loop for (op-name type mov-inst op-inst) in
-      '(
-       (add    single-float movups addps)
-       (addsub single-float movups addsubps)
-       (andnot single-float movups andnps)
-       (and    single-float movups andps)
-       (div    single-float movups divps)
-       (hadd   single-float movups haddps)
-       (hsub   single-float movups hsubps)
-       (max    single-float movups maxps)
-       (min    single-float movups minps)
-       (mul    single-float movups mulps)
-       (or     single-float movups orps)
-       (sub    single-float movups subps)
-       (xor    single-float movups xorps)
-
-       (add    double-float movupd addpd)
-       (addsub double-float movupd addsubpd)
-       (andnot double-float movupd andnpd)
-       (and    double-float movupd andpd)
-       (div    double-float movupd divpd)
-       (hadd   double-float movupd haddpd)
-       (hsub   double-float movupd hsubpd)
-       (max    double-float movupd maxpd)
-       (min    double-float movupd minpd)
-       (mul    double-float movupd mulpd)
-       (or     double-float movupd orpd)
-       (sub    double-float movupd subpd)
-       (xor    double-float movupd xorpd)
-       )
-      do
-      
-      `(define-vop (,(intern (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
-       (: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" type))
-        ,(intern (format nil "SIMPLE-ARRAY-~A" type))
-        ,(intern (format nil "SIMPLE-ARRAY-~A" type))
-        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 2)
-
-        ;; load
-        (inst ,mov-inst sse-temp1 (vect-ea vect1 index))
-        (inst ,mov-inst sse-temp2 (vect-ea vect2 index))
-
-        ;; operate
-        (inst ,op-inst sse-temp1 sse-temp2)
-
-        ;; store
-        (inst ,mov-inst (vect-ea result index) sse-temp1)
-        )))
-
-;; SINGLE-ARG SSE VOPs
-(loop for (op-name type mov-inst op-inst) in
-      '(
-       (recip  single-float movups rcpps)
-       (rsqrt  single-float movups rsqrtps)
-       (sqrt   single-float movups sqrtps)
-       (sqrt   double-float movupd sqrtpd)
-       )
-      do
-      
-      `(define-vop (,(intern (format nil "%SSE-~A/SIMPLE-ARRAY-~A-1" op-name type)))
-       (:policy :fast-safe)
-
-       ;;(:guard (member :sse2 *backend-subfeatures*))
-
-       (:args 
-        (result :scs (descriptor-reg))
-        (vect1 :scs (descriptor-reg))
-        (index :scs (unsigned-reg)))
-
-       (:arg-types 
-        ,(intern (format nil "SIMPLE-ARRAY-~A" type))
-        ,(intern (format nil "SIMPLE-ARRAY-~A" type))
-        fixnum)
-
-       (:temporary (:sc sse-reg) sse-temp1)
-
-       (:generator 10
-
-        ;; scale index by 4 (size-of single-float)
-        (inst shl index 2)
-
-        ;; load
-        (inst ,mov-inst sse-temp1 (vect-ea vect1 index))
-
-        ;; operate
-        (inst ,op-inst sse-temp1)
-
-        ;; store
-        (inst ,mov-inst (vect-ea result index) sse-temp1)
-        )))