mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 15:40:38 +02:00
Code Activity

DRAFT: Change f64->scm into an intrinsic.

Browse source
This commit is contained in:
Mark H Weaver 2019-06-05 22:23:46 -04:00
parent 87f32999b9
commit de42f12099
7 changed files with 56 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/intrinsics.c
View file

@ -459,6 +459,7 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword;
scm_vm_intrinsics.class_of = scm_class_of;
scm_vm_intrinsics.scm_to_f64 = scm_to_double;
scm_vm_intrinsics.f64_to_scm = scm_from_double;
#if INDIRECT_INT64_INTRINSICS
scm_vm_intrinsics.scm_to_u64 = indirect_scm_to_uint64;
scm_vm_intrinsics.scm_to_u64_truncate = indirect_scm_to_uint64_truncate;

2
libguile/intrinsics.h
View file

@ -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_f64_intrinsic) (double);
/* If we don't have 64-bit registers, the intrinsics will take and
return 64-bit values by reference. */
@ -161,6 +162,7 @@ typedef uint32_t* scm_t_vcode_intrinsic;
M(thread_u8_scm_sp_vra_mra, push_prompt, "push-prompt", PUSH_PROMPT) \
M(thread_scm, unpack_values_object, "unpack-values-object", UNPACK_VALUES_OBJECT) \
M(vcode, handle_interrupt_code, "%handle-interrupt-code", HANDLE_INTERRUPT_CODE) \
M(scm_from_f64, f64_to_scm, "f64->scm", F64_TO_SCM) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic

20
libguile/jit.c
View file

@ -982,6 +982,14 @@ emit_sp_set_sz (scm_jit_state *j, uint32_t dst, jit_gpr_t src)
}
}
static jit_operand_t
sp_f64_operand (scm_jit_state *j, uint32_t slot)
{
ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER);
return jit_operand_mem (JIT_OPERAND_ABI_DOUBLE, SP, 8 * slot);
}
static jit_operand_t
sp_u64_operand (scm_jit_state *j, uint32_t slot)
{
@ -2435,6 +2443,18 @@ compile_call_s64_from_scm (scm_jit_state *j, uint16_t dst, uint16_t a, uint32_t
compile_call_u64_from_scm (j, dst, a, idx);
}
static void
compile_call_scm_from_f64 (scm_jit_state *j, uint16_t dst, uint16_t src, uint32_t idx)
{
void *intrinsic = ((void **) &scm_vm_intrinsics)[idx];
emit_store_current_ip (j, T0);
emit_call_1 (j, intrinsic, sp_f64_operand (j, src));
emit_retval (j, T0);
emit_reload_sp (j);
emit_sp_set_scm (j, dst, T0);
}
static void
compile_call_scm_from_u64 (scm_jit_state *j, uint16_t dst, uint16_t src, uint32_t idx)
{

26
libguile/vm-engine.c
View file

@ -3231,7 +3231,31 @@ VM_NAME (scm_thread *thread)
VM_DEFINE_OP (153, f64_set, "f64-set!", OP1 (X8_S8_S8_S8))
PTR_SET (double, F64);
VM_DEFINE_OP (154, unused_154, NULL, NOP)
/* call-scm<-f64 dst:12 a:12 IDX:32
*
* Call the SCM-returning instrinsic with index IDX, passing the
* f64 local A as argument. Place the SCM result in DST.
*/
VM_DEFINE_OP (154, call_scm_from_f64, "call-scm<-f64", DOP2 (X8_S12_S12, C32))
{
uint16_t dst, src;
SCM res;
scm_t_scm_from_f64_intrinsic intrinsic;
UNPACK_12_12 (op, dst, src);
intrinsic = intrinsics[ip[1]];
SYNC_IP ();
res = intrinsic (SP_REF_F64 (src));
SP_SET (dst, res);
/* No CACHE_SP () after the intrinsic, as the indirect variants
pass stack pointers directly; stack relocation during this kind
of intrinsic is not supported! */
NEXT (2);
}
VM_DEFINE_OP (155, unused_155, NULL, NOP)
VM_DEFINE_OP (156, unused_156, NULL, NOP)
VM_DEFINE_OP (157, unused_157, NULL, NOP)