Changeset 10811

Timestamp:

06/19/05 02:48:08 (3 years ago)

Author:

rtoy

Message:

Add a new VOP for DOUBLE-FLOAT-BITS, like on sparc. A
micro-optimization.

Location:

trunk/src

Files:

• code/kernel.lisp (modified) (1 diff)
• compiler/ppc/float.lisp (modified) (6 diffs)

trunk/src/code/kernel.lisp

@@ -153 +153 @@
 #+long-float
 (defun long-float-low-bits (x) (long-float-low-bits x))
+
+#+sparc
+(defun double-float-bits (x) (double-float-bits x))
+
+#-sparc
+(defun double-float-bits (x)
+  (values (double-float-high-bits x) (double-float-low-bits x)))
+
+
+(defun %numerator (x)
+  (declare (type ratio x))
+  (%numerator x))
+
+(defun %denominator (x)
+  (declare (type ratio x))
+  (%denominator x))

trunk/src/compiler/ppc/float.lisp

@@ -140 +140 @@
 (defun complex-double-reg-imag-tn (x)
   (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*)
-                  :offset (+ (tn-offset x) 2)))
+                  :offset (1+ (tn-offset x))))
 
 
@@ -511 +511 @@
                 (:temporary (:from (:argument 0) :sc single-reg) temp)
                 (:temporary (:scs (double-stack)) stack-temp)
-                (:results (y :scs (signed-reg)
-                             :load-if (not (sc-is y signed-stack))))
+                (:results (y :scs (signed-reg)))
                 (:arg-types ,from-type)
                 (:result-types signed-num)
@@ -523 +522 @@
                   (note-this-location vop :internal-error)
                   (inst ,inst temp x)
-                  (sc-case y
-                    (signed-stack
-                     (inst stfd temp (current-nfp-tn vop)
-                           (* (tn-offset y) vm:word-bytes)))
-                    (signed-reg
-                     (inst stfd temp (current-nfp-tn vop)
-                           (* (tn-offset stack-temp) vm:word-bytes))
-                     (inst lwz y (current-nfp-tn vop)
-                           (+ 4 (* (tn-offset stack-temp) vm:word-bytes)))))))))
+                  (inst stfd temp (current-nfp-tn vop)
+                        (* (tn-offset stack-temp) vm:word-bytes))
+                  (inst lwz y (current-nfp-tn vop)
+                        (+ 4 (* (tn-offset stack-temp) vm:word-bytes)))))))
   (frob %unary-truncate single-reg single-float fctiwz)
   (frob %unary-truncate double-reg double-float fctiwz)
@@ -633 +627 @@
   (:args (float :scs (double-reg descriptor-reg)
                 :load-if (not (sc-is float double-stack))))
-  (:results (hi-bits :scs (signed-reg)
-                     :load-if (or (sc-is float descriptor-reg double-stack)
-                                  (not (sc-is hi-bits signed-stack)))))
-  (:temporary (:scs (signed-stack)) stack-temp)
+  (:results (hi-bits :scs (signed-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
   (:arg-types double-float)
   (:result-types signed-num)
@@ -643 +635 @@
   (:vop-var vop)
   (:generator 5
-    (sc-case hi-bits
-      (signed-reg
-       (sc-case float
-         (double-reg
-          (inst stfd float (current-nfp-tn vop)
-                (* (tn-offset stack-temp) vm:word-bytes))
-          (inst lwz hi-bits (current-nfp-tn vop)
-                (* (tn-offset stack-temp) vm:word-bytes)))
-         (double-stack
-          (inst lwz hi-bits (current-nfp-tn vop)
-                (* (tn-offset float) vm:word-bytes)))
-         (descriptor-reg
-          (loadw hi-bits float vm:double-float-value-slot
-                 vm:other-pointer-type))))
-      (signed-stack
-       (sc-case float
-         (double-reg
-          (inst stfd float (current-nfp-tn vop)
-                (* (tn-offset hi-bits) vm:word-bytes))))))))
+    (sc-case float
+      (double-reg
+       (inst stfd float (current-nfp-tn vop)
+             (* (tn-offset stack-temp) vm:word-bytes))
+       (inst lwz hi-bits (current-nfp-tn vop)
+             (* (tn-offset stack-temp) vm:word-bytes)))
+      (double-stack
+       (inst lwz hi-bits (current-nfp-tn vop)
+             (* (tn-offset float) vm:word-bytes)))
+      (descriptor-reg
+       (loadw hi-bits float vm:double-float-value-slot
+              vm:other-pointer-type)))))
 
 (define-vop (double-float-low-bits)
   (:args (float :scs (double-reg descriptor-reg)
                 :load-if (not (sc-is float double-stack))))
-  (:results (lo-bits :scs (unsigned-reg)
-                     :load-if (or (sc-is float descriptor-reg double-stack)
-                                  (not (sc-is lo-bits unsigned-stack)))))
-  (:temporary (:scs (unsigned-stack)) stack-temp)
+  (:results (lo-bits :scs (unsigned-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
   (:arg-types double-float)
   (:result-types unsigned-num)
@@ -676 +659 @@
   (:vop-var vop)
   (:generator 5
-    (sc-case lo-bits
-      (unsigned-reg
-       (sc-case float
-         (double-reg
-          (inst stfd float (current-nfp-tn vop)
-                (* (tn-offset stack-temp) vm:word-bytes))
-          (inst lwz lo-bits (current-nfp-tn vop)
-                (* (1+ (tn-offset stack-temp)) vm:word-bytes)))
-         (double-stack
-          (inst lwz lo-bits (current-nfp-tn vop)
-                (* (1+ (tn-offset float)) vm:word-bytes)))
-         (descriptor-reg
-          (loadw lo-bits float (1+ vm:double-float-value-slot)
-                 vm:other-pointer-type))))
-      (unsigned-stack
-       (sc-case float
-         (double-reg
-          (inst stfd float (current-nfp-tn vop)
-                (* (tn-offset lo-bits) vm:word-bytes))))))))
+    (sc-case float
+      (double-reg
+       (inst stfd float (current-nfp-tn vop)
+             (* (tn-offset stack-temp) vm:word-bytes))
+       (inst lwz lo-bits (current-nfp-tn vop)
+             (* (1+ (tn-offset stack-temp)) vm:word-bytes)))
+      (double-stack
+       (inst lwz lo-bits (current-nfp-tn vop)
+             (* (1+ (tn-offset float)) vm:word-bytes)))
+      (descriptor-reg
+       (loadw lo-bits float (1+ vm:double-float-value-slot)
+              vm:other-pointer-type)))))