diff options
author | Andy Wingo <wingo@pobox.com> | 2018-08-11 14:22:32 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2018-08-11 14:25:07 +0200 |
commit | 939b1ae23f680365fb6fd0a78653a281aaed95b6 (patch) | |
tree | 969e96ccfb96c4399978ee9af86e9783674fe7b0 | |
parent | 602702772412ffcf2476afa0a41b4e290fb67f59 (diff) | |
download | guile-939b1ae23f680365fb6fd0a78653a281aaed95b6.tar.gz |
Rework foreign-call trampoline
* 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.
-rw-r--r-- | libguile/foreign.c | 9 | ||||
-rw-r--r-- | libguile/foreign.h | 3 | ||||
-rw-r--r-- | libguile/intrinsics.h | 2 | ||||
-rw-r--r-- | libguile/vm-engine.c | 8 | ||||
-rw-r--r-- | libguile/vm.c | 14 |
5 files changed, 24 insertions, 12 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index 7a6f44eac..68fa5b256 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -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); } diff --git a/libguile/foreign.h b/libguile/foreign.h index d2278e801..41f26b335 100644 --- a/libguile/foreign.h +++ b/libguile/foreign.h @@ -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); diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 13056238d..877aced04 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -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) \ diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 094895642..26ba16816 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -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); } diff --git a/libguile/vm.c b/libguile/vm.c index 3159aca25..d4750056b 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -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"); |