[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-03-4-g5a97fd5
Raymond Toy
rtoy at common-lisp.net
Tue Mar 27 23:20:26 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via 5a97fd587b09075dd769dc1499c42054dcd9b983 (commit)
via 788a393ba3cc06a662da170b1eb9bc5d4863b176 (commit)
from 522f9205c9ed5e1ed23389e2c2b186de352835df (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 5a97fd587b09075dd769dc1499c42054dcd9b983
Author: Raymond Toy <rtoy at google.com>
Date: Tue Mar 27 16:20:18 2012 -0700
Add contrib for packed SSE2 operations.
src/contrib/contrib.lisp:
o Define the module
src/contrib/packed-sse2/compile-packed-sse2.lisp:
o New file to compile the contrib.
src/contrib/packed-sse2/packed-sse2.lisp:
o New file implementing the packed sse2 vops and functions.
diff --git a/src/contrib/contrib.lisp b/src/contrib/contrib.lisp
index 66bd69f..1c9fd69 100644
--- a/src/contrib/contrib.lisp
+++ b/src/contrib/contrib.lisp
@@ -40,4 +40,8 @@
(defmodule "contrib-sprof"
"modules:sprof/compile-sprof")
+;; packed sse2 needs to be compiled to work.
+(defmodule "contrib-packed-sse2"
+ "modules:packed-sse2/compile-packed-sse2")
+
(provide "cmu-contribs")
diff --git a/src/contrib/packed-sse2/compile-packed-sse2.lisp b/src/contrib/packed-sse2/compile-packed-sse2.lisp
new file mode 100644
index 0000000..8aac5e8
--- /dev/null
+++ b/src/contrib/packed-sse2/compile-packed-sse2.lisp
@@ -0,0 +1,2 @@
+(compile-file "modules:packed-sse2/packed-sse2"
+ :load t)
diff --git a/src/contrib/packed-sse2/packed-sse2.lisp b/src/contrib/packed-sse2/packed-sse2.lisp
new file mode 100644
index 0000000..c3b9668
--- /dev/null
+++ b/src/contrib/packed-sse2/packed-sse2.lisp
@@ -0,0 +1,210 @@
+;;;; -*- Mode: LISP; -*-
+
+(in-package "CL-USER")
+;; Fail if we don't have sse2!
+
+(eval-when (:load-toplevel :compile-toplevel :execute)
+ (unless (featurep :sse2)
+ (error "Cannot use packed SSE2 instructions without SSE2 support.")))
+
+;; SSE2 Packed operations.
+;;
+;; We use (complex double-float) variables to hold the packed values.
+
+(in-package #:vm)
+
+(export '(sse2-mulpd sse2-mulps
+ sse2-divpd sse2-divps
+ sse2-shufpd sse2-shufps
+ sse2-setpd sse2-setps
+ sse2-getpd sse2-getps))
+
+(defknown (sse2-mulpd sse2-mulps) ((complex double-float) (complex double-float))
+ (complex double-float)
+ (movable foldable flushable))
+
+(defknown (sse2-divpd sse2-divps) ((complex double-float) (complex double-float))
+ (complex double-float)
+ (movable foldable flushable))
+
+(macrolet
+ ((generate (movinst opinst commutative)
+ `(cond
+ ((location= x r)
+ (inst ,opinst x y))
+ ((and ,commutative (location= y r))
+ (inst ,opinst y x))
+ ((not (location= r y))
+ (inst ,movinst r x)
+ (inst ,opinst r y))
+ (t
+ (inst ,movinst tmp x)
+ (inst ,opinst tmp y)
+ (inst ,movinst r tmp))))
+ (packed-op (op inst float-type cost &optional commutative)
+ (let* ((vop-name (symbolicate (symbol-name op) "/COMPLEX-" float-type "-FLOAT"))
+ (c-type (symbolicate "COMPLEX-" float-type "-FLOAT"))
+ (complex-reg (symbolicate "COMPLEX-" float-type "-REG")))
+ ;; Note: It would probably improve things if we could use
+ ;; memory operands, but we can't because the instructions
+ ;; assumed 128-bit alignment, which we can't guarantee.
+ `(define-vop (,vop-name)
+ (:args (x :scs (,complex-reg) :target r)
+ (y :scs (,complex-reg)))
+ (:results (r :scs (,complex-reg)))
+ (:arg-types ,c-type ,c-type)
+ (:result-types ,c-type)
+ (:policy :fast-safe)
+ (:note "inline packed arithmetic")
+ (:translate ,op)
+ (:temporary (:sc ,complex-reg) tmp)
+ (:generator ,cost
+ (generate movaps ,inst ,commutative))))))
+ (packed-op sse2-mulpd mulpd double 1 t)
+ (packed-op sse2-mulps mulps double 1 t)
+ (packed-op sse2-divpd divpd double 1)
+ (packed-op sse2-divps divps double 1))
+
+(defun sse2-mulpd (x y)
+ "Packed multiply of packed doubles in X and Y"
+ (declare (type (complex double-float) x y))
+ (sse2-mulpd x y))
+
+(defun sse2-mulps (x y)
+ "Packed multiply of packed singles in X and Y"
+ (declare (type (complex double-float) x y))
+ (sse2-mulps x y))
+
+(defun sse2-divpd (x y)
+ "Packed divide of packed doubles in X and Y"
+ (declare (type (complex double-float) x y))
+ (sse2-divpd x y))
+
+(defun sse2-divps (x y)
+ "Packed divide of packed singles in X and Y"
+ (declare (type (complex double-float) x y))
+ (sse2-divps x y))
+
+(defknown (%sse2-shufpd %sse2-shufps) ((complex double-float) (complex double-float) fixnum)
+ (complex double-float)
+ (movable foldable flushable))
+
+(macrolet
+ ((generate (movinst opinst commutative)
+ `(cond
+ ((location= x r)
+ (inst ,opinst x y i))
+ ((and ,commutative (location= y r))
+ (inst ,opinst y x i))
+ ((not (location= r y))
+ (inst ,movinst r x)
+ (inst ,opinst r y i))
+ (t
+ (inst ,movinst tmp x)
+ (inst ,opinst tmp y i)
+ (inst ,movinst r tmp))))
+ (packed-op (op inst float-type cost &optional commutative)
+ (let* ((vop-name (symbolicate (symbol-name op) "/COMPLEX-" float-type "-FLOAT"))
+ (c-type (symbolicate "COMPLEX-" float-type "-FLOAT"))
+ (complex-reg (symbolicate "COMPLEX-" float-type "-REG")))
+ ;; Note: It would probably improve things if we could use
+ ;; memory operands, but we can't because the instructions
+ ;; assumed 128-bit alignment, which we can't guarantee.
+ `(define-vop (,vop-name)
+ (:args (x :scs (,complex-reg) :target r)
+ (y :scs (,complex-reg)))
+ (:info i)
+ (:results (r :scs (,complex-reg)))
+ (:arg-types ,c-type ,c-type (:constant integer))
+ (:result-types ,c-type)
+ (:policy :fast-safe)
+ (:note "inline packed arithmetic")
+ (:translate ,op)
+ (:temporary (:sc ,complex-reg) tmp)
+ (:generator ,cost
+ (generate movaps ,inst ,commutative))))))
+ (packed-op %sse2-shufpd shufpd double 1)
+ (packed-op %sse2-shufps shufps double 1))
+
+(declaim (inline sse2-shufpd sse2-shufps))
+
+(defun sse2-shufpd (x y i)
+ "Shuffle packed doubles in X and Y according to I."
+ (declare (type (complex double-float) x y)
+ (type (unsigned-byte 2) i))
+ (ecase i
+ (0
+ (%sse2-shufpd x y 0))
+ (1
+ (%sse2-shufpd x y 1))
+ (2
+ (%sse2-shufpd x y 2))
+ (3
+ (%sse2-shufpd x y 3))))
+
+(defun sse2-shufps (x y i)
+ "Shuffle packed singles in X and Y according to I."
+ (declare (type (complex double-float) x y)
+ (type (unsigned-byte 4) i))
+ (ecase i
+ (0
+ (%sse2-shufps x y 0))
+ (1
+ (%sse2-shufps x y 1))
+ (2
+ (%sse2-shufps x y 2))
+ (3
+ (%sse2-shufps x y 3))
+ (4
+ (%sse2-shufps x y 4))
+ (5
+ (%sse2-shufps x y 5))
+ (6
+ (%sse2-shufps x y 6))
+ (7
+ (%sse2-shufps x y 7))))
+
+;; x is the high part and y is the low part.
+(declaim (inline sse2-setpd sse2-getpd sse2-setps sse2-getps))
+(defun sse2-setpd (x y)
+ "Create a packed double with X in the high part and Y in the low part"
+ (declare (type double-float x y))
+ (complex y x))
+
+(defun sse2-getpd (pd)
+ "Extract the components of a packed double PD. Two values are
+ returned; the high part is the first value and the low part in the
+ second."
+ (declare (type (complex double-float) pd)) (values
+ (imagpart pd) (realpart pd)))
+
+;; x3 is the high part and x0 is the low.
+(defun sse2-setps (x3 x2 x1 x0)
+ "Create a packed single with X3 in the highest part and X0 in the lowest"
+ (declare (single-float x3 x2 x1 x0))
+ (flet ((pack-singles-to-double (hi lo)
+ (let ((hi-bits (single-float-bits hi))
+ (lo-bits (single-float-bits lo)))
+ (make-double-float hi-bits (logand #xffffffff lo-bits)))))
+ (sse2-setpd (pack-singles-to-double x3 x2)
+ (pack-singles-to-double x1 x0))))
+
+(defun sse2-getps (ps)
+ "Extract the components of a packed single PS. Four values are
+ returned. The first value is the highest part of the packed single
+ and the last value is the lowest part of the packed single."
+ (declare (type (complex double-float) ps))
+ (flet ((unpack-double-to-singles (d)
+ (multiple-value-bind (hi lo)
+ (double-float-bits d)
+ (values (make-single-float hi)
+ (if (logbitp 31 lo)
+ (- (make-single-float (ldb (byte 31 0) lo)))
+ (make-single-float lo))))))
+ (multiple-value-bind (x3 x2)
+ (unpack-double-to-singles (imagpart ps))
+ (multiple-value-bind (x1 x0)
+ (unpack-double-to-singles (realpart ps))
+ (values x3 x2 x1 x0)))))
+
+(provide "contrib-packed-sse2")
commit 788a393ba3cc06a662da170b1eb9bc5d4863b176
Author: Raymond Toy <rtoy at google.com>
Date: Tue Mar 27 16:19:03 2012 -0700
Oops. Long-standing bug that cmu-contribs was defined so it couldn't
be loaded to get the other contribs.
diff --git a/src/code/module.lisp b/src/code/module.lisp
index 0f3f861..70ccba7 100644
--- a/src/code/module.lisp
+++ b/src/code/module.lisp
@@ -147,3 +147,10 @@
(defmodule "asdf"
"modules:asdf/asdf")
+
+;; Allow user to specify "cmu-contribs" or :cmu-contribs.
+(defmodule "cmu-contribs"
+ "modules:contrib")
+
+(defmodule :cmu-contribs
+ "modules:contrib")
-----------------------------------------------------------------------
Summary of changes:
src/code/module.lisp | 7 +
src/contrib/contrib.lisp | 4 +
src/contrib/packed-sse2/compile-packed-sse2.lisp | 2 +
src/contrib/packed-sse2/packed-sse2.lisp | 210 ++++++++++++++++++++++
4 files changed, 223 insertions(+), 0 deletions(-)
create mode 100644 src/contrib/packed-sse2/compile-packed-sse2.lisp
create mode 100644 src/contrib/packed-sse2/packed-sse2.lisp
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list