diff --git a/compiler/aliencomp.lisp b/compiler/aliencomp.lisp
index 152b96a382c6277dbf5b8f61b0939b20f1561b50..b782baad51d68e6b0bcc7c275e237c33f4c3db20 100644
--- a/compiler/aliencomp.lisp
+++ b/compiler/aliencomp.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/aliencomp.lisp,v 1.30 2005/11/12 19:21:38 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/aliencomp.lisp,v 1.31 2005/11/17 03:33:45 rtoy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -687,7 +687,9 @@
       (vop alloc-number-stack-space call block stack-frame-size nsp)
       (dolist (tn arg-tns)
 	;; On PPC, TN might be a list.  This is used to indicate
-	;; something special needs to happen.
+	;; something special needs to happen.  See below.
+	;;
+	;; FIXME: We should implement something better than this.
 	(let* ((first-tn (if (listp tn) (car tn) tn))
 	       (arg (pop args))
 	       (sc (tn-sc first-tn))
@@ -702,17 +704,19 @@
 	  (emit-move call block (continuation-tn call block arg) temp-tn)
 	  (emit-move-arg-template call block (first move-arg-vops)
 				  temp-tn nsp first-tn)
+	  #+(and ppc darwin)
 	  (when (listp tn)
 	    ;; This means that we have a float arg that we need to
-	    ;; also copy to some int regs.
+	    ;; also copy to some int regs.  The list contains the TN
+	    ;; for the float as well as the TNs to use for the int
+	    ;; arg.
 	    (destructuring-bind (float-tn i1-tn &optional i2-tn)
 		tn
 	      (if i2-tn
-		  (vop double-float-bits call block
+		  (vop ppc::move-double-to-int-arg call block
 		       float-tn i1-tn i2-tn)
-		  (vop single-float-bits call block
-		       float-tn i1-tn))))
-	  ))
+		  (vop ppc::move-single-to-int-arg call block
+		       float-tn i1-tn))))))
       (assert (null args))
       (unless (listp result-tns)
 	(setf result-tns (list result-tns)))
diff --git a/compiler/ppc/c-call.lisp b/compiler/ppc/c-call.lisp
index b8ce7f51e55c83a3b3039de7740a5d8a6c08e864..15e20da4fe23010a7f1bccef2d23b922fb083344 100644
--- a/compiler/ppc/c-call.lisp
+++ b/compiler/ppc/c-call.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/c-call.lisp,v 1.15 2005/11/15 03:20:32 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/c-call.lisp,v 1.16 2005/11/17 03:33:45 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -100,14 +100,7 @@
 	   (list (my-make-wired-tn 'single-float 'single-reg (1+ fprs))
 		 (int-arg state 'signed-byte-32 'signed-reg 'signed-stack)))
 	  ((< fprs 13)
-	   ;; According to PowerOpen ABI, we need to pass those both in the
-	   ;; FPRs _and_ the stack.  However empiric testing on OS X/gcc
-	   ;; shows they are only passed in FPRs, AFAICT.
-	   ;;
-	   ;; "I" in "AFAICT" probably refers to PRM.  -- CSR, still
-	   ;; reverse-engineering comments in 2003 :-)
-	   ;;
-	   ;; Yes, it does -- me :)
+	   ;; See comments below for double-float.
 	   (incf (arg-state-fpr-args state))
 	   (progn
 	     (incf (arg-state-stack-frame-size state))
@@ -142,7 +135,6 @@
   (let ((fprs (arg-state-fpr-args state))
 	(gprs (arg-state-gpr-args state)))
     (cond ((< gprs 8) ; and by implication also (< fprs 13)
-	   ;; Corresponding GPRs are also kept empty
 	   #+nil
 	   (progn
 	     (incf (arg-state-gpr-args state) 2)
@@ -153,11 +145,11 @@
 	   (incf (arg-state-fpr-args state))
 	   ;; Assign outgoing FPRs starting at FP1.
 	   ;;
-	   ;; The ABI says float values are stored in float regs.  But
-	   ;; if we're calling a varargs function, we also need to put
-	   ;; the float into some gprs.  We indicate this to
-	   ;; %alien-funcall ir2-convert by making a list of the TNs
-	   ;; for the float reg and for the int regs.
+	   ;; The PowerOpen ABI says float values are stored in float
+	   ;; regs.  But if we're calling a varargs function, we also
+	   ;; need to put the float into some gprs.  We indicate this
+	   ;; to %alien-funcall ir2-convert by making a list of the
+	   ;; TNs for the float reg and for the int regs.
 	   ;;
 	   ;; We really only need this for vararg functions, but we
 	   ;; currently don't know that, so we do it always.
@@ -165,16 +157,17 @@
 		 (int-arg state 'signed-byte-32 'signed-reg 'signed-stack)
 		 (int-arg state 'unsigned-byte-32 'unsigned-reg 'unsigned-stack)))
 	  ((< fprs 13)
-	   ;; According to PowerOpen ABI, we need to pass those both in the
-	   ;; FPRs _and_ the stack.  However empiric testing on OS X/gcc
-	   ;; shows they are only passed in FPRs, AFAICT.
+	   ;; As above, we also need to put the float on the stack.
+	   #+nil
 	   (progn
 	     (incf (arg-state-stack-frame-size state) 2)
-	     (incf (arg-state-fpr-args state)))
-	   #+nil
-	   (list (my-make-wired-tn 'double-float 'double-reg (1+ fprs))
-		 (int-arg state 'signed-byte-32 'signed-reg 'signed-stack)
-		 (int-arg state 'unsigned-byte-32 'unsigned-reg 'unsigned-stack)))
+	     (incf (arg-state-fpr-args state))
+	     (my-make-wired-tn 'double-float 'double-reg (1+ fprs)))
+	   (progn
+	     (incf (arg-state-fpr-args state))
+	     (list (my-make-wired-tn 'double-float 'double-reg (1+ fprs))
+		   (int-arg state 'signed-byte-32 'signed-reg 'signed-stack)
+		   (int-arg state 'unsigned-byte-32 'unsigned-reg 'unsigned-stack))))
 	  (t
 	   ;; Pass on stack only
 	   (let ((stack-offset (arg-state-stack-frame-size state)))
diff --git a/compiler/ppc/float.lisp b/compiler/ppc/float.lisp
index b4be76979e09d2a655966a1e7b0503b2253b5cdd..59682cc6daeb6987fde8cfdeb25e9cb2113d90a9 100644
--- a/compiler/ppc/float.lisp
+++ b/compiler/ppc/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.4 2005/06/19 02:48:08 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.5 2005/11/17 03:33:45 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -702,6 +702,70 @@
        (loadw lo-bits float (1+ vm:double-float-value-slot)
 	      vm:other-pointer-type)))))
 
+;; 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) vm:word-bytes))
+       (sc-case hi-bits
+         (signed-reg		
+	  (inst lwz hi-bits (current-nfp-tn vop)
+		(* (tn-offset stack-temp) vm:word-bytes)))
+	 (signed-stack
+	  (inst lwz temp (current-nfp-tn vop)
+		(* (tn-offset stack-temp) vm:word-bytes))
+	  (inst stw temp nsp-tn
+		(* (tn-offset hi-bits) vm:word-bytes))))
+       (sc-case lo-bits
+         (unsigned-reg		
+	  (inst lwz lo-bits (current-nfp-tn vop)
+		(* (1+ (tn-offset stack-temp)) vm:word-bytes)))
+	 (unsigned-stack
+	  (inst lwz temp (current-nfp-tn vop)
+		(* (1+ (tn-offset stack-temp)) vm:word-bytes))
+	  (inst stw temp nsp-tn
+		(* (tn-offset lo-bits) vm: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) vm:word-bytes))
+       (sc-case bits
+         (signed-reg		
+	  (inst lwz bits (current-nfp-tn vop)
+		(* (tn-offset stack-temp) vm:word-bytes)))
+	 (signed-stack
+	  (inst lwz temp (current-nfp-tn vop)
+		(* (tn-offset stack-temp) vm:word-bytes))
+	  (inst stw temp nsp-tn
+		(* (tn-offset bits) vm:word-bytes))))))))
+
 
 ;;;; Float mode hackery: