Add unboxed floating point comparison instructions.

* libguile/vm-engine.c (BR_F64_ARITHMETIC): New preprocessor macro.
(br_if_f64_ee, br_if_f64_lt, br_if_f64_le, br_if_f64_gt, br_if_f64_ge):
New VM instructions.
* doc/ref/vm.texi ("Unboxed Floating-Point Arithmetic"): Document them.
* module/language/cps/compile-bytecode.scm (compile-function): Emit f64
comparison instructions.
* module/language/cps/effects-analysis.scm: Define effects for f64
primcalls.
* module/language/cps/primitives.scm (*branching-primcall-arities*): Add
arities for f64 primcalls.
* module/language/cps/specialize-numbers.scm (specialize-f64-comparison):
New procedure.
(specialize-operations): Specialize f64 comparisons.
* module/system/vm/assembler.scm (emit-br-if-f64-=, emit-br-if-f64-<)
(emit-br-if-f64-<=, emit-br-if-f64->, emit-br-if-f64->=): Export.
* module/system/vm/disassembler.scm (code-annotation): Add annotations
for f64 comparison instructions.

1 files changed, 68 insertions, 5 deletions

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 195237ab4..684840617 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -358,6 +358,24 @@
     NEXT (3);                                                           \
   }
 
+#define BR_F64_ARITHMETIC(crel)                                         \
+  {                                                                     \
+    scm_t_uint32 a, b;                                                  \
+    scm_t_uint64 x, y;                                                  \
+    UNPACK_24 (op, a);                                                  \
+    UNPACK_24 (ip[1], b);                                               \
+    x = SP_REF_F64 (a);                                                 \
+    y = SP_REF_F64 (b);                                                 \
+    if ((ip[2] & 0x1) ? !(x crel y) : (x crel y))                       \
+      {                                                                 \
+        scm_t_int32 offset = ip[2];                                     \
+        offset >>= 8; /* Sign-extending shift. */                       \
+        NEXT (offset);                                                  \
+      }                                                                 \
+    NEXT (3);                                                           \
+  }
+
+
 #define ARGS1(a1)                               \
   scm_t_uint16 dst, src;                        \
   SCM a1;                                       \
@@ -3935,11 +3953,56 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       NEXT (1);
     }
 
-  VM_DEFINE_OP (187, unused_187, NULL, NOP)
-  VM_DEFINE_OP (188, unused_188, NULL, NOP)
-  VM_DEFINE_OP (189, unused_189, NULL, NOP)
-  VM_DEFINE_OP (190, unused_190, NULL, NOP)
-  VM_DEFINE_OP (191, unused_191, NULL, NOP)
+  /* br-if-f64-= a:12 b:12 invert:1 _:7 offset:24
+   *
+   * If the F64 value in A is = to the F64 value in B, add OFFSET, a
+   * signed 24-bit number, to the current instruction pointer.
+   */
+  VM_DEFINE_OP (187, br_if_f64_ee, "br-if-f64-=", OP3 (X8_S24, X8_S24, B1_X7_L24))
+    {
+      BR_F64_ARITHMETIC (==);
+    }
+
+  /* br-if-f64-< a:12 b:12 invert:1 _:7 offset:24
+   *
+   * If the F64 value in A is < to the F64 value in B, add OFFSET, a
+   * signed 24-bit number, to the current instruction pointer.
+   */
+  VM_DEFINE_OP (188, br_if_f64_lt, "br-if-f64-<", OP3 (X8_S24, X8_S24, B1_X7_L24))
+    {
+      BR_F64_ARITHMETIC (<);
+    }
+
+  /* br-if-f64-<= a:24 _:8 b:24 invert:1 _:7 offset:24
+   *
+   * If the F64 value in A is <= than the F64 value in B, add OFFSET, a
+   * signed 24-bit number, to the current instruction pointer.
+   */
+  VM_DEFINE_OP (189, br_if_f64_le, "br-if-f64-<=", OP3 (X8_S24, X8_S24, B1_X7_L24))
+    {
+      BR_F64_ARITHMETIC (<=);
+    }
+
+  /* br-if-f64-> a:24 _:8 b:24 invert:1 _:7 offset:24
+   *
+   * If the F64 value in A is > than the F64 value in B, add OFFSET, a
+   * signed 24-bit number, to the current instruction pointer.
+   */
+  VM_DEFINE_OP (190, br_if_f64_gt, "br-if-f64->", OP3 (X8_S24, X8_S24, B1_X7_L24))
+    {
+      BR_F64_ARITHMETIC (>);
+    }
+
+  /* br-if-uf4->= a:24 _:8 b:24 invert:1 _:7 offset:24
+   *
+   * If the F64 value in A is >= than the F64 value in B, add OFFSET, a
+   * signed 24-bit number, to the current instruction pointer.
+   */
+  VM_DEFINE_OP (191, br_if_f64_ge, "br-if-f64->=", OP3 (X8_S24, X8_S24, B1_X7_L24))
+    {
+      BR_F64_ARITHMETIC (>=);
+    }
+
   VM_DEFINE_OP (192, unused_192, NULL, NOP)
   VM_DEFINE_OP (193, unused_193, NULL, NOP)
   VM_DEFINE_OP (194, unused_194, NULL, NOP)