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

Rework foreign-call trampoline

Browse source 
* libguile/foreign.c (scm_i_foreign_call): Rename back from
  foreign_call.  Need a new trampoline that's easier to call from JIT,
  until we actually rewrite the FFI in terms of the JIT.
  (scm_register_foreign): Remove foreign_call intrinsic init.
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Foreign-call
  intrinsic sets return directly on stack.
* libguile/vm-engine.c (foreign-call): Adapt to new intrinsic behavior.
* libguile/vm.c (foreign_call, scm_bootstrap_vm): Add new intrinsic
  wrapper.
This commit is contained in:
Andy Wingo 2018-08-11 14:22:32 +02:00
parent 6027027724
commit 939b1ae23f
5 changed files with 24 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/foreign.c
View file

@ -1016,9 +1016,9 @@ pack (const ffi_type * type, const void *loc, int return_value_p)
#define MAX(A, B) ((A) >= (B) ? (A) : (B))
static SCM
foreign_call (SCM cif_scm, SCM pointer_scm, SCM *errno_ret,
const union scm_vm_stack_element *argv)
SCM
scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret,
const union scm_vm_stack_element *argv)
{
/* FOREIGN is the pair that cif_to_procedure set as the 0th element of the
objtable. */
@ -1070,7 +1070,7 @@ foreign_call (SCM cif_scm, SCM pointer_scm, SCM *errno_ret,
/* off we go! */
errno = 0;
ffi_call (cif, func, rvalue, args);
*errno_ret = scm_from_int (errno);
*errno_ret = errno;
return pack (cif->rtype, rvalue, 1);
}
@ -1305,6 +1305,5 @@ scm_register_foreign (void)
"scm_init_foreign",
(scm_t_extension_init_func)scm_init_foreign,
NULL);
scm_vm_intrinsics.foreign_call = foreign_call;
pointer_weak_refs = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
}

3
libguile/foreign.h
View file

@ -104,6 +104,9 @@ SCM_API SCM scm_pointer_to_procedure_with_errno (SCM return_type, SCM func_ptr,
SCM arg_types);
SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr,
SCM arg_types);
SCM_INTERNAL SCM scm_i_foreign_call (SCM cif_scm, SCM pointer_scm,
int *errno_ret,
const union scm_vm_stack_element *argv);

2
libguile/intrinsics.h
View file

@ -116,7 +116,7 @@ typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) (scm_thread*);
M(u32_from_thread_u32_u32, compute_kwargs_npositional, "compute-kwargs-npositional", COMPUTE_KWARGS_NPOSITIONAL) \
M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \
M(thread_mra, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \
M(scm_from_scm_scm_scmp_sp, foreign_call, "foreign-call", FOREIGN_CALL) \
M(thread_scm_scm, foreign_call, "foreign-call", FOREIGN_CALL) \
M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \
M(scm_from_thread, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \
M(thread_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \

8
libguile/vm-engine.c
View file

@ -620,7 +620,7 @@ VM_NAME (scm_thread *thread)
VM_DEFINE_OP (11, foreign_call, "foreign-call", OP1 (X8_C12_C12))
{
uint16_t cif_idx, ptr_idx;
SCM closure, cif, pointer, ret, err;
SCM closure, cif, pointer;
UNPACK_12_12 (op, cif_idx, ptr_idx);
@ -629,13 +629,9 @@ VM_NAME (scm_thread *thread)
pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
SYNC_IP ();
ret = CALL_INTRINSIC (foreign_call, (cif, pointer, &err, sp));
CALL_INTRINSIC (foreign_call, (thread, cif, pointer));
CACHE_SP ();
ALLOC_FRAME (2);
SP_SET (1, ret);
SP_SET (0, err);
NEXT (1);
}

14
libguile/vm.c
View file

@ -1194,6 +1194,19 @@ unpack_values_object (scm_thread *thread, SCM obj)
SCM_FRAME_LOCAL (thread->vm.fp, n) = scm_i_value_ref (obj, n);
}
static void
foreign_call (scm_thread *thread, SCM cif, SCM pointer)
{
SCM ret;
int err = 0;
ret = scm_i_foreign_call (cif, pointer, &err, thread->vm.sp);
alloc_frame (thread, 2);
SCM_FRAME_LOCAL (thread->vm.fp, 0) = ret;
SCM_FRAME_LOCAL (thread->vm.fp, 1) = scm_from_int (err);
}
static SCM
capture_delimited_continuation (struct scm_vm *vp,
union scm_vm_stack_element *saved_fp,
@ -1701,6 +1714,7 @@ scm_bootstrap_vm (void)
scm_vm_intrinsics.invoke_return_hook = invoke_return_hook;
scm_vm_intrinsics.invoke_next_hook = invoke_next_hook;
scm_vm_intrinsics.invoke_abort_hook = invoke_abort_hook;
scm_vm_intrinsics.foreign_call = foreign_call;
sym_keyword_argument_error = scm_from_latin1_symbol ("keyword-argument-error");
sym_regular = scm_from_latin1_symbol ("regular");