From 95f890d776c7399fc3ce158db702f08ab43d281e Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Fri, 8 Mar 2002 18:38:21 +0000
Subject: [PATCH] Micro optimization for Sparc.  The ftruncate code using
 %unary-truncate has many redundant stack moves even when it's know the result
 will fit in a (signed-byte 32), so create vops to do the conversion directly
 in the floating-point registers.

Also, sparc-v9 can do 64-bit integer conversions, so make the range up
to 64-bits for sparc-v9.
---
 compiler/float-tran.lisp  | 22 ++++++++++-----
 compiler/sparc/float.lisp | 56 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 71 insertions(+), 7 deletions(-)

diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index 901f4171a..649185636 100644
--- a/compiler/float-tran.lisp
+++ b/compiler/float-tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.85 2002/02/25 16:23:11 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.86 2002/03/08 18:38:20 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -110,21 +110,31 @@
   '(let ((res (%unary-ftruncate (/ x y))))
      (values res (- x (* y res)))))
 
+#+sparc
+(defknown fast-unary-ftruncate ((or single-float double-float))
+  (or single-float double-float)
+  (movable foldable flushable))
+
 ;; Convert %unary-ftruncate to unary-ftruncate/{single,double}-float
 ;; if x is known to be of the right type.  Also, if the result is
 ;; known to fit in the same range as a (signed-byte 32), convert this
 ;; to %unary-truncate, which might be a single instruction, and float
-;; the result.
+;; the result.  However, for sparc, we have a vop to do this so call
+;; that, and for Sparc V9, we can actually handle a 64-bit integer
+;; range.
 
 (macrolet ((frob (ftype func)
 	     `(deftransform %unary-ftruncate ((x) (,ftype))
 		(let* ((x-type (continuation-type x))
 		       (lo (numeric-type-low x-type))
-		       (hi (numeric-type-high x-type)))
+		       (hi (numeric-type-high x-type))
+		       (limit-lo (- (ash 1 #-sparc-v9 31 #+sparc-v9 63)))
+		       (limit-hi (ash 1 #-sparc-v9 31 #+sparc-v9 63)))
 		  (if (and (numberp lo) (numberp hi)
-			   (< (- (ash 1 31)) lo)
-			   (< hi (ash 1 31)))
-		      '(coerce (%unary-truncate x) ',ftype)
+			   (< limit-lo lo)
+			   (< hi limit-hi))
+		      #-sparc '(coerce (%unary-truncate x) ',ftype)
+		      #+sparc '(fast-unary-ftruncate x)
 		      '(,func x))))))
   (frob single-float %unary-ftruncate/single-float)
   (frob double-float %unary-ftruncate/double-float))
diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp
index f8c4f694f..8c3be0a49 100644
--- a/compiler/sparc/float.lisp
+++ b/compiler/sparc/float.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.33 2001/09/24 15:37:01 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.34 2002/03/08 18:38:21 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -943,6 +943,60 @@
   #-sun4
   (frob %unary-round double-reg double-float fdtoir))
 
+(define-vop (fast-unary-ftruncate/single-float)
+  (:args (x :scs (single-reg)))
+  (:arg-types single-float)
+  (:results (r :scs (single-reg)))
+  (:result-types single-float)
+  (:policy :fast-safe)
+  (:translate c::fast-unary-ftruncate)
+  (:guard (not (backend-featurep :sparc-v9)))
+  (:note "inline ftruncate")
+  (:generator 2
+    (inst fstoi r x)
+    (inst fitos r r)))
+
+(define-vop (fast-unary-ftruncate/double-float)
+  (:args (x :scs (double-reg) :target r))
+  (:arg-types double-float)
+  (:results (r :scs (double-reg)))
+  (:result-types double-float)
+  (:policy :fast-safe)
+  (:translate c::fast-unary-ftruncate)
+  (:guard (not (backend-featurep :sparc-v9)))
+  (:note "inline ftruncate")
+  (:generator 2
+    (inst fdtoi r x)
+    (inst fitod r r)))
+
+;; The V9 architecture can convert 64-bit integers.
+(define-vop (v9-fast-unary-ftruncate/single-float)
+  (:args (x :scs (single-reg)))
+  (:arg-types single-float)
+  (:results (r :scs (single-reg)))
+  (:result-types single-float)
+  (:temporary (:scs (double-reg)) temp)
+  (:policy :fast-safe)
+  (:translate c::fast-unary-ftruncate)
+  (:guard (backend-featurep :sparc-v9))
+  (:note "inline ftruncate")
+  (:generator 2
+    (inst fstox temp x)
+    (inst fxtos r temp)))
+
+(define-vop (v9-fast-unary-ftruncate/double-float)
+  (:args (x :scs (double-reg) :target r))
+  (:arg-types double-float)
+  (:results (r :scs (double-reg)))
+  (:result-types double-float)
+  (:policy :fast-safe)
+  (:translate c::fast-unary-ftruncate)
+  (:guard (backend-featurep :sparc-v9))
+  (:note "inline ftruncate")
+  (:generator 2
+    (inst fdtox r x)
+    (inst fxtod r r)))
+
 #+sun4
 (deftransform %unary-round ((x) (float) (signed-byte 32))
   '(let* ((trunc (truly-the (signed-byte 32) (%unary-truncate x)))
-- 
GitLab