X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Ffloat.lisp;h=5b008cde6a388519b04ecb897faca6b45a5b59b4;hb=bc7cd341567dd3b2978c2accb6063356280fb80e;hp=0a6c97b7f985b443999cb2bd9b9daa4c2703c701;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git

diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp
index 0a6c97b..5b008cd 100644
--- a/src/compiler/ppc/float.lisp
+++ b/src/compiler/ppc/float.lisp
@@ -1,31 +1,37 @@
-2;;;
-;;; Written by Rob MacLachlan
-;;; Sparc conversion by William Lott.
-;;;
-(in-package "SB!VM")
+;;;; floating point support for the PPC
 
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!VM")
 
 ;;;; Move functions:
 
 (define-move-fun (load-single 1) (vop x y)
   ((single-stack) (single-reg))
-  (inst lfs y (current-nfp-tn vop) (* (tn-offset x) sb!vm:n-word-bytes)))
+  (inst lfs y (current-nfp-tn vop) (* (tn-offset x) n-word-bytes)))
 
 (define-move-fun (store-single 1) (vop x y)
   ((single-reg) (single-stack))
-  (inst stfs x (current-nfp-tn vop) (* (tn-offset y) sb!vm:n-word-bytes)))
+  (inst stfs x (current-nfp-tn vop) (* (tn-offset y) n-word-bytes)))
 
 
 (define-move-fun (load-double 2) (vop x y)
   ((double-stack) (double-reg))
   (let ((nfp (current-nfp-tn vop))
-	(offset (* (tn-offset x) sb!vm:n-word-bytes)))
+        (offset (* (tn-offset x) n-word-bytes)))
     (inst lfd y nfp offset)))
 
 (define-move-fun (store-double 2) (vop x y)
   ((double-reg) (double-stack))
   (let ((nfp (current-nfp-tn vop))
-	(offset (* (tn-offset y) sb!vm:n-word-bytes)))
+        (offset (* (tn-offset y) n-word-bytes)))
     (inst stfd x nfp offset)))
 
 
@@ -33,18 +39,18 @@
 ;;;; Move VOPs:
 
 (macrolet ((frob (vop sc)
-	     `(progn
-		(define-vop (,vop)
-		  (:args (x :scs (,sc)
-			    :target y
-			    :load-if (not (location= x y))))
-		  (:results (y :scs (,sc)
-			       :load-if (not (location= x y))))
-		  (:note "float move")
-		  (:generator 0
-		    (unless (location= y x)
+             `(progn
+                (define-vop (,vop)
+                  (:args (x :scs (,sc)
+                            :target y
+                            :load-if (not (location= x y))))
+                  (:results (y :scs (,sc)
+                               :load-if (not (location= x y))))
+                  (:note "float move")
+                  (:generator 0
+                    (unless (location= y x)
                       (inst fmr y x))))
-		(define-move-vop ,vop :move (,sc) (,sc)))))
+                (define-move-vop ,vop :move (,sc) (,sc)))))
   (frob single-move single-reg)
   (frob double-move double-reg))
 
@@ -57,55 +63,55 @@
   (: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 sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag))
-	(inst stfs x y (- (* data sb!vm:n-word-bytes) sb!vm: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
-		(define-vop (,name move-from-float)
-		  (:args (x :scs (,sc) :to :save))
-		  (:results (y :scs (descriptor-reg)))
-		  (:variant ,@args))
-		(define-move-vop ,name :move (,sc) (descriptor-reg)))))
+             `(progn
+                (define-vop (,name move-from-float)
+                  (:args (x :scs (,sc) :to :save))
+                  (:results (y :scs (descriptor-reg)))
+                  (:variant ,@args))
+                (define-move-vop ,name :move (,sc) (descriptor-reg)))))
   (frob move-from-single single-reg
-    nil sb!vm:single-float-size sb!vm:single-float-widetag sb!vm:single-float-value-slot)
+    nil single-float-size single-float-widetag single-float-value-slot)
   (frob move-from-double double-reg
-    t sb!vm:double-float-size sb!vm:double-float-widetag sb!vm:double-float-value-slot))
+    t double-float-size double-float-widetag double-float-value-slot))
 
 (macrolet ((frob (name sc double-p value)
-	     `(progn
-		(define-vop (,name)
-		  (:args (x :scs (descriptor-reg)))
-		  (:results (y :scs (,sc)))
-		  (:note "pointer to float coercion")
-		  (:generator 2
-		    (inst ,(if double-p 'lfd 'lfs) y x
-			  (- (* ,value sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag))))
-		(define-move-vop ,name :move (descriptor-reg) (,sc)))))
-  (frob move-to-single single-reg nil sb!vm:single-float-value-slot)
-  (frob move-to-double double-reg t sb!vm:double-float-value-slot))
+             `(progn
+                (define-vop (,name)
+                  (:args (x :scs (descriptor-reg)))
+                  (:results (y :scs (,sc)))
+                  (:note "pointer to float coercion")
+                  (:generator 2
+                    (inst ,(if double-p 'lfd 'lfs) y x
+                          (- (* ,value n-word-bytes) other-pointer-lowtag))))
+                (define-move-vop ,name :move (descriptor-reg) (,sc)))))
+  (frob move-to-single single-reg nil single-float-value-slot)
+  (frob move-to-double double-reg t double-float-value-slot))
 
 
 (macrolet ((frob (name sc stack-sc double-p)
-	     `(progn
-		(define-vop (,name)
-		  (:args (x :scs (,sc) :target y)
-			 (nfp :scs (any-reg)
-			      :load-if (not (sc-is y ,sc))))
-		  (:results (y))
-		  (:note "float arg move")
-		  (:generator ,(if double-p 2 1)
-		    (sc-case y
-		      (,sc
-		       (unless (location= x y)
-			 (inst fmr y x)))
-		      (,stack-sc
-		       (let ((offset (* (tn-offset y) sb!vm:n-word-bytes)))
-			 (inst ,(if double-p 'stfd 'stfs) x nfp offset))))))
-		(define-move-vop ,name :move-arg
-		  (,sc descriptor-reg) (,sc)))))
+             `(progn
+                (define-vop (,name)
+                  (:args (x :scs (,sc) :target y)
+                         (nfp :scs (any-reg)
+                              :load-if (not (sc-is y ,sc))))
+                  (:results (y))
+                  (:note "float arg move")
+                  (:generator ,(if double-p 2 1)
+                    (sc-case y
+                      (,sc
+                       (unless (location= x y)
+                         (inst fmr y x)))
+                      (,stack-sc
+                       (let ((offset (* (tn-offset y) n-word-bytes)))
+                         (inst ,(if double-p 'stfd 'stfs) x nfp offset))))))
+                (define-move-vop ,name :move-arg
+                  (,sc descriptor-reg) (,sc)))))
   (frob move-single-float-arg single-reg single-stack nil)
   (frob move-double-float-arg double-reg double-stack t))
 
@@ -115,55 +121,55 @@
 
 (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 (+ (tn-offset x) 2)))
+                  :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) sb!vm:n-word-bytes)))
+        (offset (* (tn-offset x) n-word-bytes)))
     (let ((real-tn (complex-single-reg-real-tn y)))
       (inst lfs real-tn nfp offset))
     (let ((imag-tn (complex-single-reg-imag-tn y)))
-      (inst lfs imag-tn nfp (+ offset sb!vm:n-word-bytes)))))
+      (inst lfs imag-tn nfp (+ offset n-word-bytes)))))
 
 (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) sb!vm:n-word-bytes)))
+        (offset (* (tn-offset y) n-word-bytes)))
     (let ((real-tn (complex-single-reg-real-tn x)))
       (inst stfs real-tn nfp offset))
     (let ((imag-tn (complex-single-reg-imag-tn x)))
-      (inst stfs imag-tn nfp (+ offset sb!vm:n-word-bytes)))))
+      (inst stfs imag-tn nfp (+ offset n-word-bytes)))))
 
 
 (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) sb!vm:n-word-bytes)))
+        (offset (* (tn-offset x) n-word-bytes)))
     (let ((real-tn (complex-double-reg-real-tn y)))
       (inst lfd real-tn nfp offset))
     (let ((imag-tn (complex-double-reg-imag-tn y)))
-      (inst lfd imag-tn nfp (+ offset (* 2 sb!vm:n-word-bytes))))))
+      (inst lfd imag-tn nfp (+ offset (* 2 n-word-bytes))))))
 
 (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) sb!vm:n-word-bytes)))
+        (offset (* (tn-offset y) n-word-bytes)))
     (let ((real-tn (complex-double-reg-real-tn x)))
       (inst stfd real-tn nfp offset))
     (let ((imag-tn (complex-double-reg-imag-tn x)))
-      (inst stfd imag-tn nfp (+ offset (* 2 sb!vm:n-word-bytes))))))
+      (inst stfd imag-tn nfp (+ offset (* 2 n-word-bytes))))))
 
 
 ;;;
@@ -171,7 +177,7 @@
 ;;;
 (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
@@ -179,18 +185,18 @@
        ;; 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 fmr y-real x-real))
+             (y-real (complex-single-reg-real-tn y)))
+         (inst fmr y-real x-real))
        (let ((x-imag (complex-single-reg-imag-tn x))
-	     (y-imag (complex-single-reg-imag-tn y)))
-	 (inst fmr y-imag x-imag)))))
+             (y-imag (complex-single-reg-imag-tn y)))
+         (inst fmr y-imag x-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
@@ -198,11 +204,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 fmr y-real x-real))
+             (y-real (complex-double-reg-real-tn y)))
+         (inst fmr y-real x-real))
        (let ((x-imag (complex-double-reg-imag-tn x))
-	     (y-imag (complex-double-reg-imag-tn y)))
-	 (inst fmr y-imag x-imag)))))
+             (y-imag (complex-double-reg-imag-tn y)))
+         (inst fmr y-imag x-imag)))))
 ;;;
 (define-move-vop complex-double-move :move
   (complex-double-reg) (complex-double-reg))
@@ -219,16 +225,16 @@
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:note "complex single float to pointer coercion")
   (:generator 13
-     (with-fixed-allocation (y pa-flag ndescr sb!vm:complex-single-float-widetag
-			       sb!vm:complex-single-float-size))
-     (let ((real-tn (complex-single-reg-real-tn x)))
-       (inst stfs real-tn y (- (* sb!vm:complex-single-float-real-slot
-				  sb!vm:n-word-bytes)
-			       sb!vm:other-pointer-lowtag)))
-     (let ((imag-tn (complex-single-reg-imag-tn x)))
-       (inst stfs imag-tn y (- (* sb!vm:complex-single-float-imag-slot
-				  sb!vm:n-word-bytes)
-			       sb!vm:other-pointer-lowtag)))))
+     (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))))))
 ;;;
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))
@@ -240,16 +246,16 @@
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:note "complex double float to pointer coercion")
   (:generator 13
-     (with-fixed-allocation (y pa-flag ndescr sb!vm:complex-double-float-widetag
-			       sb!vm:complex-double-float-size))
-     (let ((real-tn (complex-double-reg-real-tn x)))
-       (inst stfd real-tn y (- (* sb!vm:complex-double-float-real-slot
-				  sb!vm:n-word-bytes)
-			       sb!vm:other-pointer-lowtag)))
-     (let ((imag-tn (complex-double-reg-imag-tn x)))
-       (inst stfd imag-tn y (- (* sb!vm:complex-double-float-imag-slot
-				  sb!vm:n-word-bytes)
-			       sb!vm:other-pointer-lowtag)))))
+     (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))))))
 ;;;
 (define-move-vop move-from-complex-double :move
   (complex-double-reg) (descriptor-reg))
@@ -265,10 +271,10 @@
   (:generator 2
     (let ((real-tn (complex-single-reg-real-tn y)))
       (inst lfs real-tn x (- (* complex-single-float-real-slot n-word-bytes)
-			     other-pointer-lowtag)))
+                             other-pointer-lowtag)))
     (let ((imag-tn (complex-single-reg-imag-tn y)))
       (inst lfs imag-tn x (- (* complex-single-float-imag-slot n-word-bytes)
-			     other-pointer-lowtag)))))
+                             other-pointer-lowtag)))))
 (define-move-vop move-to-complex-single :move
   (descriptor-reg) (complex-single-reg))
 
@@ -279,10 +285,10 @@
   (:generator 2
     (let ((real-tn (complex-double-reg-real-tn y)))
       (inst lfd real-tn x (- (* complex-double-float-real-slot n-word-bytes)
-			     other-pointer-lowtag)))
+                             other-pointer-lowtag)))
     (let ((imag-tn (complex-double-reg-imag-tn y)))
       (inst lfd imag-tn x (- (* complex-double-float-imag-slot n-word-bytes)
-			     other-pointer-lowtag)))))
+                             other-pointer-lowtag)))))
 (define-move-vop move-to-complex-double :move
   (descriptor-reg) (complex-double-reg))
 
@@ -292,49 +298,49 @@
 ;;;
 (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 "complex single-float arg 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 fmr y-real x-real))
-	 (let ((x-imag (complex-single-reg-imag-tn x))
-	       (y-imag (complex-single-reg-imag-tn y)))
-	   (inst fmr y-imag x-imag))))
+         (let ((x-real (complex-single-reg-real-tn x))
+               (y-real (complex-single-reg-real-tn y)))
+           (inst fmr y-real x-real))
+         (let ((x-imag (complex-single-reg-imag-tn x))
+               (y-imag (complex-single-reg-imag-tn y)))
+           (inst fmr y-imag x-imag))))
       (complex-single-stack
        (let ((offset (* (tn-offset y) n-word-bytes)))
-	 (let ((real-tn (complex-single-reg-real-tn x)))
-	   (inst stfs real-tn nfp offset))
-	 (let ((imag-tn (complex-single-reg-imag-tn x)))
-	   (inst stfs imag-tn nfp (+ offset n-word-bytes))))))))
+         (let ((real-tn (complex-single-reg-real-tn x)))
+           (inst stfs real-tn nfp offset))
+         (let ((imag-tn (complex-single-reg-imag-tn x)))
+           (inst stfs imag-tn nfp (+ offset n-word-bytes))))))))
 (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 "complex double-float arg move")
   (:generator 2
     (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 fmr y-real x-real))
-	 (let ((x-imag (complex-double-reg-imag-tn x))
-	       (y-imag (complex-double-reg-imag-tn y)))
-	   (inst fmr y-imag x-imag))))
+         (let ((x-real (complex-double-reg-real-tn x))
+               (y-real (complex-double-reg-real-tn y)))
+           (inst fmr y-real x-real))
+         (let ((x-imag (complex-double-reg-imag-tn x))
+               (y-imag (complex-double-reg-imag-tn y)))
+           (inst fmr y-imag x-imag))))
       (complex-double-stack
        (let ((offset (* (tn-offset y) n-word-bytes)))
-	 (let ((real-tn (complex-double-reg-real-tn x)))
-	   (inst stfd real-tn nfp offset))
-	 (let ((imag-tn (complex-double-reg-imag-tn x)))
-	   (inst stfd imag-tn nfp (+ offset (* 2 n-word-bytes)))))))))
+         (let ((real-tn (complex-double-reg-real-tn x)))
+           (inst stfd real-tn nfp offset))
+         (let ((imag-tn (complex-double-reg-imag-tn x)))
+           (inst stfd imag-tn nfp (+ offset (* 2 n-word-bytes)))))))))
 (define-move-vop move-complex-double-float-arg :move-arg
   (complex-double-reg descriptor-reg) (complex-double-reg))
 
@@ -355,44 +361,44 @@
   (:save-p :compute-only))
 
 (macrolet ((frob (name sc ptype)
-	     `(define-vop (,name float-op)
-		(:args (x :scs (,sc))
-		       (y :scs (,sc)))
-		(:results (r :scs (,sc)))
-		(:arg-types ,ptype ,ptype)
-		(:result-types ,ptype))))
+             `(define-vop (,name float-op)
+                (:args (x :scs (,sc))
+                       (y :scs (,sc)))
+                (:results (r :scs (,sc)))
+                (:arg-types ,ptype ,ptype)
+                (:result-types ,ptype))))
   (frob single-float-op single-reg single-float)
   (frob double-float-op double-reg double-float))
 
 (macrolet ((frob (op sinst sname scost dinst dname dcost)
-	     `(progn
-		(define-vop (,sname single-float-op)
-		  (:translate ,op)
-		  (:generator ,scost
-		    (inst ,sinst r x y)))
-		(define-vop (,dname double-float-op)
-		  (:translate ,op)
-		  (:generator ,dcost
-		    (inst ,dinst r x y))))))
+             `(progn
+                (define-vop (,sname single-float-op)
+                  (:translate ,op)
+                  (:generator ,scost
+                    (inst ,sinst r x y)))
+                (define-vop (,dname double-float-op)
+                  (:translate ,op)
+                  (:generator ,dcost
+                    (inst ,dinst r x y))))))
   (frob + fadds +/single-float 2 fadd +/double-float 2)
   (frob - fsubs -/single-float 2 fsub -/double-float 2)
   (frob * fmuls */single-float 4 fmul */double-float 5)
   (frob / fdivs //single-float 12 fdiv //double-float 19))
 
 (macrolet ((frob (name inst translate sc type)
-	     `(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)
-		(:generator 1
-		  (note-this-location vop :internal-error)
-		  (inst ,inst y x)))))
+             `(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)
+                (:generator 1
+                  (note-this-location vop :internal-error)
+                  (inst ,inst y x)))))
   (frob abs/single-float fabs abs single-reg single-float)
   (frob abs/double-float fabs abs double-reg double-float)
   (frob %negate/single-float fneg %negate single-reg single-float)
@@ -418,21 +424,21 @@
     (inst b?  :cr1 (if not-p nope yep) target)))
 
 (macrolet ((frob (name sc ptype)
-	     `(define-vop (,name float-compare)
-		(:args (x :scs (,sc))
-		       (y :scs (,sc)))
-		(:arg-types ,ptype ,ptype))))
+             `(define-vop (,name float-compare)
+                (:args (x :scs (,sc))
+                       (y :scs (,sc)))
+                (:arg-types ,ptype ,ptype))))
   (frob single-float-compare single-reg single-float)
   (frob double-float-compare double-reg double-float))
 
 (macrolet ((frob (translate yep nope sname dname)
-	     `(progn
-		(define-vop (,sname single-float-compare)
-		  (:translate ,translate)
-		  (:variant :single ,yep ,nope))
-		(define-vop (,dname double-float-compare)
-		  (:translate ,translate)
-		  (:variant :double ,yep ,nope)))))
+             `(progn
+                (define-vop (,sname single-float-compare)
+                  (:translate ,translate)
+                  (:variant :single ,yep ,nope))
+                (define-vop (,dname double-float-compare)
+                  (:translate ,translate)
+                  (:variant :double ,yep ,nope)))))
   (frob < :lt :ge </single-float </double-float)
   (frob > :gt :le >/single-float >/double-float)
   (frob = :eq :ne eql/single-float eql/double-float))
@@ -441,24 +447,24 @@
 ;;;; Conversion:
 
 (macrolet ((frob (name translate inst to-sc to-type)
-	     `(define-vop (,name)
-		(:args (x :scs (signed-reg)))
-		(:temporary (:scs (double-stack)) temp)
+             `(define-vop (,name)
+                (:args (x :scs (signed-reg)))
+                (:temporary (:scs (double-stack)) temp)
                 (:temporary (:scs (double-reg)) fmagic)
                 (:temporary (:scs (signed-reg)) rtemp)
-		(:results (y :scs (,to-sc)))
-		(:arg-types signed-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) sb!vm:n-word-bytes))
+                (:results (y :scs (,to-sc)))
+                (:arg-types signed-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 sb!vm:n-word-bytes))
-                         (temp-offset-low (* (1+ stack-offset) sb!vm:n-word-bytes)))
+                         (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 lis rtemp #x8000)
@@ -466,69 +472,91 @@
                     (inst lfd fmagic nfp-tn temp-offset-high)
                     (inst xor rtemp rtemp x)          ; invert sign bit of x : rtemp had #x80000000
                     (inst stw rtemp nfp-tn temp-offset-low)
-                    (inst lfd y nfp-tn temp-offset-high) 		    
-		    (note-this-location vop :internal-error)
-		    (inst ,inst y y fmagic))))))
+                    (inst lfd y nfp-tn temp-offset-high)
+                    (note-this-location vop :internal-error)
+                    (inst ,inst y y fmagic))))))
   (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)))
-		(: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)
-		(:generator 2
-		  (note-this-location vop :internal-error)
-		  (inst ,inst y x)))))
+             `(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)
+                (:generator 2
+                  (note-this-location vop :internal-error)
+                  (inst ,inst y x)))))
   (frob %single-float/double-float %single-float frsp
     double-reg double-float single-reg single-float)
   (frob %double-float/single-float %double-float fmr
     single-reg single-float double-reg double-float))
 
 (macrolet ((frob (trans from-sc from-type inst)
-	     `(define-vop (,(symbolicate trans "/" from-type))
-		(:args (x :scs (,from-sc) :target temp))
-		(: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))))
-		(:arg-types ,from-type)
-		(:result-types signed-num)
-		(:translate ,trans)
-		(:policy :fast-safe)
-		(:note "inline float truncate")
-		(:vop-var vop)
-		(:save-p :compute-only)
-		(:generator 5
-		  (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) sb!vm:n-word-bytes)))
-		    (signed-reg
-		     (inst stfd temp (current-nfp-tn vop)
-			   (* (tn-offset stack-temp) sb!vm:n-word-bytes))
-		     (inst lwz y (current-nfp-tn vop)
-			   (+ 4 (* (tn-offset stack-temp) sb!vm:n-word-bytes)))))))))
-  (frob %unary-truncate single-reg single-float fctiwz)
-  (frob %unary-truncate double-reg double-float fctiwz)
+             `(define-vop (,(symbolicate trans "/" from-type))
+                (:args (x :scs (,from-sc) :target temp))
+                (:temporary (:from (:argument 0) :sc single-reg) temp)
+                (:temporary (:scs (double-stack)) stack-temp)
+                (:results (y :scs (signed-reg)))
+                (:arg-types ,from-type)
+                (:result-types signed-num)
+                (:translate ,trans)
+                (:policy :fast-safe)
+                (:note "inline float truncate")
+                (:vop-var vop)
+                (:save-p :compute-only)
+                (:generator 5
+                  (note-this-location vop :internal-error)
+                  (inst ,inst temp x)
+                  (inst stfd temp (current-nfp-tn vop)
+                        (* (tn-offset stack-temp) n-word-bytes))
+                  (inst lwz y (current-nfp-tn vop)
+                        (+ 4 (* (tn-offset stack-temp) n-word-bytes)))))))
+  (frob %unary-truncate/single-float single-reg single-float fctiwz)
+  (frob %unary-truncate/double-float double-reg double-float fctiwz)
   (frob %unary-round single-reg single-float fctiw)
   (frob %unary-round double-reg double-float fctiw))
 
-
-
 (define-vop (make-single-float)
   (:args (bits :scs (signed-reg) :target res
-	       :load-if (not (sc-is bits signed-stack))))
+               :load-if (not (sc-is bits signed-stack))))
   (:results (res :scs (single-reg)
-		 :load-if (not (sc-is res single-stack))))
+                 :load-if (not (sc-is res single-stack))))
   (:temporary (:scs (signed-reg) :from (:argument 0) :to (:result 0)) temp)
   (:temporary (:scs (signed-stack)) stack-temp)
   (:arg-types signed-num)
@@ -540,31 +568,31 @@
     (sc-case bits
       (signed-reg
        (sc-case res
-	 (single-reg
-	  (inst stw bits (current-nfp-tn vop)
-		(* (tn-offset stack-temp) sb!vm:n-word-bytes))
-	  (inst lfs res (current-nfp-tn vop)
-		(* (tn-offset stack-temp) sb!vm:n-word-bytes)))
-	 (single-stack
-	  (inst stw bits (current-nfp-tn vop)
-		(* (tn-offset res) sb!vm:n-word-bytes)))))
+         (single-reg
+          (inst stw bits (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes))
+          (inst lfs res (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes)))
+         (single-stack
+          (inst stw bits (current-nfp-tn vop)
+                (* (tn-offset res) n-word-bytes)))))
       (signed-stack
        (sc-case res
-	 (single-reg
-	  (inst lfs res (current-nfp-tn vop)
-		(* (tn-offset bits) sb!vm:n-word-bytes)))
-	 (single-stack
-	  (unless (location= bits res)
-	    (inst lwz temp (current-nfp-tn vop)
-		  (* (tn-offset bits) sb!vm:n-word-bytes))
-	    (inst stw temp (current-nfp-tn vop)
-		  (* (tn-offset res) sb!vm:n-word-bytes)))))))))
+         (single-reg
+          (inst lfs res (current-nfp-tn vop)
+                (* (tn-offset bits) n-word-bytes)))
+         (single-stack
+          (unless (location= bits res)
+            (inst lwz temp (current-nfp-tn vop)
+                  (* (tn-offset bits) n-word-bytes))
+            (inst stw temp (current-nfp-tn vop)
+                  (* (tn-offset res) n-word-bytes)))))))))
 
 (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))))
   (:temporary (:scs (double-stack)) temp)
   (:arg-types signed-num unsigned-num)
   (:result-types double-float)
@@ -573,22 +601,22 @@
   (:vop-var vop)
   (:generator 2
     (let ((stack-tn (sc-case res
-		      (double-stack res)
-		      (double-reg temp))))
+                      (double-stack res)
+                      (double-reg temp))))
       (inst stw hi-bits (current-nfp-tn vop)
-	    (* (tn-offset stack-tn) sb!vm:n-word-bytes))
+            (* (tn-offset stack-tn) n-word-bytes))
       (inst stw lo-bits (current-nfp-tn vop)
-	    (* (1+ (tn-offset stack-tn)) sb!vm:n-word-bytes)))
+            (* (1+ (tn-offset stack-tn)) n-word-bytes)))
     (when (sc-is res double-reg)
       (inst lfd res (current-nfp-tn vop)
-	    (* (tn-offset temp) sb!vm:n-word-bytes)))))
+            (* (tn-offset temp) n-word-bytes)))))
 
 (define-vop (single-float-bits)
   (:args (float :scs (single-reg descriptor-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 (sc-is float descriptor-reg single-stack)
-			       (not (sc-is bits signed-stack)))))
+                  :load-if (or (sc-is float descriptor-reg single-stack)
+                               (not (sc-is bits signed-stack)))))
   (:temporary (:scs (signed-stack)) stack-temp)
   (:arg-types single-float)
   (:result-types signed-num)
@@ -599,88 +627,69 @@
     (sc-case bits
       (signed-reg
        (sc-case float
-	 (single-reg
-	  (inst stfs float (current-nfp-tn vop)
-		(* (tn-offset stack-temp) sb!vm:n-word-bytes))
-	  (inst lwz bits (current-nfp-tn vop)
-		(* (tn-offset stack-temp) sb!vm:n-word-bytes)))
-	 (single-stack
-	  (inst lwz bits (current-nfp-tn vop)
-		(* (tn-offset float) sb!vm:n-word-bytes)))
-	 (descriptor-reg
-	  (loadw bits float sb!vm:single-float-value-slot sb!vm:other-pointer-lowtag))))
+         (single-reg
+          (inst stfs float (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes))
+          (inst lwz bits (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes)))
+         (single-stack
+          (inst lwz bits (current-nfp-tn vop)
+                (* (tn-offset float) n-word-bytes)))
+         (descriptor-reg
+          (loadw bits float single-float-value-slot other-pointer-lowtag))))
       (signed-stack
        (sc-case float
-	 (single-reg
-	  (inst stfs float (current-nfp-tn vop)
-		(* (tn-offset bits) sb!vm:n-word-bytes))))))))
+         (single-reg
+          (inst stfs float (current-nfp-tn vop)
+                (* (tn-offset bits) n-word-bytes))))))))
 
 (define-vop (double-float-high-bits)
   (: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)
+                :load-if (not (sc-is float double-stack))))
+  (:results (hi-bits :scs (signed-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
   (:arg-types double-float)
   (:result-types signed-num)
   (:translate double-float-high-bits)
   (:policy :fast-safe)
   (: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) sb!vm:n-word-bytes))
-	  (inst lwz hi-bits (current-nfp-tn vop)
-		(* (tn-offset stack-temp) sb!vm:n-word-bytes)))
-	 (double-stack
-	  (inst lwz hi-bits (current-nfp-tn vop)
-		(* (tn-offset float) sb!vm:n-word-bytes)))
-	 (descriptor-reg
-	  (loadw hi-bits float sb!vm:double-float-value-slot
-		 sb!vm:other-pointer-lowtag))))
-      (signed-stack
-       (sc-case float
-	 (double-reg
-	  (inst stfd float (current-nfp-tn vop)
-		(* (tn-offset hi-bits) sb!vm:n-word-bytes))))))))
+    (sc-case float
+      (double-reg
+        (inst stfd float (current-nfp-tn vop)
+              (* (tn-offset stack-temp) n-word-bytes))
+        (inst lwz hi-bits (current-nfp-tn vop)
+              (* (tn-offset stack-temp) n-word-bytes)))
+      (double-stack
+        (inst lwz hi-bits (current-nfp-tn vop)
+              (* (tn-offset float) n-word-bytes)))
+      (descriptor-reg
+        (loadw hi-bits float double-float-value-slot
+               other-pointer-lowtag)))))
 
 (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)
+                :load-if (not (sc-is float double-stack))))
+  (:results (lo-bits :scs (unsigned-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
   (:arg-types double-float)
   (:result-types unsigned-num)
   (:translate double-float-low-bits)
   (:policy :fast-safe)
   (: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) sb!vm:n-word-bytes))
-	  (inst lwz lo-bits (current-nfp-tn vop)
-		(* (1+ (tn-offset stack-temp)) sb!vm:n-word-bytes)))
-	 (double-stack
-	  (inst lwz lo-bits (current-nfp-tn vop)
-		(* (1+ (tn-offset float)) sb!vm:n-word-bytes)))
-	 (descriptor-reg
-	  (loadw lo-bits float (1+ sb!vm:double-float-value-slot)
-		 sb!vm:other-pointer-lowtag))))
-      (unsigned-stack
-       (sc-case float
-	 (double-reg
-	  (inst stfd float (current-nfp-tn vop)
-		(* (tn-offset lo-bits) sb!vm:n-word-bytes))))))))
-
+    (sc-case float
+      (double-reg
+        (inst stfd float (current-nfp-tn vop)
+              (* (tn-offset stack-temp) n-word-bytes))
+        (inst lwz lo-bits (current-nfp-tn vop)
+              (* (1+ (tn-offset stack-temp)) n-word-bytes)))
+      (double-stack
+        (inst lwz lo-bits (current-nfp-tn vop)
+              (* (1+ (tn-offset float)) n-word-bytes)))
+      (descriptor-reg
+        (loadw lo-bits float (1+ double-float-value-slot)
+               other-pointer-lowtag)))))
 
 ;;;; Float mode hackery:
 
@@ -726,11 +735,11 @@
 (define-vop (make-complex-single-float)
   (:translate complex)
   (:args (real :scs (single-reg) :target r
-	       :load-if (not (location= real r)))
-	 (imag :scs (single-reg) :to :save))
+               :load-if (not (location= real r)))
+         (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)
@@ -739,26 +748,26 @@
     (sc-case r
       (complex-single-reg
        (let ((r-real (complex-single-reg-real-tn r)))
-	 (unless (location= real r-real)
-	   (inst fmr r-real real)))
+         (unless (location= real r-real)
+           (inst fmr r-real real)))
        (let ((r-imag (complex-single-reg-imag-tn r)))
-	 (unless (location= imag r-imag)
-	   (inst fmr r-imag imag))))
+         (unless (location= imag r-imag)
+           (inst fmr r-imag imag))))
       (complex-single-stack
        (let ((nfp (current-nfp-tn vop))
-	     (offset (* (tn-offset r) sb!vm:n-word-bytes)))
-	 (unless (location= real r)
-	   (inst stfs real nfp offset))
-	 (inst stfs imag nfp (+ offset sb!vm:n-word-bytes)))))))
+             (offset (* (tn-offset r) n-word-bytes)))
+         (unless (location= real r)
+           (inst stfs real nfp offset))
+         (inst stfs imag nfp (+ offset n-word-bytes)))))))
 
 (define-vop (make-complex-double-float)
   (:translate complex)
   (:args (real :scs (double-reg) :target r
-	       :load-if (not (location= real r)))
-	 (imag :scs (double-reg) :to :save))
+               :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))))
+               :load-if (not (sc-is r complex-double-stack))))
   (:result-types complex-double-float)
   (:note "inline complex double-float creation")
   (:policy :fast-safe)
@@ -767,22 +776,22 @@
     (sc-case r
       (complex-double-reg
        (let ((r-real (complex-double-reg-real-tn r)))
-	 (unless (location= real r-real)
-	   (inst fmr r-real real)))
+         (unless (location= real r-real)
+           (inst fmr r-real real)))
        (let ((r-imag (complex-double-reg-imag-tn r)))
-	 (unless (location= imag r-imag)
-	   (inst fmr r-imag imag))))
+         (unless (location= imag r-imag)
+           (inst fmr r-imag imag))))
       (complex-double-stack
        (let ((nfp (current-nfp-tn vop))
-	     (offset (* (tn-offset r) sb!vm:n-word-bytes)))
-	 (unless (location= real r)
-	   (inst stfd real nfp offset))
-	 (inst stfd imag nfp (+ offset (* 2 sb!vm:n-word-bytes))))))))
+             (offset (* (tn-offset r) n-word-bytes)))
+         (unless (location= real r)
+           (inst stfd real nfp offset))
+         (inst stfd imag nfp (+ offset (* 2 n-word-bytes))))))))
 
 
 (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)
@@ -793,14 +802,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 fmr r value-tn))))
+                         (:real (complex-single-reg-real-tn x))
+                         (:imag (complex-single-reg-imag-tn x)))))
+         (unless (location= value-tn r)
+           (inst fmr r value-tn))))
       (complex-single-stack
        (inst lfs r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 1))
-					      (tn-offset x))
-					   sb!vm:n-word-bytes))))))
+                                              (tn-offset x))
+                                           n-word-bytes))))))
 
 (define-vop (realpart/complex-single-float complex-single-float-value)
   (:translate realpart)
@@ -814,7 +823,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)
@@ -825,14 +834,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 fmr r value-tn))))
+                         (:real (complex-double-reg-real-tn x))
+                         (:imag (complex-double-reg-imag-tn x)))))
+         (unless (location= value-tn r)
+           (inst fmr r value-tn))))
       (complex-double-stack
        (inst lfd r (current-nfp-tn vop) (* (+ (ecase slot (:real 0) (:imag 2))
-					      (tn-offset x))
-					   sb!vm:n-word-bytes))))))
+                                              (tn-offset x))
+                                           n-word-bytes))))))
 
 (define-vop (realpart/complex-double-float complex-double-float-value)
   (:translate realpart)
@@ -844,4 +853,67 @@
   (:note "complex double float imagpart")
   (:variant :imag))
 
-
+;; This vop and the next are intended to be used only for moving a
+;; float to an integer arg location (register or stack) for C callout.
+;; See %alien-funcall ir2convert in aliencomp.lisp.
+
+#!+darwin
+(define-vop (move-double-to-int-arg)
+  (:args (float :scs (double-reg)))
+  (:results (hi-bits :scs (signed-reg signed-stack))
+            (lo-bits :scs (unsigned-reg unsigned-stack)))
+  (:temporary (:scs (double-stack)) stack-temp)
+  (:temporary (:scs (signed-reg)) temp)
+  (:arg-types double-float)
+  (:result-types signed-num unsigned-num)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 5
+    (sc-case float
+      (double-reg
+       (inst stfd float (current-nfp-tn vop)
+             (* (tn-offset stack-temp) n-word-bytes))
+       (sc-case hi-bits
+         (signed-reg
+          (inst lwz hi-bits (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes)))
+         (signed-stack
+          (inst lwz temp (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes))
+          (inst stw temp nsp-tn
+                (* (tn-offset hi-bits) n-word-bytes))))
+       (sc-case lo-bits
+         (unsigned-reg
+          (inst lwz lo-bits (current-nfp-tn vop)
+                (* (1+ (tn-offset stack-temp)) n-word-bytes)))
+         (unsigned-stack
+          (inst lwz temp (current-nfp-tn vop)
+                (* (1+ (tn-offset stack-temp)) n-word-bytes))
+          (inst stw temp nsp-tn
+                (* (tn-offset lo-bits) n-word-bytes))))))))
+
+#!+darwin
+(define-vop (move-single-to-int-arg)
+  (:args (float :scs (single-reg)))
+  (:results (bits :scs (signed-reg signed-stack)))
+  (:temporary (:scs (double-stack)) stack-temp)
+  (:temporary (:scs (signed-reg)) temp)
+  (:arg-types single-float)
+  (:result-types signed-num)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 5
+    (sc-case float
+      (single-reg
+       (inst stfs float (current-nfp-tn vop)
+             (* (tn-offset stack-temp) n-word-bytes))
+       (sc-case bits
+         (signed-reg
+          (inst lwz bits (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes)))
+         (signed-stack
+          (inst lwz temp (current-nfp-tn vop)
+                (* (tn-offset stack-temp) n-word-bytes))
+          (inst stw temp nsp-tn
+                (* (tn-offset bits) n-word-bytes))))))))
+