[Guile-commits] 04/16: VM calls "<?" through intrinsic.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 0a8a7e9fd0eedfcf7e7acb1a6ecbc4a3bb9a5f16
Author: Andy Wingo <address@hidden>
Date:   Tue May 8 12:03:53 2018 +0200

    VM calls "<?" through intrinsic.
    
    * libguile/intrinsics.c (less_p): New intrinsic.
      (scm_bootstrap_intrinsics): Wire up intrinsic.
    * libguile/intrinsics.h: Declare new intrinsic.
    * libguile/vm-engine.c (less_p): Call through intrinsic.
---
 libguile/intrinsics.c | 12 ++++++++++++
 libguile/intrinsics.h |  4 ++++
 libguile/vm-engine.c  |  7 +------
 3 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 2a07905..33857f2 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -203,6 +203,17 @@ rsh_immediate (SCM a, scm_t_uint8 b)
   return rsh (a, b);
 }
 
+static enum scm_compare
+less_p (SCM a, SCM b)
+{
+  if (scm_is_true (scm_nan_p (a)) || scm_is_true (scm_nan_p (b)))
+    return SCM_F_COMPARE_INVALID;
+  else if (scm_is_true (scm_less_p (a, b)))
+    return SCM_F_COMPARE_LESS_THAN;
+  else
+    return SCM_F_COMPARE_NONE;
+}
+
 void
 scm_bootstrap_intrinsics (void)
 {
@@ -243,6 +254,7 @@ scm_bootstrap_intrinsics (void)
   scm_vm_intrinsics.lsh_immediate = lsh_immediate;
   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_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index e30ed10..3f59528 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -23,6 +23,8 @@
 
 #ifdef BUILDING_LIBGUILE
 
+#include <libguile/vm.h>
+
 typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM);
 typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, scm_t_uint8);
 typedef void (*scm_t_scm_u64_u64_intrinsic) (SCM, scm_t_uint64, scm_t_uint64);
@@ -38,6 +40,7 @@ typedef void (*scm_t_thread_scm_scm_intrinsic) 
(scm_i_thread*, SCM, SCM);
 typedef SCM (*scm_t_scm_from_thread_scm_intrinsic) (scm_i_thread*, SCM);
 typedef SCM (*scm_t_scm_from_scm_u64_intrinsic) (SCM, scm_t_uint64);
 typedef int (*scm_t_bool_from_scm_scm_intrinsic) (SCM, SCM);
+typedef enum scm_compare (*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM);
 
 #define SCM_FOR_ALL_VM_INTRINSICS(M) \
   M(scm_from_scm_scm, add, "add", ADD) \
@@ -77,6 +80,7 @@ typedef int (*scm_t_bool_from_scm_scm_intrinsic) (SCM, SCM);
   M(scm_from_scm_uimm, lsh_immediate, "lsh/immediate", LSH_IMMEDIATE) \
   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) \
   /* 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 184cd1e..0c3a0ae 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2897,12 +2897,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       y = SP_REF (b);
 
       SYNC_IP ();
-      if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y)))
-        vp->compare_result = SCM_F_COMPARE_INVALID;
-      else if (scm_is_true (scm_less_p (x, y)))
-        vp->compare_result = SCM_F_COMPARE_LESS_THAN;
-      else
-        vp->compare_result = SCM_F_COMPARE_NONE;
+      vp->compare_result = scm_vm_intrinsics.less_p (x, y);
       CACHE_SP ();
       NEXT (1);
     }