From c6ede90552019a5851e4ba0de41fa9dfd3269b38 Mon Sep 17 00:00:00 2001 From: Zhu Zihao Date: Fri, 14 Oct 2022 00:00:32 +0800 Subject: [PATCH] Allow closure returned by procedure->pointer executed in foreign thread. * libguile/foreign.c (invoke_closure): Move the core logci to "do_invoke_closure". Wrap it by "scm_with_guile". (do_invoke_closure): New function. --- libguile/foreign.c | 29 +++++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/libguile/foreign.c b/libguile/foreign.c index 1f594b0e4..2f9a8469a 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -1148,13 +1148,19 @@ scm_i_foreign_call (SCM cif_scm, SCM pointer_scm, int *errno_ret, #ifdef FFI_CLOSURES -/* Trampoline to invoke a libffi closure that wraps a Scheme - procedure. */ -static void -invoke_closure (ffi_cif *cif, void *ret, void **args, void *data) +static void * +do_invoke_closure (void *outer_data) { + ffi_cif *cif; + void *ret, **args, *data; size_t i; SCM proc, *argv, result; + void ** outer_args = (void **) outer_data; + + cif = outer_args[0]; + ret = outer_args[1]; + args = outer_args[2]; + data = outer_args[3]; proc = SCM_PACK_POINTER (data); @@ -1167,6 +1173,21 @@ invoke_closure (ffi_cif *cif, void *ret, void **args, void *data) result = scm_call_n (proc, argv, cif->nargs); unpack (cif->rtype, ret, result, 1); + + return NULL; +} + +/* Trampoline to invoke a libffi closure that wraps a Scheme + procedure. */ +static void +invoke_closure (ffi_cif *cif, void *ret, void **args, void *data) +{ + void *outer_args[4] = { cif, ret, args, data }; + + /* Foreign code may call this Scheme closure in a context which Guile is not + initialized. */ + scm_with_guile (do_invoke_closure, outer_args); + } SCM_DEFINE (scm_procedure_to_pointer, "procedure->pointer", 3, 0, 0, -- 2.38.0