From 76ada89c55e4ffe0b16bf278b2c9e333ec852a02 Mon Sep 17 00:00:00 2001 From: rlaakso Date: Mon, 8 Aug 2005 15:56:01 +0000 Subject: [PATCH] .. --- .cvsignore | 1 + example-test.lisp | 22 ++++- generate-sse-vops.lisp | 223 +++++++++++++++++++++++++++++++++++++++++++++++++ load.lisp | 6 ++ sse-vop.lisp | 116 ------------------------- 5 files changed, 250 insertions(+), 118 deletions(-) create mode 100644 generate-sse-vops.lisp create mode 100644 load.lisp delete mode 100644 sse-vop.lisp diff --git a/.cvsignore b/.cvsignore index a15c332..f503226 100644 --- a/.cvsignore +++ b/.cvsignore @@ -1,3 +1,4 @@ .emacs.desktop *.fasl sse-insts.lisp +sse-vops.lisp diff --git a/example-test.lisp b/example-test.lisp index 222f522..6be574d 100644 --- a/example-test.lisp +++ b/example-test.lisp @@ -10,14 +10,32 @@ (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 index 0000000..4823b1b --- /dev/null +++ b/generate-sse-vops.lisp @@ -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 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 index 07550d0..0000000 --- a/sse-vop.lisp +++ /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) - ))) -- 2.11.4.GIT