mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

VM calls "<?" through intrinsic.

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2018-05-08 12:03:53 +02:00
parent 41bc98985f
commit 0a8a7e9fd0
3 changed files with 17 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

12
libguile/intrinsics.c
View file

@ -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",

4
libguile/intrinsics.h
View file

@ -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

7
libguile/vm-engine.c
View file

@ -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);
}