From 007fcf699f2f327fdc187d9a51db0ba83b02d6de Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 8 May 2018 14:16:02 +0200
Subject: [PATCH] =?UTF-8?q?VM=20calls=20=3D=3F=20through=20intrinsic?=

* libguile/intrinsics.c (numerically_equal_p): New intrinsic.
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Declare new
  intrinsic.
* libguile/vm-engine.c (=?): Call through intrinsic.
---
 libguile/intrinsics.c | 7 +++++++
 libguile/intrinsics.h | 1 +
 libguile/vm-engine.c  | 2 +-
 3 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 33857f297..c361e4626 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -214,6 +214,12 @@ less_p (SCM a, SCM b)
     return SCM_F_COMPARE_NONE;
 }
 
+static int
+numerically_equal_p (SCM a, SCM b)
+{
+  return scm_is_true (scm_num_eq_p (a, b));
+}
+
 void
 scm_bootstrap_intrinsics (void)
 {
@@ -255,6 +261,7 @@ scm_bootstrap_intrinsics (void)
   scm_vm_intrinsics.rsh_immediate = rsh_immediate;
   scm_vm_intrinsics.heap_numbers_equal_p = scm_i_heap_numbers_equal_p;
   scm_vm_intrinsics.less_p = less_p;
+  scm_vm_intrinsics.numerically_equal_p = numerically_equal_p;
 
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 3f5952881..9d8010a5e 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -81,6 +81,7 @@ typedef enum scm_compare (*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM);
   M(scm_from_scm_uimm, rsh_immediate, "rsh/immediate", RSH_IMMEDIATE) \
   M(bool_from_scm_scm, heap_numbers_equal_p, "heap-numbers-equal?", HEAP_NUMBERS_EQUAL_P) \
   M(compare_from_scm_scm, less_p, "<?", LESS_P) \
+  M(bool_from_scm_scm, numerically_equal_p, "=?", NUMERICALLY_EQUAL_P) \
   /* Add new intrinsics here; also update scm_bootstrap_intrinsics.  */
 
 enum scm_vm_intrinsic
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 0c3a0ae6f..f4b10af66 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2879,7 +2879,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       y = SP_REF (b);
 
       SYNC_IP ();
-      if (scm_is_true (scm_num_eq_p (x, y)))
+      if (scm_vm_intrinsics.numerically_equal_p (x, y))
         vp->compare_result = SCM_F_COMPARE_EQUAL;
       else
         vp->compare_result = SCM_F_COMPARE_NONE;