From 5ccf36d823a5f0fe45313260982cfea633a48f38 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Tue, 7 Oct 2008 13:29:53 +0000
Subject: [PATCH] Experiment to store (complex double) numbers as packed values
 in SSE2 registers.

compiler/x86/vm.lisp:
o Can use all 8 SSE2 registers instead of every other one for complex
  double's.

compiler/x86/float-sse2.lisp:
compiler/x86/sse2-array.lisp:
o Update all complex-double vops to handle packed storage of
  complex doubles.
---
 compiler/x86/float-sse2.lisp | 143 ++++++++++++++++++++++++++++++++++-
 compiler/x86/sse2-array.lisp | 138 +++++++++++++++++++--------------
 compiler/x86/vm.lisp         |   6 +-
 3 files changed, 226 insertions(+), 61 deletions(-)

diff --git a/compiler/x86/float-sse2.lisp b/compiler/x86/float-sse2.lisp
index 189562717..30ea3bf3d 100644
--- a/compiler/x86/float-sse2.lisp
+++ b/compiler/x86/float-sse2.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.1.2.8 2008/10/04 02:48:31 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float-sse2.lisp,v 1.1.2.8.2.1 2008/10/07 13:29:53 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -240,6 +240,7 @@
   (let ((imag-tn (complex-single-reg-imag-tn x)))
     (inst movss (ea-for-csf-imag-stack y) imag-tn)))
 
+#+(or)
 (define-move-function (load-complex-double 2) (vop x y)
   ((complex-double-stack) (complex-double-reg))
   (let ((real-tn (complex-double-reg-real-tn y)))
@@ -247,6 +248,11 @@
   (let ((imag-tn (complex-double-reg-imag-tn y)))
     (inst movsd imag-tn (ea-for-cdf-imag-stack x))))
 
+(define-move-function (load-complex-double 2) (vop x y)
+  ((complex-double-stack) (complex-double-reg))
+  (inst movupd (ea-for-cdf-real-stack x) y))
+
+#+(or)
 (define-move-function (store-complex-double 2) (vop x y)
   ((complex-double-reg) (complex-double-stack))
   (let ((real-tn (complex-double-reg-real-tn x)))
@@ -254,6 +260,10 @@
   (let ((imag-tn (complex-double-reg-imag-tn x)))
     (inst movsd (ea-for-cdf-imag-stack y) imag-tn)))
 
+(define-move-function (store-complex-double 2) (vop x y)
+  ((complex-double-reg) (complex-double-stack))
+  (inst movupd (ea-for-cdf-real-stack y) x))
+
 #+long-float
 (define-move-function (load-complex-long 2) (vop x y)
   ((complex-long-stack) (complex-long-reg))
@@ -362,13 +372,23 @@
 (define-move-vop complex-single-move :move
   (complex-single-reg) (complex-single-reg))
 
+#+(or)
 (define-vop (complex-double-move complex-float-move)
   (:args (x :scs (complex-double-reg)
 	    :target y :load-if (not (location= x y))))
   (:results (y :scs (complex-double-reg) :load-if (not (location= x y)))))
+(define-vop (complex-double-move complex-float-move)
+  (:args (x :scs (complex-double-reg)
+	    :target y :load-if (not (location= x y))))
+  (:results (y :scs (complex-double-reg) :load-if (not (location= x y))))
+  (:generator 0
+    (unless (location= x y)
+      (inst movapd y x))))
+
 (define-move-vop complex-double-move :move
   (complex-double-reg) (complex-double-reg))
 
+    
 #+long-float
 (define-vop (complex-long-move complex-float-move)
   (:args (x :scs (complex-long-reg)
@@ -483,6 +503,7 @@
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))
 
+#+(or)
 (define-vop (move-from-complex-double)
   (:args (x :scs (complex-double-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
@@ -495,6 +516,16 @@
 	 (inst movsd (ea-for-cdf-real-desc y) real-tn))
        (let ((imag-tn (complex-double-reg-imag-tn x)))
 	 (inst movsd (ea-for-cdf-imag-desc y) imag-tn)))))
+(define-vop (move-from-complex-double)
+  (:args (x :scs (complex-double-reg) :to :save))
+  (:results (y :scs (descriptor-reg)))
+  (:node-var node)
+  (:note "complex float to pointer coercion")
+  (:generator 13
+     (with-fixed-allocation (y vm:complex-double-float-type
+			       vm:complex-double-float-size node)
+       (inst movupd (ea-for-cdf-real-desc y) x))))
+
 (define-move-vop move-from-complex-double :move
   (complex-double-reg) (descriptor-reg))
 
@@ -561,8 +592,19 @@
 			  #+long-float
 			  (:long '((inst fldl (ea-for-clf-imag-desc x))))))))
 		(define-move-vop ,name :move (descriptor-reg) (,sc)))))
-	  (frob move-to-complex-single complex-single-reg :single)
-	  (frob move-to-complex-double complex-double-reg :double))
+  (frob move-to-complex-single complex-single-reg :single)
+  #+(or)
+  (frob move-to-complex-double complex-double-reg :double))
+
+(define-vop (move-to-complex-double)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (complex-double-reg)))
+  (:note "pointer to complex float coercion")
+  (:generator 2
+    (inst movupd (ea-for-cdf-real-desc x) y)))
+
+(define-move-vop move-to-complex-double :move
+  (descriptor-reg) (complex-double-reg))
 
 
 ;;;
@@ -646,9 +688,27 @@
 		  (,sc descriptor-reg) (,sc)))))
   (frob move-complex-single-float-argument
 	complex-single-reg complex-single-stack :single)
+  #+(or)
   (frob move-complex-double-float-argument
 	complex-double-reg complex-double-stack :double))
 
+(define-vop (move-complex-double-float-argument)
+  (:args (x :scs (complex-double-reg) :target y)
+	 (fp :scs (any-reg)
+	     :load-if (not (sc-is y complex-double-reg))))
+  (:results (y))
+  (:note "complex float argument move")
+  (:generator 3
+    (sc-case y
+      (complex-double-reg
+       (unless (location= x y)
+	 (inst movapd y x)))
+      (complex-double-stack
+       (inst movupd (ea-for-csf-real-stack y fp) x)))))
+
+(define-move-vop move-complex-double-float-argument :move-argument
+  (complex-double-reg descriptor-reg) (complex-double-reg))
+
 #+double-double
 (define-vop (move-complex-double-double-float-argument)
   (:args (x :scs (complex-double-double-reg) :target y)
@@ -1418,6 +1478,7 @@
 	 (inst movss (ea-for-csf-real-stack r) real))
        (inst movss (ea-for-csf-imag-stack r) imag)))))
 
+#+(or)
 (define-vop (make-complex-double-float)
   (:translate complex)
   (:args (real :scs (double-reg) :target r
@@ -1443,6 +1504,30 @@
 	 (inst movsd (ea-for-cdf-real-stack r) real))
        (inst movsd (ea-for-cdf-imag-stack r) imag)))))
 
+(define-vop (make-complex-double-float)
+  (:translate complex)
+  (:args (real :scs (double-reg)
+	       :load-if (not (location= real r)))
+	 (imag :scs (double-reg) :to :save))
+  (:arg-types double-float double-float)
+  (:results (r :scs (complex-double-reg) :from (:argument 0)
+	       :load-if (not (sc-is r complex-double-stack))))
+  (:result-types complex-double-float)
+  (:temporary (:sc complex-double-reg) temp)
+  (:note "inline complex double-float creation")
+  (:policy :fast-safe)
+  (:generator 5
+    (sc-case r
+      (complex-double-reg
+       ;; Move the imag part to both the low and high parts of temp
+       (inst movddup temp imag)
+       ;; Move the real part the low part of temp.  The high part is untouched.
+       (inst movsd temp real)
+       (inst movapd r temp))
+      (complex-double-stack
+       (inst movsd (ea-for-cdf-real-stack r) real)
+       (inst movsd (ea-for-cdf-imag-stack r) imag)))))
+
 (define-vop (complex-float-value)
   (:args (x :target r))
   (:results (r))
@@ -1492,6 +1577,7 @@
   (:note "complex float realpart")
   (:variant 0))
 
+#+(or)
 (define-vop (realpart/complex-double-float complex-float-value)
   (:translate realpart)
   (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg)
@@ -1501,6 +1587,22 @@
   (:result-types double-float)
   (:note "complex float realpart")
   (:variant 0))
+(define-vop (realpart/complex-double-float)
+  (:translate realpart)
+  (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg)))
+  (:arg-types complex-double-float)
+  (:results (r :scs (double-reg)))
+  (:result-types double-float)
+  (:policy :fast-safe)
+  (:note "complex float realpart")
+  (:generator 3
+    (sc-case x
+      (complex-double-reg
+       (inst movsd r x))
+      (complex-double-stack
+       (inst movsd r (ea-for-cdf-real-stack x)))
+      (descriptor-reg
+       (inst movsd r (ea-for-cdf-real-desc x))))))
 
 (define-vop (imagpart/complex-single-float complex-float-value)
   (:translate imagpart)
@@ -1512,6 +1614,7 @@
   (:note "complex float imagpart")
   (:variant 1))
 
+#+(or)
 (define-vop (imagpart/complex-double-float complex-float-value)
   (:translate imagpart)
   (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg)
@@ -1522,6 +1625,27 @@
   (:note "complex float imagpart")
   (:variant 1))
 
+(define-vop (imagpart/complex-double-float)
+  (:translate imagpart)
+  (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg)))
+  (:arg-types complex-double-float)
+  (:results (r :scs (double-reg)))
+  (:result-types double-float)
+  (:temporary (:sc complex-double-reg) temp)
+  (:policy :fast-safe)
+  (:note "complex float imagpart")
+  (:generator 3
+    (sc-case x
+      (complex-double-reg
+       (inst movapd temp x)
+       ;; Put the high part of x (the imaginary part) to the low part
+       ;; of r.  We ignore the high part of r.
+       (inst unpckhpd temp x)
+       (inst movsd r temp))
+      (complex-double-stack
+       (inst movsd r (ea-for-cdf-imag-stack x)))
+      (descriptor-reg
+       (inst movsd r (ea-for-cdf-imag-desc x))))))
 
 ;;; A hack dummy VOP to bias the representation selection of its
 ;;; argument towards a FP register which can help avoid consing at
@@ -1843,3 +1967,16 @@
   (:variant :imag))
 
 ); progn
+
+
+(define-vop (complex-double-float/add)
+  (:translate +)
+  (:args (x :scs (complex-double-reg))
+	 (y :scs (complex-double-reg)))
+  (:arg-types complex-double-float complex-double-float)
+  (:results (r :scs (complex-double-reg)))
+  (:result-types complex-double-float)
+  (:policy :fast-safe)
+  (:generator 1
+    (inst movapd r x)
+    (inst addpd r y)))
\ No newline at end of file
diff --git a/compiler/x86/sse2-array.lisp b/compiler/x86/sse2-array.lisp
index 42c6bb1ac..b2feb550b 100644
--- a/compiler/x86/sse2-array.lisp
+++ b/compiler/x86/sse2-array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sse2-array.lisp,v 1.1.2.2 2008/09/28 20:51:28 rtoy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sse2-array.lisp,v 1.1.2.2.2.1 2008/10/07 13:29:53 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -273,16 +273,21 @@
   (:result-types complex-double-float)
   (:guard (backend-featurep :sse2))
   (:generator 7
-    (let ((real-tn (complex-double-reg-real-tn value)))
-      (inst movsd real-tn (make-ea :dword :base object :index index :scale 4
+    #+(or)
+    (progn
+      (let ((real-tn (complex-double-reg-real-tn value)))
+	(inst movsd real-tn (make-ea :dword :base object :index index :scale 4
+				     :disp (- (* vm:vector-data-offset vm:word-bytes)
+					      vm:other-pointer-type))))
+      (let ((imag-tn (complex-double-reg-imag-tn value)))
+	(inst movsd imag-tn
+	      (make-ea :dword :base object :index index :scale 4
+		       :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
+				   8)
+				vm:other-pointer-type)))))
+    (inst movupd value (make-ea :dword :base object :index index :scale 4
 				   :disp (- (* vm:vector-data-offset vm:word-bytes)
-					    vm:other-pointer-type))))
-    (let ((imag-tn (complex-double-reg-imag-tn value)))
-      (inst movsd imag-tn
-	    (make-ea :dword :base object :index index :scale 4
-		     :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
-				 8)
-			      vm:other-pointer-type))))))
+					    vm:other-pointer-type)))))
 
 (define-vop (data-vector-ref-c/simple-array-complex-double-float)
   (:note "inline array access")
@@ -295,18 +300,24 @@
   (:result-types complex-double-float)
   (:guard (backend-featurep :sse2))
   (:generator 6
-    (let ((real-tn (complex-double-reg-real-tn value)))
-      (inst movsd real-tn
-	    (make-ea :dword :base object
-		     :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
-				 (* 16 index))
-			      vm:other-pointer-type))))
-    (let ((imag-tn (complex-double-reg-imag-tn value)))
-      (inst movsd imag-tn
-	    (make-ea :dword :base object
-		     :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
-				 (* 16 index) 8)
-			      vm:other-pointer-type))))))
+    #+(or)
+    (progn
+      (let ((real-tn (complex-double-reg-real-tn value)))
+	(inst movsd real-tn
+	      (make-ea :dword :base object
+		       :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
+				   (* 16 index))
+				vm:other-pointer-type))))
+      (let ((imag-tn (complex-double-reg-imag-tn value)))
+	(inst movsd imag-tn
+	      (make-ea :dword :base object
+		       :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
+				   (* 16 index) 8)
+				vm:other-pointer-type)))))
+    (inst movupd value (make-ea :dword :base object
+				:disp (- (+ (* vm:vector-data-offset vm:word-bytes)
+					    (* 16 index))
+					 vm:other-pointer-type)))))
 
 (define-vop (data-vector-set/simple-array-complex-double-float)
   (:note "inline array store")
@@ -321,22 +332,30 @@
   (:result-types complex-double-float)
   (:guard (backend-featurep :sse2))
   (:generator 20
-    (let ((value-real (complex-double-reg-real-tn value))
-	  (result-real (complex-double-reg-real-tn result)))
-      (inst movsd (make-ea :dword :base object :index index :scale 4
-			   :disp (- (* vm:vector-data-offset
-				       vm:word-bytes)
-				    vm:other-pointer-type))
-	    value-real)
-      (inst movsd result-real value-real))
-    (let ((value-imag (complex-double-reg-imag-tn value))
-	  (result-imag (complex-double-reg-imag-tn result)))
-      (inst movsd (make-ea :dword :base object :index index :scale 4
-			   :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
-				       8)
-				    vm:other-pointer-type))
-	    value-imag)
-      (inst movsd result-imag value-imag))))
+    #+(or)	      
+    (progn
+      (let ((value-real (complex-double-reg-real-tn value))
+	    (result-real (complex-double-reg-real-tn result)))
+	(inst movsd (make-ea :dword :base object :index index :scale 4
+			     :disp (- (* vm:vector-data-offset
+					 vm:word-bytes)
+				      vm:other-pointer-type))
+	      value-real)
+	(inst movsd result-real value-real))
+      (let ((value-imag (complex-double-reg-imag-tn value))
+	    (result-imag (complex-double-reg-imag-tn result)))
+	(inst movsd (make-ea :dword :base object :index index :scale 4
+			     :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
+					 8)
+				      vm:other-pointer-type))
+	      value-imag)
+	(inst movsd result-imag value-imag)))
+    (inst movupd (make-ea :dword :base object :index index :scale 4
+			     :disp (- (* vm:vector-data-offset
+					 vm:word-bytes)
+				      vm:other-pointer-type))
+	  value)
+    (inst movapd result value)))
 
 (define-vop (data-vector-set-c/simple-array-complex-double-float)
   (:note "inline array store")
@@ -351,23 +370,32 @@
   (:result-types complex-double-float)
   (:guard (backend-featurep :sse2))
   (:generator 19
-    (let ((value-real (complex-double-reg-real-tn value))
-	  (result-real (complex-double-reg-real-tn result)))
-      (inst movsd (make-ea :dword :base object
-			   :disp (- (+ (* vm:vector-data-offset
-					  vm:word-bytes)
-				       (* 16 index))
-				    vm:other-pointer-type))
-	    value-real)
-      (inst movsd result-real value-real))
-    (let ((value-imag (complex-double-reg-imag-tn value))
-	  (result-imag (complex-double-reg-imag-tn result)))
-      (inst movsd (make-ea :dword :base object
-			   :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
-				       (* 16 index) 8)
-				    vm:other-pointer-type))
-	    value-imag)
-      (inst movsd result-imag value-imag))))
+    #+(or)	      
+    (progn
+      (let ((value-real (complex-double-reg-real-tn value))
+	    (result-real (complex-double-reg-real-tn result)))
+	(inst movsd (make-ea :dword :base object
+			     :disp (- (+ (* vm:vector-data-offset
+					    vm:word-bytes)
+					 (* 16 index))
+				      vm:other-pointer-type))
+	      value-real)
+	(inst movsd result-real value-real))
+      (let ((value-imag (complex-double-reg-imag-tn value))
+	    (result-imag (complex-double-reg-imag-tn result)))
+	(inst movsd (make-ea :dword :base object
+			     :disp (- (+ (* vm:vector-data-offset vm:word-bytes)
+					 (* 16 index) 8)
+				      vm:other-pointer-type))
+	      value-imag)
+	(inst movsd result-imag value-imag)))
+    (inst movupd (make-ea :dword :base object
+			  :disp (- (+ (* vm:vector-data-offset
+					 vm:word-bytes)
+				      (* 16 index))
+				   vm:other-pointer-type))
+	  value)
+    (inst movapd result value)))
 
 
 #+double-double
diff --git a/compiler/x86/vm.lisp b/compiler/x86/vm.lisp
index 41f3ca74c..68dd42882 100644
--- a/compiler/x86/vm.lisp
+++ b/compiler/x86/vm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.13.6.1 2008/09/26 18:56:41 rtoy Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.13.6.1.2.1 2008/10/07 13:29:53 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -293,8 +293,8 @@
 		      :alternate-scs (complex-single-stack))
 
   (complex-double-reg float-registers
-		      :locations (0 2 4 6)
-		      :element-size 2
+		      :locations #-sse2 (0 2 4 6) #+sse2 (0 1 2 3 4 5 6 7)
+		      :element-size #-sse2 2 #+sse2 1
 		      :constant-scs ()
 		      :save-p t
 		      :alternate-scs (complex-double-stack))
-- 
GitLab