bug#58498: Foreign callback returned by procedure->pointer cannot be executed in foreign thread.

[Zhu Zihao]

The foreign function pointer returned by "procedure->pointer" can only
executed in a thread which Scheme context is already initialized.

This may not so convenient because foreign library may create its own
thread and run our callback in foreign thread.

To show what will happen, this is a small example using Guile FFI & pthread API
to create a foreign thread and run foreign callback in it.

```
(begin
  (use-modules (rnrs bytevectors)
               (system foreign)
               (system foreign-library))

  (define libc
    (load-foreign-library #f))

  (define pthread_create
    (foreign-library-function libc "pthread_create"
                              #:return-type int
                              #:arg-types `(* * * *)))

  (define pthread-handle-ret
    (make-bytevector 4))

  (define thread-runner
    (procedure->pointer '* (lambda (_)
                             (display "I' m from a foreign thread!\n")
                             %null-pointer)
                        `(*)))

  (pthread_create (bytevector->pointer pthread-handle-ret)
                  %null-pointer
                  thread-runner
                  %null-pointer))
```

In Guile 3.0.8. This will cause segfault and crash. My patch to fix this
problem is attached below. It wraps the real execution of foreign
callback in "scm_with_guile".

signature.asc
Description: PGP signature

>From c6ede90552019a5851e4ba0de41fa9dfd3269b38 Mon Sep 17 00:00:00 2001
From: Zhu Zihao <all_but_l...@163.com>
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


-- 
Retrieve my PGP public key:

  gpg --recv-keys B3EBC086AB0EBC0F45E0B4D433DB374BCEE4D9DC

Zihao