X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Ffloat.lisp;h=de018330ae3ce7737c81afae20770af896c498f0;hb=5d04a95274c9ddaebbcd6ddffc5d646e2c25598c;hp=f4cc01b6b2d2ac250149c443c8ad1db1897ca470;hpb=52cfe54802db8736f1f4e2b67764c43bba9b78b3;p=sbcl.git

diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp
index f4cc01b..de01833 100644
--- a/src/compiler/ppc/float.lisp
+++ b/src/compiler/ppc/float.lisp
@@ -852,3 +852,68 @@
   (:translate imagpart)
   (: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))))))))
+