diff options
-rw-r--r-- | libguile/intrinsics.c | 12 | ||||
-rw-r--r-- | libguile/intrinsics.h | 4 | ||||
-rw-r--r-- | libguile/vm-engine.c | 7 |
3 files changed, 17 insertions, 6 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index 2a07905c0..33857f297 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 e30ed10cd..3f5952881 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 184cd1ef7..0c3a0ae6f 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); } |