summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/intrinsics.c21
-rw-r--r--libguile/intrinsics.h5
-rw-r--r--libguile/jit.c30
-rw-r--r--libguile/vm-engine.c44
4 files changed, 96 insertions, 4 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 92b587cfe..10f897a0e 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -1,4 +1,4 @@
-/* Copyright 2018-2020
+/* Copyright 2018-2021
Free Software Foundation, Inc.
This file is part of Guile.
@@ -368,6 +368,23 @@ lookup_bound (SCM module, SCM name)
return var;
}
+/* lookup-bound-public and lookup-bound-private take the name as a
+ string instead of a symbol in order to reduce relocations at program
+ startup. */
+static SCM
+lookup_bound_public (SCM module, SCM name)
+{
+ return lookup_bound (resolve_module (module, 1),
+ scm_string_to_symbol (name));
+}
+
+static SCM
+lookup_bound_private (SCM module, SCM name)
+{
+ return lookup_bound (resolve_module (module, 0),
+ scm_string_to_symbol (name));
+}
+
static void throw_ (SCM key, SCM args) SCM_NORETURN;
static void throw_with_value (SCM val, SCM key_subr_and_message) SCM_NORETURN;
static void throw_with_value_and_data (SCM val, SCM key_subr_and_message) SCM_NORETURN;
@@ -601,6 +618,8 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.module_variable = module_variable;
scm_vm_intrinsics.lookup = lookup;
scm_vm_intrinsics.lookup_bound = lookup_bound;
+ scm_vm_intrinsics.lookup_bound_public = lookup_bound_public;
+ scm_vm_intrinsics.lookup_bound_private = lookup_bound_private;
scm_vm_intrinsics.define_x = scm_module_ensure_local_variable;
scm_vm_intrinsics.throw_ = throw_;
scm_vm_intrinsics.throw_with_value = throw_with_value;
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index d8b927c4b..936e06d84 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -1,4 +1,4 @@
-/* Copyright 2018-2020
+/* Copyright 2018-2021
Free Software Foundation, Inc.
This file is part of Guile.
@@ -34,6 +34,7 @@ typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, uint8_t);
typedef void (*scm_t_scm_sz_u32_intrinsic) (SCM, size_t, uint32_t);
typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM);
typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
+typedef SCM (*scm_t_scm_from_scmn_scmn_intrinsic) (SCM, SCM);
/* If we don't have 64-bit registers, the intrinsics will take and
return 64-bit values by reference. */
@@ -214,6 +215,8 @@ typedef void (*scm_t_scm_uimm_scm_intrinsic) (SCM, uint8_t, SCM);
M(scm_uimm_scm, struct_set_x_immediate, "$struct-set!/immediate", STRUCT_SET_X_IMMEDIATE) \
M(scm_from_scm_scm, lookup, "lookup", LOOKUP) \
M(scm_from_scm_scm, lookup_bound, "lookup-bound", LOOKUP_BOUND) \
+ M(scm_from_scmn_scmn, lookup_bound_public, "lookup-bound-public", LOOKUP_BOUND_PUBLIC) \
+ M(scm_from_scmn_scmn, lookup_bound_private, "lookup-bound-private", LOOKUP_BOUND_PRIVATE) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
/* Intrinsics prefixed with $ are meant to reduce bytecode size,
diff --git a/libguile/jit.c b/libguile/jit.c
index 45208be30..8420829b4 100644
--- a/libguile/jit.c
+++ b/libguile/jit.c
@@ -5217,6 +5217,26 @@ compile_s64_to_f64_slow (scm_jit_state *j, uint16_t dst, uint16_t src)
{
}
+static void
+compile_call_scm_from_scmn_scmn (scm_jit_state *j, uint32_t dst,
+ void *a, void *b, uint32_t idx)
+{
+ void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
+ jit_operand_t op_a = jit_operand_imm (JIT_OPERAND_ABI_POINTER, (uintptr_t)a);
+ jit_operand_t op_b = jit_operand_imm (JIT_OPERAND_ABI_POINTER, (uintptr_t)b);
+
+ emit_store_current_ip (j, T2);
+ emit_call_2 (j, intrinsic, op_a, op_b);
+ emit_retval (j, T0);
+ emit_reload_sp (j);
+ emit_sp_set_scm (j, dst, T0);
+}
+static void
+compile_call_scm_from_scmn_scmn_slow (scm_jit_state *j, uint32_t dst,
+ void *a, void *b, uint32_t idx)
+{
+}
+
#define UNPACK_8_8_8(op,a,b,c) \
do \
@@ -5575,6 +5595,16 @@ compile_s64_to_f64_slow (scm_jit_state *j, uint16_t dst, uint16_t src)
comp (j, a, b, c, d, e); \
}
+#define COMPILE_X8_S24__N32__N32__C32(j, comp) \
+ { \
+ uint32_t a; \
+ UNPACK_24 (j->ip[0], a); \
+ int32_t b = j->ip[1]; \
+ int32_t c = j->ip[2]; \
+ uint32_t d = j->ip[3]; \
+ comp (j, a, j->ip + b, j->ip + c, d); \
+ }
+
static uintptr_t opcodes_seen[256 / (SCM_SIZEOF_UINTPTR_T * 8)];
static uintptr_t
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index bf646847c..510563ce4 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1,4 +1,4 @@
-/* Copyright 2001,2009-2015,2017-2020
+/* Copyright 2001,2009-2015,2017-2021
Free Software Foundation, Inc.
This file is part of Guile.
@@ -3437,7 +3437,47 @@ VM_NAME (scm_thread *thread)
NEXT (1);
}
- VM_DEFINE_OP (166, unused_166, NULL, NOP)
+ /* call-scm<-scmn-scmn dst:24 a:32 b:32 idx:32
+ *
+ * Call the SCM-returning instrinsic with index IDX, passing the SCM
+ * values A and B as arguments. A and B are non-immediates, located
+ * at a constant offset from the instruction. Place the SCM result in
+ * DST.
+ */
+ VM_DEFINE_OP (166, call_scm_from_scmn_scmn, "call-scm<-scmn-scmn", DOP4 (X8_S24, N32, N32, C32))
+ {
+ uint32_t dst;
+ SCM a, b;
+ scm_t_scm_from_scmn_scmn_intrinsic intrinsic;
+
+ UNPACK_24 (op, dst);
+
+ {
+ int32_t offset = ip[1];
+ uint32_t* loc = ip + offset;
+ scm_t_bits unpacked = (scm_t_bits) loc;
+ VM_ASSERT (!(unpacked & 0x7), abort());
+ a = SCM_PACK (unpacked);
+ }
+
+ {
+ int32_t offset = ip[2];
+ uint32_t* loc = ip + offset;
+ scm_t_bits unpacked = (scm_t_bits) loc;
+ VM_ASSERT (!(unpacked & 0x7), abort());
+ b = SCM_PACK (unpacked);
+ }
+
+ intrinsic = intrinsics[ip[3]];
+
+ SYNC_IP ();
+ SCM res = intrinsic (a, b);
+ CACHE_SP ();
+ SP_SET (dst, res);
+
+ NEXT (4);
+ }
+
VM_DEFINE_OP (167, unused_167, NULL, NOP)
VM_DEFINE_OP (168, unused_168, NULL, NOP)
VM_DEFINE_OP (169, unused_169, NULL, NOP)