Better support for NetBSD/current

[sbcl.git] / src / compiler / ppc / float.lisp

diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp
index f4cc01b..5b008cd 100644 (file)
--- 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))))))))
+