scratch/igc 6682d0e6c96 2/2: Fix gnutls crashes on MPS Windows builds

[Pip Cet]

branch: scratch/igc
commit 6682d0e6c96b0279929e3f47ae0820dd8a513d4b
Author: Pip Cet <pipcet@protonmail.com>
Commit: Pip Cet <pipcet@protonmail.com>

    Fix gnutls crashes on MPS Windows builds
    
    A more general mechanism to pin pointers used for external callbacks is
    needed.
    
    * src/process.h (struct Lisp_Process): Add 'gnutls_pproc' pointer to a
    pointer to ourselves.
    * src/alloc.c (cleanup_vector): Free 'gnutls_pproc'.
    * src/gnutls.c (emacs_gnutls_handshake): Allocate 'gnutls_pproc', and
    use it.
    * src/w32.c (emacs_gnutls_pull):
    (emacs_gnutls_push): Use indirection through 'gnutls_pproc'.
---
 src/alloc.c   |  8 +++++++-
 src/gnutls.c  | 17 +++++++++++++++--
 src/process.h |  1 +
 src/w32.c     |  4 ++--
 4 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index f41cef9516a..4074adf3e6b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -44,6 +44,7 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
 #include "frame.h"
 #include "blockinput.h"
 #include "pdumper.h"
+#include "process.h"
 #include "termhooks.h"         /* For struct terminal.  */
 #include "itree.h"
 #ifdef HAVE_WINDOW_SYSTEM
@@ -3569,12 +3570,17 @@ cleanup_vector (struct Lisp_Vector *vector)
        hash_table_allocated_bytes -= bytes;
       }
       break;
+    case PVEC_PROCESS:
+      {
+       struct Lisp_Process *p = PSEUDOVEC_STRUCT (vector, Lisp_Process);
+       xfree (p->gnutls_pproc);
+      }
+      break;
     /* Keep the switch exhaustive.  */
     case PVEC_NORMAL_VECTOR:
     case PVEC_FREE:
     case PVEC_SYMBOL_WITH_POS:
     case PVEC_MISC_PTR:
-    case PVEC_PROCESS:
     case PVEC_FRAME:
     case PVEC_WINDOW:
     case PVEC_BOOL_VECTOR:
diff --git a/src/gnutls.c b/src/gnutls.c
index 334d1d47eb6..7bc1183aeee 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -27,6 +27,10 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
 #include "buffer.h"
 #include "pdumper.h"
 
+#ifdef HAVE_MPS
+#include "igc.h"
+#endif
+
 #ifdef HAVE_GNUTLS
 
 # if GNUTLS_VERSION_NUMBER >= 0x030014
@@ -702,12 +706,21 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
   if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
     {
 # ifdef WINDOWSNT
+#ifdef HAVE_MPS
+      /* FIXME/igc: use exact tracing here */
+      if (!proc->gnutls_pproc)
+       proc->gnutls_pproc = igc_xzalloc_ambig (sizeof *proc->gnutls_pproc);
+#else
+      if (!proc->gnutls_pproc)
+       proc->gnutls_pproc = xmalloc (sizeof *proc->gnutls_pproc);
+#endif
+      *proc->gnutls_pproc = proc;
       /* On W32 we cannot transfer socket handles between different runtime
         libraries, so we tell GnuTLS to use our special push/pull
         functions.  */
       gnutls_transport_set_ptr2 (state,
-                                (gnutls_transport_ptr_t) proc,
-                                (gnutls_transport_ptr_t) proc);
+                                (gnutls_transport_ptr_t) proc->gnutls_pproc,
+                                (gnutls_transport_ptr_t) proc->gnutls_pproc);
       gnutls_transport_set_push_function (state, &emacs_gnutls_push);
       gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
 # else
diff --git a/src/process.h b/src/process.h
index ebc07b23fa7..812059420e1 100644
--- a/src/process.h
+++ b/src/process.h
@@ -191,6 +191,7 @@ struct Lisp_Process
 #endif
 
 #ifdef HAVE_GNUTLS
+    struct Lisp_Process **gnutls_pproc;
     gnutls_initstage_t gnutls_initstage;
     gnutls_session_t gnutls_state;
     gnutls_certificate_client_credentials gnutls_x509_cred;
diff --git a/src/w32.c b/src/w32.c
index 31ffa301c2f..6e7425f4099 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -11198,7 +11198,7 @@ ssize_t
 emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz)
 {
   int n, err;
-  struct Lisp_Process *process = (struct Lisp_Process *)p;
+  struct Lisp_Process *process = *(struct Lisp_Process **)p;
   int fd = process->infd;
 
   n = sys_read (fd, (char*)buf, sz);
@@ -11220,7 +11220,7 @@ emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, 
size_t sz)
 ssize_t
 emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz)
 {
-  struct Lisp_Process *process = (struct Lisp_Process *)p;
+  struct Lisp_Process *process = *(struct Lisp_Process **)p;
   int fd = process->outfd;
   ssize_t n = sys_write (fd, buf, sz);