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

diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp
index f4cc01b..5b008cd 100644
--- a/src/compiler/ppc/float.lisp
+++ b/src/compiler/ppc/float.lisp
@@ -547,8 +547,8 @@
                         (* (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-reg single-float fctiwz)
-  (frob %unary-truncate double-reg double-float fctiwz)
+  (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))
 
@@ -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))))))))
+