X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Ffloat.lisp;h=86853e82e721881573d918ea077fe221e3855d0a;hb=646a14a9099c3c6bbb60ff09f7fb6a781a030815;hp=145e171cd7970a5914cd08c9477f41e80f1afec9;hpb=63817d29028c8551cda23f432a3328acd7fdd62f;p=sbcl.git

diff --git a/src/compiler/hppa/float.lisp b/src/compiler/hppa/float.lisp
index 145e171..86853e8 100644
--- a/src/compiler/hppa/float.lisp
+++ b/src/compiler/hppa/float.lisp
@@ -19,10 +19,10 @@
 
 (defun ld-float (offset base r)
   (cond ((< offset (ash 1 4))
-	 (inst flds offset base r))
-	(t
-	 (inst ldo offset zero-tn lip-tn)
-	 (inst fldx lip-tn base r))))
+         (inst flds offset base r))
+        (t
+         (inst ldo offset zero-tn lip-tn)
+         (inst fldx lip-tn base r))))
 
 (define-move-fun (load-float 1) (vop x y)
   ((single-stack) (single-reg)
@@ -32,10 +32,10 @@
 
 (defun str-float (x offset base)
   (cond ((< offset (ash 1 4))
-	 (inst fsts x offset base))
-	(t
-	 (inst ldo offset zero-tn lip-tn)
-	 (inst fstx x lip-tn base))))
+         (inst fsts x offset base))
+        (t
+         (inst ldo offset zero-tn lip-tn)
+         (inst fstx x lip-tn base))))
 
 (define-move-fun (store-float 1) (vop x y)
   ((single-reg) (single-stack)
@@ -46,10 +46,10 @@
 ;;;; Move VOPs
 (define-vop (move-float)
   (:args (x :scs (single-reg double-reg)
-	    :target y
-	    :load-if (not (location= x y))))
+            :target y
+            :load-if (not (location= x y))))
   (:results (y :scs (single-reg double-reg)
-	       :load-if (not (location= x y))))
+               :load-if (not (location= x y))))
   (:note "float move")
   (:generator 0
     (unless (location= y x)
@@ -64,15 +64,15 @@
   (:variant-vars size type data)
   (:note "float to pointer coercion")
   (:generator 13
-    (with-fixed-allocation (y ndescr type size))
-    (inst fsts x (- (* data n-word-bytes) other-pointer-lowtag) y)))
+    (with-fixed-allocation (y ndescr type size)
+      (inst fsts x (- (* data n-word-bytes) other-pointer-lowtag) y))))
 
 (macrolet ((frob (name sc &rest args)
-	     `(progn
-		(define-vop (,name move-from-float)
-		  (:args (x :scs (,sc) :to :save))
-		  (:variant ,@args))
-		(define-move-vop ,name :move (,sc) (descriptor-reg)))))
+             `(progn
+                (define-vop (,name move-from-float)
+                  (:args (x :scs (,sc) :to :save))
+                  (:variant ,@args))
+                (define-move-vop ,name :move (,sc) (descriptor-reg)))))
   (frob move-from-single single-reg
     single-float-size single-float-widetag single-float-value-slot)
   (frob move-from-double double-reg
@@ -87,28 +87,28 @@
     (inst flds (- (* offset n-word-bytes) other-pointer-lowtag) x y)))
 
 (macrolet ((frob (name sc offset)
-	     `(progn
-		(define-vop (,name move-to-float)
-		  (:results (y :scs (,sc)))
-		  (:variant ,offset))
-		(define-move-vop ,name :move (descriptor-reg) (,sc)))))
+             `(progn
+                (define-vop (,name move-to-float)
+                  (:results (y :scs (,sc)))
+                  (:variant ,offset))
+                (define-move-vop ,name :move (descriptor-reg) (,sc)))))
   (frob move-to-single single-reg single-float-value-slot)
   (frob move-to-double double-reg double-float-value-slot))
 
 (define-vop (move-float-arg)
   (:args (x :scs (single-reg double-reg) :target y)
-	 (nfp :scs (any-reg)
-	      :load-if (not (sc-is y single-reg double-reg))))
+         (nfp :scs (any-reg)
+              :load-if (not (sc-is y single-reg double-reg))))
   (:results (y))
   (:note "float argument move")
   (:generator 1
     (sc-case y
       ((single-reg double-reg)
        (unless (location= x y)
-	 (inst funop :copy x y)))
+         (inst funop :copy x y)))
       ((single-stack double-stack)
        (let ((offset (* (tn-offset y) n-word-bytes)))
-	 (str-float x offset nfp))))))
+         (str-float x offset nfp))))))
 (define-move-vop move-float-arg :move-arg
   (single-reg descriptor-reg) (single-reg))
 (define-move-vop move-float-arg :move-arg
@@ -117,31 +117,31 @@
 ;;;; Complex float move functions
 (defun complex-single-reg-real-tn (x)
   (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
-		  :offset (tn-offset x)))
+                  :offset (tn-offset x)))
 (defun complex-single-reg-imag-tn (x)
   (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
-		  :offset (1+ (tn-offset x))))
+                  :offset (1+ (tn-offset x))))
 
 (defun complex-double-reg-real-tn (x)
   (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
-		  :offset (tn-offset x)))
+                  :offset (tn-offset x)))
 (defun complex-double-reg-imag-tn (x)
   (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
-		  :offset (1+ (tn-offset x))))
+                  :offset (1+ (tn-offset x))))
 
 (define-move-fun (load-complex-single 2) (vop x y)
   ((complex-single-stack) (complex-single-reg))
   (let ((nfp (current-nfp-tn vop))
-	(offset (* (tn-offset x) n-word-bytes)))
+        (offset (* (tn-offset x) n-word-bytes)))
     (let ((real-tn (complex-single-reg-real-tn y)))
       (ld-float offset nfp real-tn))
     (let ((imag-tn (complex-single-reg-imag-tn y)))
       (ld-float (+ offset n-word-bytes) nfp imag-tn))))
-  
+
 (define-move-fun (store-complex-single 2) (vop x y)
   ((complex-single-reg) (complex-single-stack))
   (let ((nfp (current-nfp-tn vop))
-	(offset (* (tn-offset y) n-word-bytes)))
+        (offset (* (tn-offset y) n-word-bytes)))
     (let ((real-tn (complex-single-reg-real-tn x)))
       (str-float real-tn offset nfp))
     (let ((imag-tn (complex-single-reg-imag-tn x)))
@@ -150,7 +150,7 @@
 (define-move-fun (load-complex-double 4) (vop x y)
   ((complex-double-stack) (complex-double-reg))
   (let ((nfp (current-nfp-tn vop))
-	(offset (* (tn-offset x) n-word-bytes)))
+        (offset (* (tn-offset x) n-word-bytes)))
     (let ((real-tn (complex-double-reg-real-tn y)))
       (ld-float offset nfp real-tn))
     (let ((imag-tn (complex-double-reg-imag-tn y)))
@@ -159,7 +159,7 @@
 (define-move-fun (store-complex-double 4) (vop x y)
   ((complex-double-reg) (complex-double-stack))
   (let ((nfp (current-nfp-tn vop))
-	(offset (* (tn-offset y) n-word-bytes)))
+        (offset (* (tn-offset y) n-word-bytes)))
     (let ((real-tn (complex-double-reg-real-tn x)))
       (str-float real-tn offset nfp))
     (let ((imag-tn (complex-double-reg-imag-tn x)))
@@ -168,7 +168,7 @@
 ;;; Complex float register to register moves.
 (define-vop (complex-single-move)
   (:args (x :scs (complex-single-reg) :target y
-	    :load-if (not (location= x y))))
+            :load-if (not (location= x y))))
   (:results (y :scs (complex-single-reg) :load-if (not (location= x y))))
   (:note "complex single float move")
   (:generator 0
@@ -176,17 +176,17 @@
        ;; Note the complex-float-regs are aligned to every second
        ;; float register so there is not need to worry about overlap.
        (let ((x-real (complex-single-reg-real-tn x))
-	     (y-real (complex-single-reg-real-tn y)))
-	 (inst funop :copy x-real y-real))
+             (y-real (complex-single-reg-real-tn y)))
+         (inst funop :copy x-real y-real))
        (let ((x-imag (complex-single-reg-imag-tn x))
-	     (y-imag (complex-single-reg-imag-tn y)))
-	 (inst funop :copy x-imag y-imag)))))
+             (y-imag (complex-single-reg-imag-tn y)))
+         (inst funop :copy x-imag y-imag)))))
 (define-move-vop complex-single-move :move
   (complex-single-reg) (complex-single-reg))
 
 (define-vop (complex-double-move)
   (:args (x :scs (complex-double-reg)
-	    :target y :load-if (not (location= x y))))
+            :target y :load-if (not (location= x y))))
   (:results (y :scs (complex-double-reg) :load-if (not (location= x y))))
   (:note "complex double float move")
   (:generator 0
@@ -194,11 +194,11 @@
        ;; Note the complex-float-regs are aligned to every second
        ;; float register so there is not need to worry about overlap.
        (let ((x-real (complex-double-reg-real-tn x))
-	     (y-real (complex-double-reg-real-tn y)))
-	 (inst funop :copy x-real y-real))
+             (y-real (complex-double-reg-real-tn y)))
+         (inst funop :copy x-real y-real))
        (let ((x-imag (complex-double-reg-imag-tn x))
-	     (y-imag (complex-double-reg-imag-tn y)))
-	 (inst funop :copy x-imag y-imag)))))
+             (y-imag (complex-double-reg-imag-tn y)))
+         (inst funop :copy x-imag y-imag)))))
 (define-move-vop complex-double-move :move
   (complex-double-reg) (complex-double-reg))
 
@@ -211,15 +211,15 @@
   (:note "complex single float to pointer coercion")
   (:generator 13
      (with-fixed-allocation (y ndescr complex-single-float-widetag
-			       complex-single-float-size))
-     (let ((real-tn (complex-single-reg-real-tn x)))
-       (inst fsts real-tn (- (* complex-single-float-real-slot n-word-bytes)
-			     other-pointer-lowtag)
-	     y))
-     (let ((imag-tn (complex-single-reg-imag-tn x)))
-       (inst fsts imag-tn (- (* complex-single-float-imag-slot n-word-bytes)
-			     other-pointer-lowtag)
-	     y))))
+                               complex-single-float-size)
+       (let ((real-tn (complex-single-reg-real-tn x)))
+         (inst fsts real-tn (- (* complex-single-float-real-slot n-word-bytes)
+                               other-pointer-lowtag)
+               y))
+       (let ((imag-tn (complex-single-reg-imag-tn x)))
+         (inst fsts imag-tn (- (* complex-single-float-imag-slot n-word-bytes)
+                               other-pointer-lowtag)
+               y)))))
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))
 
@@ -230,15 +230,15 @@
   (:note "complex double float to pointer coercion")
   (:generator 13
      (with-fixed-allocation (y ndescr complex-double-float-widetag
-			       complex-double-float-size))
-     (let ((real-tn (complex-double-reg-real-tn x)))
-       (inst fsts real-tn (- (* complex-double-float-real-slot n-word-bytes)
-			     other-pointer-lowtag)
-	     y))
-     (let ((imag-tn (complex-double-reg-imag-tn x)))
-       (inst fsts imag-tn (- (* complex-double-float-imag-slot n-word-bytes)
-			     other-pointer-lowtag)
-	     y))))
+                               complex-double-float-size)
+       (let ((real-tn (complex-double-reg-real-tn x)))
+         (inst fsts real-tn (- (* complex-double-float-real-slot n-word-bytes)
+                               other-pointer-lowtag)
+               y))
+       (let ((imag-tn (complex-double-reg-imag-tn x)))
+         (inst fsts imag-tn (- (* complex-double-float-imag-slot n-word-bytes)
+                               other-pointer-lowtag)
+               y)))))
 (define-move-vop move-from-complex-double :move
   (complex-double-reg) (descriptor-reg))
 
@@ -250,12 +250,12 @@
   (:generator 2
     (let ((real-tn (complex-single-reg-real-tn y)))
       (inst flds (- (* complex-single-float-real-slot n-word-bytes)
-		    other-pointer-lowtag)
-	    x real-tn))
+                    other-pointer-lowtag)
+            x real-tn))
     (let ((imag-tn (complex-single-reg-imag-tn y)))
       (inst flds (- (* complex-single-float-imag-slot n-word-bytes)
-		    other-pointer-lowtag)
-	    x imag-tn))))
+                    other-pointer-lowtag)
+            x imag-tn))))
 (define-move-vop move-to-complex-single :move
   (descriptor-reg) (complex-single-reg))
 
@@ -266,61 +266,61 @@
   (:generator 2
     (let ((real-tn (complex-double-reg-real-tn y)))
       (inst flds (- (* complex-double-float-real-slot n-word-bytes)
-		    other-pointer-lowtag)
-	    x real-tn))
+                    other-pointer-lowtag)
+            x real-tn))
     (let ((imag-tn (complex-double-reg-imag-tn y)))
       (inst flds (- (* complex-double-float-imag-slot n-word-bytes)
-		    other-pointer-lowtag)
-	    x imag-tn))))
+                    other-pointer-lowtag)
+            x imag-tn))))
 (define-move-vop move-to-complex-double :move
   (descriptor-reg) (complex-double-reg))
 
 ;;; Complex float move-arg vop
 (define-vop (move-complex-single-float-arg)
   (:args (x :scs (complex-single-reg) :target y)
-	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
+         (nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
   (:results (y))
   (:note "float argument move")
   (:generator 1
     (sc-case y
       (complex-single-reg
        (unless (location= x y)
-	 (let ((x-real (complex-single-reg-real-tn x))
-	       (y-real (complex-single-reg-real-tn y)))
-	   (inst funop :copy x-real y-real))
-	 (let ((x-imag (complex-single-reg-imag-tn x))
-	       (y-imag (complex-single-reg-imag-tn y)))
-	   (inst funop :copy x-imag y-imag))))
+         (let ((x-real (complex-single-reg-real-tn x))
+               (y-real (complex-single-reg-real-tn y)))
+           (inst funop :copy x-real y-real))
+         (let ((x-imag (complex-single-reg-imag-tn x))
+               (y-imag (complex-single-reg-imag-tn y)))
+           (inst funop :copy x-imag y-imag))))
       (complex-single-stack
        (let ((offset (* (tn-offset y) n-word-bytes)))
-	 (let ((real-tn (complex-single-reg-real-tn x)))
-	   (str-float real-tn offset nfp))
-	 (let ((imag-tn (complex-single-reg-imag-tn x)))
-	   (str-float imag-tn (+ offset n-word-bytes) nfp)))))))
+         (let ((real-tn (complex-single-reg-real-tn x)))
+           (str-float real-tn offset nfp))
+         (let ((imag-tn (complex-single-reg-imag-tn x)))
+           (str-float imag-tn (+ offset n-word-bytes) nfp)))))))
 (define-move-vop move-complex-single-float-arg :move-arg
   (complex-single-reg descriptor-reg) (complex-single-reg))
 
 (define-vop (move-complex-double-float-arg)
   (:args (x :scs (complex-double-reg) :target y)
-	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
+         (nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
   (:results (y))
   (:note "float argument move")
   (:generator 1
     (sc-case y
       (complex-double-reg
        (unless (location= x y)
-	 (let ((x-real (complex-double-reg-real-tn x))
-	       (y-real (complex-double-reg-real-tn y)))
-	   (inst funop :copy x-real y-real))
-	 (let ((x-imag (complex-double-reg-imag-tn x))
-	       (y-imag (complex-double-reg-imag-tn y)))
-	   (inst funop :copy x-imag y-imag))))
+         (let ((x-real (complex-double-reg-real-tn x))
+               (y-real (complex-double-reg-real-tn y)))
+           (inst funop :copy x-real y-real))
+         (let ((x-imag (complex-double-reg-imag-tn x))
+               (y-imag (complex-double-reg-imag-tn y)))
+           (inst funop :copy x-imag y-imag))))
       (complex-double-stack
        (let ((offset (* (tn-offset y) n-word-bytes)))
-	 (let ((real-tn (complex-double-reg-real-tn x)))
-	   (str-float real-tn offset nfp))
-	 (let ((imag-tn (complex-double-reg-imag-tn x)))
-	   (str-float imag-tn (+ offset (* 2 n-word-bytes)) nfp)))))))
+         (let ((real-tn (complex-double-reg-real-tn x)))
+           (str-float real-tn offset nfp))
+         (let ((imag-tn (complex-double-reg-imag-tn x)))
+           (str-float imag-tn (+ offset (* 2 n-word-bytes)) nfp)))))))
 (define-move-vop move-complex-double-float-arg :move-arg
   (complex-double-reg descriptor-reg) (complex-double-reg))
 
@@ -346,25 +346,25 @@
       (inst fsts fp-single-zero-tn 0 csp-tn))))
 
 (macrolet ((frob (name sc zero-sc ptype)
-	     `(define-vop (,name float-op)
-		(:args (x :scs (,sc ,zero-sc))
-		       (y :scs (,sc ,zero-sc)))
-		(:results (r :scs (,sc)))
-		(:arg-types ,ptype ,ptype)
-		(:result-types ,ptype))))
+             `(define-vop (,name float-op)
+                (:args (x :scs (,sc ,zero-sc))
+                       (y :scs (,sc ,zero-sc)))
+                (:results (r :scs (,sc)))
+                (:arg-types ,ptype ,ptype)
+                (:result-types ,ptype))))
   (frob single-float-op single-reg fp-single-zero single-float)
   (frob double-float-op double-reg fp-double-zero double-float))
 
 (macrolet ((frob (translate op sname scost dname dcost)
-	     `(progn
-		(define-vop (,sname single-float-op)
-		  (:translate ,translate)
-		  (:variant ,op)
-		  (:variant-cost ,scost))
-		(define-vop (,dname double-float-op)
-		  (:translate ,translate)
-		  (:variant ,op)
-		  (:variant-cost ,dcost)))))
+             `(progn
+                (define-vop (,sname single-float-op)
+                  (:translate ,translate)
+                  (:variant ,op)
+                  (:variant-cost ,scost))
+                (define-vop (,dname double-float-op)
+                  (:translate ,translate)
+                  (:variant ,op)
+                  (:variant-cost ,dcost)))))
   (frob + :add +/single-float 2 +/double-float 2)
   (frob - :sub -/single-float 2 -/double-float 2)
   (frob * :mpy */single-float 4 */double-float 5)
@@ -372,22 +372,22 @@
 
 
 (macrolet ((frob (name translate sc type inst)
-	     `(define-vop (,name)
-		(:args (x :scs (,sc)))
-		(:results (y :scs (,sc)))
-		(:translate ,translate)
-		(:policy :fast-safe)
-		(:arg-types ,type)
-		(:result-types ,type)
-		(:note "inline float arithmetic")
-		(:vop-var vop)
-		(:save-p :compute-only)
-		(:node-var node)
-		(:generator 1
-		  ,inst
-		  (when (policy node (or (= debug 3) (> safety speed)))
-		    (note-next-instruction vop :internal-error)
-		    (inst fsts fp-single-zero-tn 0 csp-tn))))))
+             `(define-vop (,name)
+                (:args (x :scs (,sc)))
+                (:results (y :scs (,sc)))
+                (:translate ,translate)
+                (:policy :fast-safe)
+                (:arg-types ,type)
+                (:result-types ,type)
+                (:note "inline float arithmetic")
+                (:vop-var vop)
+                (:save-p :compute-only)
+                (:node-var node)
+                (:generator 1
+                  ,inst
+                  (when (policy node (or (= debug 3) (> safety speed)))
+                    (note-next-instruction vop :internal-error)
+                    (inst fsts fp-single-zero-tn 0 csp-tn))))))
   (frob abs/single-float abs single-reg single-float
     (inst funop :abs x y))
   (frob abs/double-float abs double-reg double-float
@@ -417,21 +417,21 @@
     (inst b target :nullify t)))
 
 (macrolet ((frob (name sc zero-sc ptype)
-	     `(define-vop (,name float-compare)
-		(:args (x :scs (,sc ,zero-sc))
-		       (y :scs (,sc ,zero-sc)))
-		(:arg-types ,ptype ,ptype))))
+             `(define-vop (,name float-compare)
+                (:args (x :scs (,sc ,zero-sc))
+                       (y :scs (,sc ,zero-sc)))
+                (:arg-types ,ptype ,ptype))))
   (frob single-float-compare single-reg fp-single-zero single-float)
   (frob double-float-compare double-reg fp-double-zero double-float))
 
 (macrolet ((frob (translate condition complement sname dname)
-	     `(progn
-		(define-vop (,sname single-float-compare)
-		  (:translate ,translate)
-		  (:variant ,condition ,complement))
-		(define-vop (,dname double-float-compare)
-		  (:translate ,translate)
-		  (:variant ,condition ,complement)))))
+             `(progn
+                (define-vop (,sname single-float-compare)
+                  (:translate ,translate)
+                  (:variant ,condition ,complement))
+                (define-vop (,dname double-float-compare)
+                  (:translate ,translate)
+                  (:variant ,condition ,complement)))))
   (frob < #b01001 #b10101 </single-float </double-float)
   (frob > #b10001 #b01101 >/single-float >/double-float)
   (frob = #b00101 #b11001 eql/single-float eql/double-float))
@@ -440,22 +440,22 @@
 ;;;; Conversion:
 
 (macrolet ((frob (name translate from-sc from-type to-sc to-type)
-	     `(define-vop (,name)
-		(:args (x :scs (,from-sc)))
-		(:results (y :scs (,to-sc)))
-		(:arg-types ,from-type)
-		(:result-types ,to-type)
-		(:policy :fast-safe)
-		(:note "inline float coercion")
-		(:translate ,translate)
-		(:vop-var vop)
-		(:save-p :compute-only)
-		(:node-var node)
-		(:generator 2
-		  (inst fcnvff x y)
-		  (when (policy node (or (= debug 3) (> safety speed)))
-		    (note-next-instruction vop :internal-error)
-		    (inst fsts fp-single-zero-tn 0 csp-tn))))))
+             `(define-vop (,name)
+                (:args (x :scs (,from-sc)))
+                (:results (y :scs (,to-sc)))
+                (:arg-types ,from-type)
+                (:result-types ,to-type)
+                (:policy :fast-safe)
+                (:note "inline float coercion")
+                (:translate ,translate)
+                (:vop-var vop)
+                (:save-p :compute-only)
+                (:node-var node)
+                (:generator 2
+                  (inst fcnvff x y)
+                  (when (policy node (or (= debug 3) (> safety speed)))
+                    (note-next-instruction vop :internal-error)
+                    (inst fsts fp-single-zero-tn 0 csp-tn))))))
   (frob %single-float/double-float %single-float
     double-reg double-float
     single-reg single-float)
@@ -464,44 +464,44 @@
     double-reg double-float))
 
 (macrolet ((frob (name translate to-sc to-type)
-	     `(define-vop (,name)
-		(:args (x :scs (signed-reg)
-			  :load-if (not (sc-is x signed-stack))
-			  :target stack-temp))
-		(:arg-types signed-num)
-		(:results (y :scs (,to-sc)))
-		(:result-types ,to-type)
-		(:policy :fast-safe)
-		(:note "inline float coercion")
-		(:translate ,translate)
-		(:vop-var vop)
-		(:save-p :compute-only)
-		(:node-var node)
-		(:temporary (:scs (signed-stack) :from (:argument 0))
-			    stack-temp)
-		(:temporary (:scs (single-reg) :to (:result 0) :target y)
-			    fp-temp)
-		(:temporary (:scs (any-reg) :from (:argument 0)
-				  :to (:result 0)) index)
-		(:generator 5
-		  (let* ((nfp (current-nfp-tn vop))
-			 (stack-tn
-			  (sc-case x
-			    (signed-stack
-			     x)
-			    (signed-reg
-			     (storew x nfp (tn-offset stack-temp))
-			     stack-temp)))
-			 (offset (* (tn-offset stack-tn) n-word-bytes)))
-		    (cond ((< offset (ash 1 4))
-			   (inst flds offset nfp fp-temp))
-			  (t
-			   (inst ldo offset zero-tn index)
-			   (inst fldx index nfp fp-temp)))
-		    (inst fcnvxf fp-temp y)
-		    (when (policy node (or (= debug 3) (> safety speed)))
-		      (note-next-instruction vop :internal-error)
-		      (inst fsts fp-single-zero-tn 0 csp-tn)))))))
+             `(define-vop (,name)
+                (:args (x :scs (signed-reg)
+                          :load-if (not (sc-is x signed-stack))
+                          :target stack-temp))
+                (:arg-types signed-num)
+                (:results (y :scs (,to-sc)))
+                (:result-types ,to-type)
+                (:policy :fast-safe)
+                (:note "inline float coercion")
+                (:translate ,translate)
+                (:vop-var vop)
+                (:save-p :compute-only)
+                (:node-var node)
+                (:temporary (:scs (signed-stack) :from (:argument 0))
+                            stack-temp)
+                (:temporary (:scs (single-reg) :to (:result 0) :target y)
+                            fp-temp)
+                (:temporary (:scs (any-reg) :from (:argument 0)
+                                  :to (:result 0)) index)
+                (:generator 5
+                  (let* ((nfp (current-nfp-tn vop))
+                         (stack-tn
+                          (sc-case x
+                            (signed-stack
+                             x)
+                            (signed-reg
+                             (storew x nfp (tn-offset stack-temp))
+                             stack-temp)))
+                         (offset (* (tn-offset stack-tn) n-word-bytes)))
+                    (cond ((< offset (ash 1 4))
+                           (inst flds offset nfp fp-temp))
+                          (t
+                           (inst ldo offset zero-tn index)
+                           (inst fldx index nfp fp-temp)))
+                    (inst fcnvxf fp-temp y)
+                    (when (policy node (or (= debug 3) (> safety speed)))
+                      (note-next-instruction vop :internal-error)
+                      (inst fsts fp-single-zero-tn 0 csp-tn)))))))
   (frob %single-float/signed %single-float
     single-reg single-float)
   (frob %double-float/signed %double-float
@@ -509,40 +509,40 @@
 
 
 (macrolet ((frob (trans from-sc from-type inst note)
-	     `(define-vop (,(symbolicate trans "/" from-type))
-		(:args (x :scs (,from-sc)
-			  :target fp-temp))
-		(:results (y :scs (signed-reg)
-			     :load-if (not (sc-is y signed-stack))))
-		(:arg-types ,from-type)
-		(:result-types signed-num)
-		(:translate ,trans)
-		(:policy :fast-safe)
-		(:note ,note)
-		(:vop-var vop)
-		(:save-p :compute-only)
-		(:temporary (:scs (single-reg) :from (:argument 0)) fp-temp)
-		(:temporary (:scs (signed-stack) :to (:result 0) :target y)
-			    stack-temp)
-		(:temporary (:scs (any-reg) :from (:argument 0)
-				  :to (:result 0)) index)
-		(:generator 3
-		  (let* ((nfp (current-nfp-tn vop))
-			 (stack-tn
-			  (sc-case y
-			    (signed-stack y)
-			    (signed-reg stack-temp)))
-			 (offset (* (tn-offset stack-tn) n-word-bytes)))
-		    (inst ,inst x fp-temp)
-		    (cond ((< offset (ash 1 4))
-			   (note-next-instruction vop :internal-error)
-			   (inst fsts fp-temp offset nfp))
-			  (t
-			   (inst ldo offset zero-tn index)
-			   (note-next-instruction vop :internal-error)
-			   (inst fstx fp-temp index nfp)))
-		    (unless (eq y stack-tn)
-		      (loadw y nfp (tn-offset stack-tn))))))))
+             `(define-vop (,(symbolicate trans "/" from-type))
+                (:args (x :scs (,from-sc)
+                          :target fp-temp))
+                (:results (y :scs (signed-reg)
+                             :load-if (not (sc-is y signed-stack))))
+                (:arg-types ,from-type)
+                (:result-types signed-num)
+                (:translate ,trans)
+                (:policy :fast-safe)
+                (:note ,note)
+                (:vop-var vop)
+                (:save-p :compute-only)
+                (:temporary (:scs (single-reg) :from (:argument 0)) fp-temp)
+                (:temporary (:scs (signed-stack) :to (:result 0) :target y)
+                            stack-temp)
+                (:temporary (:scs (any-reg) :from (:argument 0)
+                                  :to (:result 0)) index)
+                (:generator 3
+                  (let* ((nfp (current-nfp-tn vop))
+                         (stack-tn
+                          (sc-case y
+                            (signed-stack y)
+                            (signed-reg stack-temp)))
+                         (offset (* (tn-offset stack-tn) n-word-bytes)))
+                    (inst ,inst x fp-temp)
+                    (cond ((< offset (ash 1 4))
+                           (note-next-instruction vop :internal-error)
+                           (inst fsts fp-temp offset nfp))
+                          (t
+                           (inst ldo offset zero-tn index)
+                           (note-next-instruction vop :internal-error)
+                           (inst fstx fp-temp index nfp)))
+                    (unless (eq y stack-tn)
+                      (loadw y nfp (tn-offset stack-tn))))))))
   (frob %unary-round single-reg single-float fcnvfx "inline float round")
   (frob %unary-round double-reg double-float fcnvfx "inline float round")
   (frob %unary-truncate single-reg single-float fcnvfxt
@@ -553,11 +553,11 @@
 
 (define-vop (make-single-float)
   (:args (bits :scs (signed-reg)
-	       :load-if (or (not (sc-is bits signed-stack))
-			    (sc-is res single-stack))
-	       :target res))
+               :load-if (or (not (sc-is bits signed-stack))
+                            (sc-is res single-stack))
+               :target res))
   (:results (res :scs (single-reg)
-		 :load-if (not (sc-is bits single-stack))))
+                 :load-if (not (sc-is bits single-stack))))
   (:arg-types signed-num)
   (:result-types single-float)
   (:translate make-single-float)
@@ -568,33 +568,33 @@
   (:generator 2
     (let ((nfp (current-nfp-tn vop)))
       (sc-case bits
-	(signed-reg
-	 (sc-case res
-	   (single-reg
-	    (let ((offset (* (tn-offset temp) n-word-bytes)))
-	      (inst stw bits offset nfp)
-	      (cond ((< offset (ash 1 4))
-		     (inst flds offset nfp res))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fldx index nfp res)))))
-	   (single-stack
-	    (inst stw bits (* (tn-offset res) n-word-bytes) nfp))))
-	(signed-stack
-	 (sc-case res
-	   (single-reg
-	    (let ((offset (* (tn-offset bits) n-word-bytes)))
-	      (cond ((< offset (ash 1 4))
-		     (inst flds offset nfp res))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fldx index nfp res)))))))))))
+        (signed-reg
+         (sc-case res
+           (single-reg
+            (let ((offset (* (tn-offset temp) n-word-bytes)))
+              (inst stw bits offset nfp)
+              (cond ((< offset (ash 1 4))
+                     (inst flds offset nfp res))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fldx index nfp res)))))
+           (single-stack
+            (inst stw bits (* (tn-offset res) n-word-bytes) nfp))))
+        (signed-stack
+         (sc-case res
+           (single-reg
+            (let ((offset (* (tn-offset bits) n-word-bytes)))
+              (cond ((< offset (ash 1 4))
+                     (inst flds offset nfp res))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fldx index nfp res)))))))))))
 
 (define-vop (make-double-float)
   (:args (hi-bits :scs (signed-reg))
-	 (lo-bits :scs (unsigned-reg)))
+         (lo-bits :scs (unsigned-reg)))
   (:results (res :scs (double-reg)
-		 :load-if (not (sc-is res double-stack))))
+                 :load-if (not (sc-is res double-stack))))
   (:arg-types signed-num unsigned-num)
   (:result-types double-float)
   (:translate make-double-float)
@@ -604,26 +604,26 @@
   (:vop-var vop)
   (:generator 2
     (let* ((nfp (current-nfp-tn vop))
-	   (stack-tn (sc-case res
-		       (double-stack res)
-		       (double-reg temp)))
-	   (offset (* (tn-offset stack-tn) n-word-bytes)))
+           (stack-tn (sc-case res
+                       (double-stack res)
+                       (double-reg temp)))
+           (offset (* (tn-offset stack-tn) n-word-bytes)))
       (inst stw hi-bits offset nfp)
       (inst stw lo-bits (+ offset n-word-bytes) nfp)
       (cond ((eq stack-tn res))
-	    ((< offset (ash 1 4))
-	     (inst flds offset nfp res))
-	    (t
-	     (inst ldo offset zero-tn index)
-	     (inst fldx index nfp res))))))
+            ((< offset (ash 1 4))
+             (inst flds offset nfp res))
+            (t
+             (inst ldo offset zero-tn index)
+             (inst fldx index nfp res))))))
 
 
 (define-vop (single-float-bits)
   (:args (float :scs (single-reg)
-		:load-if (not (sc-is float single-stack))))
+                :load-if (not (sc-is float single-stack))))
   (:results (bits :scs (signed-reg)
-		  :load-if (or (not (sc-is bits signed-stack))
-			       (sc-is float single-stack))))
+                  :load-if (or (not (sc-is bits signed-stack))
+                               (sc-is float single-stack))))
   (:arg-types single-float)
   (:result-types signed-num)
   (:translate single-float-bits)
@@ -634,34 +634,34 @@
   (:generator 2
     (let ((nfp (current-nfp-tn vop)))
       (sc-case float
-	(single-reg
-	 (sc-case bits
-	   (signed-reg
-	    (let ((offset (* (tn-offset temp) n-word-bytes)))
-	      (cond ((< offset (ash 1 4))
-		     (inst fsts float offset nfp))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fstx float index nfp)))
-	      (inst ldw offset nfp bits)))
-	   (signed-stack
-	    (let ((offset (* (tn-offset bits) n-word-bytes)))
-	      (cond ((< offset (ash 1 4))
-		     (inst fsts float offset nfp))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fstx float index nfp)))))))
-	(single-stack
-	 (sc-case bits
-	   (signed-reg
-	    (inst ldw (* (tn-offset float) n-word-bytes) nfp bits))))))))
+        (single-reg
+         (sc-case bits
+           (signed-reg
+            (let ((offset (* (tn-offset temp) n-word-bytes)))
+              (cond ((< offset (ash 1 4))
+                     (inst fsts float offset nfp))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fstx float index nfp)))
+              (inst ldw offset nfp bits)))
+           (signed-stack
+            (let ((offset (* (tn-offset bits) n-word-bytes)))
+              (cond ((< offset (ash 1 4))
+                     (inst fsts float offset nfp))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fstx float index nfp)))))))
+        (single-stack
+         (sc-case bits
+           (signed-reg
+            (inst ldw (* (tn-offset float) n-word-bytes) nfp bits))))))))
 
 (define-vop (double-float-high-bits)
   (:args (float :scs (double-reg)
-		:load-if (not (sc-is float double-stack))))
+                :load-if (not (sc-is float double-stack))))
   (:results (hi-bits :scs (signed-reg)
-		     :load-if (or (not (sc-is hi-bits signed-stack))
-				  (sc-is float double-stack))))
+                     :load-if (or (not (sc-is hi-bits signed-stack))
+                                  (sc-is float double-stack))))
   (:arg-types double-float)
   (:result-types signed-num)
   (:translate double-float-high-bits)
@@ -672,35 +672,35 @@
   (:generator 2
     (let ((nfp (current-nfp-tn vop)))
       (sc-case float
-	(double-reg
-	 (sc-case hi-bits
-	   (signed-reg
-	    (let ((offset (* (tn-offset temp) n-word-bytes)))
-	      (cond ((< offset (ash 1 4))
-		     (inst fsts float offset nfp :side 0))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fstx float index nfp :side 0)))
-	      (inst ldw offset nfp hi-bits)))
-	   (signed-stack
-	    (let ((offset (* (tn-offset hi-bits) n-word-bytes)))
-	      (cond ((< offset (ash 1 4))
-		     (inst fsts float offset nfp :side 0))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fstx float index nfp :side 0)))))))
-	(double-stack
-	 (sc-case hi-bits
-	   (signed-reg
-	    (let ((offset (* (tn-offset float) n-word-bytes)))
-	      (inst ldw offset nfp hi-bits)))))))))
+        (double-reg
+         (sc-case hi-bits
+           (signed-reg
+            (let ((offset (* (tn-offset temp) n-word-bytes)))
+              (cond ((< offset (ash 1 4))
+                     (inst fsts float offset nfp :side 0))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fstx float index nfp :side 0)))
+              (inst ldw offset nfp hi-bits)))
+           (signed-stack
+            (let ((offset (* (tn-offset hi-bits) n-word-bytes)))
+              (cond ((< offset (ash 1 4))
+                     (inst fsts float offset nfp :side 0))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fstx float index nfp :side 0)))))))
+        (double-stack
+         (sc-case hi-bits
+           (signed-reg
+            (let ((offset (* (tn-offset float) n-word-bytes)))
+              (inst ldw offset nfp hi-bits)))))))))
 
 (define-vop (double-float-low-bits)
   (:args (float :scs (double-reg)
-		:load-if (not (sc-is float double-stack))))
+                :load-if (not (sc-is float double-stack))))
   (:results (lo-bits :scs (unsigned-reg)
-		     :load-if (or (not (sc-is lo-bits unsigned-stack))
-				  (sc-is float double-stack))))
+                     :load-if (or (not (sc-is lo-bits unsigned-stack))
+                                  (sc-is float double-stack))))
   (:arg-types double-float)
   (:result-types unsigned-num)
   (:translate double-float-low-bits)
@@ -711,28 +711,28 @@
   (:generator 2
     (let ((nfp (current-nfp-tn vop)))
       (sc-case float
-	(double-reg
-	 (sc-case lo-bits
-	   (unsigned-reg
-	    (let ((offset (* (tn-offset temp) n-word-bytes)))
-	      (cond ((< offset (ash 1 4))
-		     (inst fsts float offset nfp :side 1))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fstx float index nfp :side 1)))
-	      (inst ldw offset nfp lo-bits)))
-	   (unsigned-stack
-	    (let ((offset (* (tn-offset lo-bits) n-word-bytes)))
-	      (cond ((< offset (ash 1 4))
-		     (inst fsts float offset nfp :side 1))
-		    (t
-		     (inst ldo offset zero-tn index)
-		     (inst fstx float index nfp :side 1)))))))
-	(double-stack
-	 (sc-case lo-bits
-	   (unsigned-reg
-	    (let ((offset (* (1+ (tn-offset float)) n-word-bytes)))
-	      (inst ldw offset nfp lo-bits)))))))))
+        (double-reg
+         (sc-case lo-bits
+           (unsigned-reg
+            (let ((offset (* (tn-offset temp) n-word-bytes)))
+              (cond ((< offset (ash 1 4))
+                     (inst fsts float offset nfp :side 1))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fstx float index nfp :side 1)))
+              (inst ldw offset nfp lo-bits)))
+           (unsigned-stack
+            (let ((offset (* (tn-offset lo-bits) n-word-bytes)))
+              (cond ((< offset (ash 1 4))
+                     (inst fsts float offset nfp :side 1))
+                    (t
+                     (inst ldo offset zero-tn index)
+                     (inst fstx float index nfp :side 1)))))))
+        (double-stack
+         (sc-case lo-bits
+           (unsigned-reg
+            (let ((offset (* (1+ (tn-offset float)) n-word-bytes)))
+              (inst ldw offset nfp lo-bits)))))))))
 
 
 
@@ -745,7 +745,7 @@
 
 (define-vop (floating-point-modes)
   (:results (res :scs (unsigned-reg)
-		 :load-if (not (sc-is res unsigned-stack))))
+                 :load-if (not (sc-is res unsigned-stack))))
   (:result-types unsigned-num)
   (:translate floating-point-modes)
   (:policy :fast-safe)
@@ -754,21 +754,21 @@
   (:vop-var vop)
   (:generator 3
     (let* ((nfp (current-nfp-tn vop))
-	   (stack-tn (sc-case res
-		       (unsigned-stack res)
-		       (unsigned-reg temp)))
-	   (offset (* (tn-offset stack-tn) n-word-bytes)))
+           (stack-tn (sc-case res
+                       (unsigned-stack res)
+                       (unsigned-reg temp)))
+           (offset (* (tn-offset stack-tn) n-word-bytes)))
       (cond ((< offset (ash 1 4))
-	     (inst fsts fp-single-zero-tn offset nfp))
-	    (t
-	     (inst ldo offset zero-tn index)
-	     (inst fstx fp-single-zero-tn index nfp)))
+             (inst fsts fp-single-zero-tn offset nfp))
+            (t
+             (inst ldo offset zero-tn index)
+             (inst fstx fp-single-zero-tn index nfp)))
       (unless (eq stack-tn res)
-	(inst ldw offset nfp res)))))
+        (inst ldw offset nfp res)))))
 
 (define-vop (set-floating-point-modes)
   (:args (new :scs (unsigned-reg)
-	      :load-if (not (sc-is new unsigned-stack))))
+              :load-if (not (sc-is new unsigned-stack))))
   (:results (res :scs (unsigned-reg)))
   (:arg-types unsigned-num)
   (:result-types unsigned-num)
@@ -779,17 +779,17 @@
   (:vop-var vop)
   (:generator 3
     (let* ((nfp (current-nfp-tn vop))
-	   (stack-tn (sc-case new
-		       (unsigned-stack new)
-		       (unsigned-reg temp)))
-	   (offset (* (tn-offset stack-tn) n-word-bytes)))
+           (stack-tn (sc-case new
+                       (unsigned-stack new)
+                       (unsigned-reg temp)))
+           (offset (* (tn-offset stack-tn) n-word-bytes)))
       (unless (eq new stack-tn)
-	(inst stw new offset nfp))
+        (inst stw new offset nfp))
       (cond ((< offset (ash 1 4))
-	     (inst flds offset nfp fp-single-zero-tn))
-	    (t
-	     (inst ldo offset zero-tn index)
-	     (inst fldx index nfp fp-single-zero-tn)))
+             (inst flds offset nfp fp-single-zero-tn))
+            (t
+             (inst ldo offset zero-tn index)
+             (inst fldx index nfp fp-single-zero-tn)))
       (inst ldw offset nfp res))))
 
 
@@ -798,10 +798,10 @@
 (define-vop (make-complex-single-float)
   (:translate complex)
   (:args (real :scs (single-reg) :target r)
-	 (imag :scs (single-reg) :to :save))
+         (imag :scs (single-reg) :to :save))
   (:arg-types single-float single-float)
   (:results (r :scs (complex-single-reg) :from (:argument 0)
-	       :load-if (not (sc-is r complex-single-stack))))
+               :load-if (not (sc-is r complex-single-stack))))
   (:result-types complex-single-float)
   (:note "inline complex single-float creation")
   (:policy :fast-safe)
@@ -810,24 +810,24 @@
     (sc-case r
       (complex-single-reg
        (let ((r-real (complex-single-reg-real-tn r)))
-	 (unless (location= real r-real)
-	   (inst funop :copy real r-real)))
+         (unless (location= real r-real)
+           (inst funop :copy real r-real)))
        (let ((r-imag (complex-single-reg-imag-tn r)))
-	 (unless (location= imag r-imag)
-	   (inst funop :copy imag r-imag))))
+         (unless (location= imag r-imag)
+           (inst funop :copy imag r-imag))))
       (complex-single-stack
        (let ((nfp (current-nfp-tn vop))
-	     (offset (* (tn-offset r) n-word-bytes)))
-	 (str-float real offset nfp)
-	 (str-float imag (+ offset n-word-bytes) nfp))))))
+             (offset (* (tn-offset r) n-word-bytes)))
+         (str-float real offset nfp)
+         (str-float imag (+ offset n-word-bytes) nfp))))))
 
 (define-vop (make-complex-double-float)
   (:translate complex)
   (:args (real :scs (double-reg) :target r)
-	 (imag :scs (double-reg) :to :save))
+         (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))))
+               :load-if (not (sc-is r complex-double-stack))))
   (:result-types complex-double-float)
   (:note "inline complex double-float creation")
   (:policy :fast-safe)
@@ -836,21 +836,21 @@
     (sc-case r
       (complex-double-reg
        (let ((r-real (complex-double-reg-real-tn r)))
-	 (unless (location= real r-real)
-	   (inst funop :copy real r-real)))
+         (unless (location= real r-real)
+           (inst funop :copy real r-real)))
        (let ((r-imag (complex-double-reg-imag-tn r)))
-	 (unless (location= imag r-imag)
-	   (inst funop :copy imag r-imag))))
+         (unless (location= imag r-imag)
+           (inst funop :copy imag r-imag))))
       (complex-double-stack
        (let ((nfp (current-nfp-tn vop))
-	     (offset (* (tn-offset r) n-word-bytes)))
-	 (str-float real offset nfp)
-	 (str-float imag (+ offset (* 2 n-word-bytes)) nfp))))))
+             (offset (* (tn-offset r) n-word-bytes)))
+         (str-float real offset nfp)
+         (str-float imag (+ offset (* 2 n-word-bytes)) nfp))))))
 
 
 (define-vop (complex-single-float-value)
   (:args (x :scs (complex-single-reg) :target r
-	    :load-if (not (sc-is x complex-single-stack))))
+            :load-if (not (sc-is x complex-single-stack))))
   (:arg-types complex-single-float)
   (:results (r :scs (single-reg)))
   (:result-types single-float)
@@ -861,14 +861,14 @@
     (sc-case x
       (complex-single-reg
        (let ((value-tn (ecase slot
-			 (:real (complex-single-reg-real-tn x))
-			 (:imag (complex-single-reg-imag-tn x)))))
-	 (unless (location= value-tn r)
-	   (inst funop :copy value-tn r))))
+                         (:real (complex-single-reg-real-tn x))
+                         (:imag (complex-single-reg-imag-tn x)))))
+         (unless (location= value-tn r)
+           (inst funop :copy value-tn r))))
       (complex-single-stack
        (ld-float (* (+ (ecase slot (:real 0) (:imag 1)) (tn-offset x))
-		    n-word-bytes)
-		 (current-nfp-tn vop) r)))))
+                    n-word-bytes)
+                 (current-nfp-tn vop) r)))))
 
 (define-vop (realpart/complex-single-float complex-single-float-value)
   (:translate realpart)
@@ -882,7 +882,7 @@
 
 (define-vop (complex-double-float-value)
   (:args (x :scs (complex-double-reg) :target r
-	    :load-if (not (sc-is x complex-double-stack))))
+            :load-if (not (sc-is x complex-double-stack))))
   (:arg-types complex-double-float)
   (:results (r :scs (double-reg)))
   (:result-types double-float)
@@ -893,14 +893,14 @@
     (sc-case x
       (complex-double-reg
        (let ((value-tn (ecase slot
-			 (:real (complex-double-reg-real-tn x))
-			 (:imag (complex-double-reg-imag-tn x)))))
-	 (unless (location= value-tn r)
-	   (inst funop :copy value-tn r))))
+                         (:real (complex-double-reg-real-tn x))
+                         (:imag (complex-double-reg-imag-tn x)))))
+         (unless (location= value-tn r)
+           (inst funop :copy value-tn r))))
       (complex-double-stack
        (ld-float (* (+ (ecase slot (:real 0) (:imag 2)) (tn-offset x))
-		    n-word-bytes)
-		 (current-nfp-tn vop) r)))))
+                    n-word-bytes)
+                 (current-nfp-tn vop) r)))))
 
 (define-vop (realpart/complex-double-float complex-double-float-value)
   (:translate realpart)