0.9.1.38:

[sbcl.git] / src / compiler / ppc / float.lisp

diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp
index c8bfcba..d06334b 100644 (file)
--- a/src/compiler/ppc/float.lisp
+++ b/src/compiler/ppc/float.lisp
@@ -63,10 +63,10 @@
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:variant-vars double-p size type data)
   (:generator 13
-    (with-fixed-allocation (y pa-flag ndescr type size))
-    (if double-p
-       (inst stfd x y (- (* data n-word-bytes) other-pointer-lowtag))
-       (inst stfs x y (- (* data n-word-bytes) other-pointer-lowtag)))))
+    (with-fixed-allocation (y pa-flag ndescr type size)
+      (if double-p
+          (inst stfd x y (- (* data n-word-bytes) other-pointer-lowtag))
+          (inst stfs x y (- (* data n-word-bytes) other-pointer-lowtag))))))
 
 (macrolet ((frob (name sc &rest args)
             `(progn
@@ -226,15 +226,15 @@
   (:note "complex single float to pointer coercion")
   (:generator 13
      (with-fixed-allocation (y pa-flag ndescr complex-single-float-widetag
-                              complex-single-float-size))
-     (let ((real-tn (complex-single-reg-real-tn x)))
-       (inst stfs real-tn y (- (* complex-single-float-real-slot
-                                 n-word-bytes)
-                              other-pointer-lowtag)))
-     (let ((imag-tn (complex-single-reg-imag-tn x)))
-       (inst stfs imag-tn y (- (* complex-single-float-imag-slot
-                                 n-word-bytes)
-                              other-pointer-lowtag)))))
+                              complex-single-float-size)
+       (let ((real-tn (complex-single-reg-real-tn x)))
+         (inst stfs real-tn y (- (* complex-single-float-real-slot
+                                    n-word-bytes)
+                                 other-pointer-lowtag)))
+       (let ((imag-tn (complex-single-reg-imag-tn x)))
+         (inst stfs imag-tn y (- (* complex-single-float-imag-slot
+                                    n-word-bytes)
+                                 other-pointer-lowtag))))))
 ;;;
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))
@@ -247,15 +247,15 @@
   (:note "complex double float to pointer coercion")
   (:generator 13
      (with-fixed-allocation (y pa-flag ndescr complex-double-float-widetag
-                              complex-double-float-size))
-     (let ((real-tn (complex-double-reg-real-tn x)))
-       (inst stfd real-tn y (- (* complex-double-float-real-slot
-                                 n-word-bytes)
-                              other-pointer-lowtag)))
-     (let ((imag-tn (complex-double-reg-imag-tn x)))
-       (inst stfd imag-tn y (- (* complex-double-float-imag-slot
-                                 n-word-bytes)
-                              other-pointer-lowtag)))))
+                              complex-double-float-size)
+       (let ((real-tn (complex-double-reg-real-tn x)))
+         (inst stfd real-tn y (- (* complex-double-float-real-slot
+                                    n-word-bytes)
+                                 other-pointer-lowtag)))
+       (let ((imag-tn (complex-double-reg-imag-tn x)))
+         (inst stfd imag-tn y (- (* complex-double-float-imag-slot
+                                    n-word-bytes)
+                                 other-pointer-lowtag))))))
 ;;;
 (define-move-vop move-from-complex-double :move
   (complex-double-reg) (descriptor-reg))
@@ -478,6 +478,36 @@
   (frob %single-float/signed %single-float fsubs single-reg single-float)
   (frob %double-float/signed %double-float fsub double-reg double-float))
 
+(macrolet ((frob (name translate inst to-sc to-type)
+            `(define-vop (,name)
+               (:args (x :scs (unsigned-reg)))
+               (:temporary (:scs (double-stack)) temp)
+              (:temporary (:scs (double-reg)) fmagic)
+              (:temporary (:scs (signed-reg)) rtemp)
+               (:results (y :scs (,to-sc)))
+               (:arg-types unsigned-num)
+               (:result-types ,to-type)
+               (:policy :fast-safe)
+               (:note "inline float coercion")
+               (:translate ,translate)
+               (:vop-var vop)
+               (:save-p :compute-only)
+               (:generator 5
+                 (let* ((stack-offset (* (tn-offset temp) n-word-bytes))
+                         (nfp-tn (current-nfp-tn vop))
+                         (temp-offset-high (* stack-offset n-word-bytes))
+                         (temp-offset-low (* (1+ stack-offset) n-word-bytes)))
+                    (inst lis rtemp #x4330)   ; High word of magic constant
+                    (inst stw rtemp nfp-tn temp-offset-high)
+                    (inst stw zero-tn nfp-tn temp-offset-low)
+                    (inst lfd fmagic nfp-tn temp-offset-high)
+                    (inst stw x nfp-tn temp-offset-low)
+                    (inst lfd y nfp-tn temp-offset-high)
+                   (note-this-location vop :internal-error)
+                   (inst ,inst y y fmagic))))))
+  (frob %single-float/unsigned %single-float fsubs single-reg single-float)
+  (frob %double-float/unsigned %double-float fsub double-reg double-float))
+
 (macrolet ((frob (name translate inst from-sc from-type to-sc to-type)
             `(define-vop (,name)
                (:args (x :scs (,from-sc)))