path: root/json-rpc-lsp-mode.patch

diff --git a/.gitignore b/.gitignore
index b09a0c030b3..af79ccf289a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -315,6 +315,7 @@ nt/emacs.rc
 nt/emacsclient.rc
 src/gdb.ini
 /var/
+launch.json
 
 # Seccomp filter files.
 lib-src/seccomp-filter.bpf
diff --git a/readme.md b/readme.md
new file mode 100644
index 00000000000..fe1c17845d7
--- /dev/null
+++ b/readme.md
@@ -0,0 +1,31 @@
+# Emacs for lsp-mode(POC)
+
+A Emacs fork implementing non-blocking and async `JSONRPC` support
+
+## Motivation
+
+The fork aims to fix the strugle of `lsp-mode` with sync `Emacs` core and json handling
+
+## How it works?
+
+The fork uses separate emacs threads to run the processing and then runs `release_global_lock()` from the C code when the processing does not involve `lisp` objects. There are a lot of benefits from this approach:
+
+* *UI does not block the server.* Imagine that currently you have font lock running. In stock `emacs` that will prevent reading the process intput even if the server has alredy sent the response to the client. Note that this will improve not only emacs performance but it will improve the performance of single threaded server because the server won't be blocked to wait for IO to be read by the client.
+
+* *Server does not block the UI.* Similarly, the processing of `lsp-mode` serialization of requests/deserialization of responses does block UI processing. Only small portion of whole `JSONRPC`
+
+* *Server being slow reading requests does not block the UI* . In stock `emacs` sending requests to the server will force `emacs` to wait for server to read the request.
+* *Less garbage*. Since a lot of the processing does not involve lisp objects we generate less garbage and as a result the GC runs less often.
+
+## Current state
+
+The code runs fine with most of the servers I have tested with. Only Linux/Unix is supported for now.
+
+## How to use?
+
+Compile `emacs` just like normal `emacs` and then use the latest version of `lsp-mode`.
+
+# Acknowledgments
+
+Thanks to [606u](https://github.com/606u) for helping me out with low
+level process communication code
diff --git a/src/json.c b/src/json.c
index f7979fb446e..dc57d1740b0 100644
--- a/src/json.c
+++ b/src/json.c
@@ -20,18 +20,27 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <config.h>
 
 #include <errno.h>
+#include <pthread.h>
 #include <stddef.h>
 #include <stdint.h>
+#include <stdio.h>
 #include <stdlib.h>
 
 #include <jansson.h>
+#include <string.h>
 
 #include "lisp.h"
+#include "intervals.h"
+#include "spsupr.h"
+#include "thread.h"
 #include "buffer.h"
 #include "coding.h"
+#include "spsupr.c"
 
 #define JSON_HAS_ERROR_CODE (JANSSON_VERSION_HEX >= 0x020B00)
 
+const int BUFFER_SIZE = 1000;
+
 #ifdef WINDOWSNT
 # include <windows.h>
 # include "w32common.h"
@@ -993,6 +1002,402 @@ usage: (json-parse-string STRING &rest ARGS) */)
   return unbind_to (count, json_to_lisp (object, &conf));
 }
 
+// JSONRPC
+
+#define ERROR_BUFFER_SIZE 1024 * 1024 * 4
+
+struct json_rpc_state
+{
+  pthread_mutex_t handle_mx;
+  struct SSP_Handle* handle;
+  json_t* message;
+  json_error_t error;
+  bool done;
+  char error_buffer[ERROR_BUFFER_SIZE + 1];
+  int error_buffer_read;
+};
+
+/* Usage:
+ * if (can_use_handle (state))
+ *   {
+ *     ... use state->handle
+ *     end_using_handle (state);
+ *   }
+ */
+inline static void
+end_using_handle (struct json_rpc_state *state)
+{
+  assert (state->handle);
+  pthread_mutex_unlock (&state->handle_mx);
+}
+inline static int
+can_use_handle (struct json_rpc_state *state)
+{
+  if (pthread_mutex_lock (&state->handle_mx) == 0)
+    {
+      if (state->handle)
+	return 1; /* handle is good */
+      /* else handle is already gone */
+      end_using_handle (state);
+    }
+  return 0;
+}
+
+inline static void
+CHECK_RPC_CONNECTION (Lisp_Object obj)
+{
+  CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj);
+}
+
+static void
+json_rpc_state_free (void *ptr)
+{
+  struct json_rpc_state *state = ptr;
+  assert (state->handle == NULL); /* Loop must be exited */
+  pthread_mutex_destroy (&state->handle_mx);
+  free (state);
+}
+
+
+DEFUN ("json-rpc-connection", Fjson_rpc_connection, Sjson_rpc_connection, 1, MANY,
+       NULL,
+       doc: /* Create JSONRPC connection. */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  USE_SAFE_ALLOCA;
+  char **new_argv;
+  SAFE_NALLOCA (new_argv, 1, nargs + 1);
+  new_argv[nargs] = NULL;
+
+  for (int i = 0; i < nargs; i++)
+    {
+      CHECK_STRING (args[i]);
+      new_argv[i] = SSDATA (args[i]);
+    }
+
+  struct SSP_Opts opts;
+  memset(&opts, 0, sizeof(opts));
+  opts.binary = new_argv[0];
+  opts.argv = new_argv;
+  opts.read_timeout_ms = -1;
+  struct SSP_Handle* handle = ssp_spawn(&opts);
+  if (!handle)
+    {
+      Fsignal (Qerror, list1 (build_string ("Failed to start process.")));
+    }
+  else
+    {
+      struct json_rpc_state *state = malloc (sizeof (struct json_rpc_state));
+      /* TODO: state might be NULL */
+      pthread_mutex_init (&state->handle_mx, NULL);
+      /* TODO: mutex_init could fail */
+      state->handle = handle;
+      state->done = false;
+      state->error_buffer_read = 0;
+      SAFE_FREE ();
+      return make_user_ptr (json_rpc_state_free, state);
+    }
+}
+
+struct json_rpc_send_params
+{
+  struct json_rpc_state *state;
+  json_t* message;
+};
+
+static void
+json_rpc_send_callback (void * arg)
+{
+  struct json_rpc_send_params *param = arg;
+  struct json_rpc_state *state = param->state;
+  json_t *message = param->message;
+  struct thread_state *self = current_thread;
+
+  if (can_use_handle (state))
+    {
+      release_global_lock ();
+      sys_thread_yield ();
+
+      char *string = json_dumps (message, JSON_COMPACT | JSON_ENCODE_ANY);
+      /* TODO: no point in copying whole message */
+      size_t size = strlen (string);
+      char *msg = malloc (size + 100);
+      /* TODO: missing test if msg != NULL */
+      sprintf (msg, "Content-Length: %zu\r\n\r\n%s", size, string);
+      /* TODO: send could do a partial send */
+      state->handle->send (state->handle, msg, strlen(msg));
+      end_using_handle (state);
+      free (msg);
+      free (string);
+      acquire_global_lock (self);
+    }
+}
+
+static struct json_rpc_state * json_rpc_state(Lisp_Object connection) {
+  return XUSER_PTR (connection)->p;
+}
+
+DEFUN ("json-rpc-send", Fjson_rpc_send, Sjson_rpc_send, 1, MANY,
+       NULL,
+       doc: /* Send message to jsonrpc connection */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  Lisp_Object connection = args[0];
+  CHECK_RPC_CONNECTION(connection);
+
+  struct json_configuration conf =
+    {json_object_hashtable, json_array_array, QCnull, QCfalse};
+  json_parse_args (nargs - 2, args + 2, &conf, false);
+
+  json_t *message = lisp_to_json (args[1], &conf);
+
+  /* TODO: params is on the stack; is this an issue? */
+  struct json_rpc_send_params params = {
+    .state = json_rpc_state(connection),
+    .message = message
+  };
+  flush_stack_call_func (json_rpc_send_callback, &params);
+  return Qnil;
+}
+
+DEFUN ("json-rpc-shutdown", Fjson_rpc_shutdown, Sjson_rpc_shutdown, 1, 1, 0,
+       doc: /* Shutdowns json rpc connection */)
+  (Lisp_Object connection)
+{
+  CHECK_RPC_CONNECTION (connection);
+  struct json_rpc_state *state = json_rpc_state (connection);
+  if (can_use_handle (state))
+    {
+      state->handle->cancel_recv (state->handle);
+      end_using_handle (state);
+    }
+  return Qnil;
+}
+
+DEFUN ("json-rpc-pid", Fjson_rpc_pid, Sjson_rpc_pid, 1, 1, 0,
+       doc: /* Shutdowns json rpc connection */)
+  (Lisp_Object connection)
+{
+  int res = 0; /* or -1? */
+  CHECK_RPC_CONNECTION (connection);
+  struct json_rpc_state *state = json_rpc_state (connection);
+  if (can_use_handle (state))
+    {
+      res = state->handle->pid;
+      end_using_handle (state);
+    }
+  return make_int (res);
+}
+
+DEFUN ("json-rpc-stderr", Fjson_rpc_stderr, Sjson_rpc_stderr, 1, 1, 0,
+       doc: /* Shutdowns json rpc connection */)
+  (Lisp_Object connection)
+{
+  CHECK_RPC_CONNECTION(connection);
+  struct json_rpc_state* state = json_rpc_state(connection);
+  return make_string(state->error_buffer, state->error_buffer_read);
+}
+
+DEFUN ("json-rpc-alive-p", Fjson_rpc_alive_p, Sjson_rpc_alive_p, 1, 1, 0,
+       doc: /* Returns if json rpc connection is alive */)
+  (Lisp_Object connection)
+{
+  int res = 0; /* is not, by default */
+  CHECK_RPC_CONNECTION(connection);
+  struct json_rpc_state *state = json_rpc_state (connection);
+  if (can_use_handle (state))
+    {
+      res = state->handle->isalive (state->handle);
+      end_using_handle (state);
+    }
+  return res ? Qt : Qnil;
+}
+
+static size_t read_stdout (struct json_rpc_state *param, char *buffer,
+			   size_t size)
+{
+  struct SSP_Handle *handle = param->handle;
+  size_t result, read_res;
+  do
+    {
+      result = size;
+      size_t stderr_size = ERROR_BUFFER_SIZE - param->error_buffer_read;
+      read_res = handle->recv (handle, buffer, &result,
+			  param->error_buffer + param->error_buffer_read,
+			  &stderr_size);
+
+      if (stderr_size)
+	{
+	  param->error_buffer_read += stderr_size;
+	  if (param->error_buffer_read == ERROR_BUFFER_SIZE) {
+	    param->error_buffer_read = ERROR_BUFFER_SIZE / 2;
+	    strcpy(param->error_buffer, param->error_buffer + ERROR_BUFFER_SIZE / 2);
+	  }
+	}
+
+      if (result)
+	break;
+  } while (read_res > 0 || handle->isalive (handle));
+
+  return result;
+}
+
+static bool read_until (struct json_rpc_state *param, const char *needle,
+			char *output)
+{
+  // XXX: optimize the first read and make sure output is not
+  // overflowing
+  size_t bytes_read = 0;
+  int read = 0;
+  while (strstr (output, needle) == NULL)
+    {
+      bytes_read = read_stdout (param, output + read, 1);
+      if (bytes_read == 0)
+	return false;
+      read += bytes_read;
+    }
+  return true;
+}
+
+static void
+json_rpc_callback (void *arg)
+{
+  struct json_rpc_state *param = arg;
+  struct thread_state *self = current_thread;
+
+  release_global_lock ();
+  sys_thread_yield ();
+
+  char data[BUFFER_SIZE + 1];
+
+  memset (data, '\0', BUFFER_SIZE);
+  if (read_until (param, "Content-Length:", data))
+    {
+      memset (data, '\0', BUFFER_SIZE);
+
+      if (read_until (param, "\r\n\r\n", data))
+	{
+	  char *_end;
+	  const size_t content_length = strtol (data, &_end, 10);
+	  size_t has_to_read = content_length;
+	  char *msg = malloc (content_length + 1);
+	  while (has_to_read > 0)
+	    {
+	      int bytes_read
+		= read_stdout (param, msg + (content_length - has_to_read),
+			       has_to_read);
+	      if (bytes_read == 0)
+		{
+		  param->done = true;
+		  break;
+		}
+
+	      has_to_read -= bytes_read;
+	    }
+	  if (!param->done)
+	    {
+	      msg[content_length] = '\0';
+	      param->message = json_loads (msg, JSON_DECODE_ANY | JSON_ALLOW_NUL, &param->error);
+	      free (msg);
+	    }
+	}
+      else
+	{
+	  param->done = true;
+	}
+    }
+  else
+    {
+      param->done = true;
+    }
+
+  acquire_global_lock (self);
+}
+
+static Lisp_Object
+get_json_parse_error (const json_error_t *error)
+{
+  Lisp_Object symbol;
+#if JSON_HAS_ERROR_CODE
+  switch (json_error_code (error))
+    {
+    case json_error_premature_end_of_input:
+      symbol = Qjson_end_of_file;
+      break;
+    case json_error_end_of_input_expected:
+      symbol = Qjson_trailing_content;
+      break;
+    default:
+      symbol = Qjson_parse_error;
+      break;
+    }
+#else
+  if (json_has_suffix (error->text, "expected near end of file"))
+    symbol = Qjson_end_of_file;
+  else if (json_has_prefix (error->text, "end of file expected"))
+    symbol = Qjson_trailing_content;
+  else
+    symbol = Qjson_parse_error;
+#endif
+  return Fcons (symbol, list5 (build_string_from_utf8 (error->text),
+			       build_string_from_utf8 (error->source),
+			       INT_TO_INTEGER (error->line),
+			       INT_TO_INTEGER (error->column),
+			       INT_TO_INTEGER (error->position)));
+}
+
+DEFUN ("json-rpc", Fjson_rpc, Sjson_rpc, 1, MANY,
+       NULL,
+       doc: /* Runs json-rpc dispach loop over jsonrpc connection */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  Lisp_Object connection = args[0];
+  CHECK_RPC_CONNECTION(connection);
+
+  Lisp_Object callback = args[1];
+
+  struct json_configuration conf =
+    {json_object_hashtable, json_array_array, QCnull, QCfalse};
+
+  json_parse_args (nargs - 2, args + 2, &conf, true);
+
+  struct json_rpc_state* param = json_rpc_state(connection);
+  struct SSP_Handle* handle = param->handle;
+
+  while (!param->done && handle->isalive(handle))
+    {
+      flush_stack_call_func (json_rpc_callback, param);
+
+      if (!param->done)
+	{
+	  if (param->message != NULL)
+	    {
+	      Lisp_Object msg = json_to_lisp (param->message, &conf);
+	      free (param->message);
+              param->message = NULL;
+	      CALLN (Ffuncall, callback, msg, Qnil, Qnil);
+	    }
+	  else
+	    {
+	      Lisp_Object error = get_json_parse_error(&param->error);
+	      CALLN (Ffuncall, callback, Qnil, error, Qnil);
+	    }
+	} else {
+      }
+    }
+  CALLN (Ffuncall, callback, Qnil, Qnil, Qt);
+  if (pthread_mutex_lock (&param->handle_mx) == 0)
+    {
+      param->handle->close (param->handle);
+      param->handle = NULL;
+      pthread_mutex_unlock (&param->handle_mx);
+    }
+  /* TODO: what if mutex_lock fails? */
+  return Qnil;
+}
+
+// jsonrpc end
+
 struct json_read_buffer_data
 {
   /* Byte position of position to read the next chunk from.  */
@@ -1122,6 +1527,14 @@ syms_of_json (void)
 
   DEFSYM (Qjson_serialize, "json-serialize");
   DEFSYM (Qjson_parse_string, "json-parse-string");
+  DEFSYM (Qjson_rpc, "json-rpc");
+  DEFSYM (Qjson_rpc_connection, "json-rpc-connection");
+  DEFSYM (Qjson_rpc_shutdown, "json-rpc-shutdown");
+  DEFSYM (Qjson_rpc_send, "json-rpc-send");
+  DEFSYM (Qjson_rpc_alive_p, "json-rpc-alive-p");
+  DEFSYM (Qjson_rpc_pid, "json-rpc-pid");
+  DEFSYM (Qjson_rpc_close, "json-rpc-close");
+  DEFSYM (Qjson_rpc_stderr, "json-rpc-stderr");
   Fput (Qjson_serialize, Qpure, Qt);
   Fput (Qjson_serialize, Qside_effect_free, Qt);
   Fput (Qjson_parse_string, Qpure, Qt);
@@ -1139,5 +1552,12 @@ syms_of_json (void)
   defsubr (&Sjson_serialize);
   defsubr (&Sjson_insert);
   defsubr (&Sjson_parse_string);
+  defsubr (&Sjson_rpc);
+  defsubr (&Sjson_rpc_connection);
+  defsubr (&Sjson_rpc_send);
+  defsubr (&Sjson_rpc_shutdown);
+  defsubr (&Sjson_rpc_pid);
+  defsubr (&Sjson_rpc_stderr);
+  defsubr (&Sjson_rpc_alive_p);
   defsubr (&Sjson_parse_buffer);
 }
diff --git a/src/spsupr.c b/src/spsupr.c
new file mode 100644
index 00000000000..864c60975fd
--- /dev/null
+++ b/src/spsupr.c
@@ -0,0 +1,220 @@
+#include "spsupr.h"
+
+#if defined(__linux__) || defined(__FreeBSD__) || defined(__APPLE__)
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/wait.h>
+#include <assert.h>
+#include <err.h>
+#include <errno.h>
+#include <poll.h>
+#include <stddef.h>
+#include <string.h>
+#include <sysexits.h>
+#include <unistd.h>
+
+enum { parent_end = 0, child_end = 1 };
+
+struct SSP_Posix {
+	struct SSP_Handle handle;
+	struct pollfd fds[3];
+	pid_t pid;
+	int io_fd; /* two-way: sub-process' stdin and stdout */
+	int err_fd; /* to read sub-process' stderr */
+	/* Sending a byte at write end will unblock a waiting recv() */
+	int cancelwr_fd, cancelrd_fd;
+	int timeout_ms; /* 0 for poll, -1 for wait forever */
+	int isalive;
+};
+#define GETH(_h) \
+	((struct SSP_Posix *)((char *)_h - offsetof(struct SSP_Posix, handle)))
+
+static int
+ssp_send(struct SSP_Handle *ssph, void *buf, size_t sz)
+{
+	struct SSP_Posix *h = GETH(ssph);
+	ssize_t res;
+	do
+		res = send(h->io_fd, buf, sz, MSG_NOSIGNAL);
+	while (res == -1 && errno == EINTR);
+	return (int)res;
+}
+
+static int
+ssp_recv(struct SSP_Handle *ssph, void *stdout_buf, size_t *stdout_buf_sz,
+	 void *stderr_buf, size_t *stderr_buf_sz)
+{
+	struct SSP_Posix *h = GETH(ssph);
+	const size_t sz1 = *stdout_buf_sz, sz2 = *stderr_buf_sz;
+	int ready, have_data, have_err = 0;
+	ssize_t len;
+
+	*stdout_buf_sz = *stderr_buf_sz = 0;
+	do
+		ready = poll(h->fds, 3, h->timeout_ms);
+	while (ready == -1 && errno == EINTR);
+	if (!ready)
+		return 0;
+
+	if (ready && (h->fds[0].revents & POLLIN) == POLLIN) {
+		do
+			len = recv(h->io_fd, stdout_buf, sz1, MSG_DONTWAIT);
+		while (len == -1 && errno == EINTR);
+		if (len > 0) {
+			*stdout_buf_sz = (size_t)len;
+		} else if (!len) {
+			h->isalive = 0;
+		} else {
+			have_err = 1;
+		}
+		--ready;
+	}
+	if (ready && (h->fds[1].revents & POLLIN) == POLLIN) {
+		do
+			len = recv(h->err_fd, stderr_buf, sz2, MSG_DONTWAIT);
+		while (len == -1 && errno == EINTR);
+		if (len > 0) {
+			*stderr_buf_sz = (size_t)len;
+		} else if (!len) {
+			h->isalive = 0;
+		} else {
+			have_err = 1;
+		}
+		--ready;
+	}
+	if (ready && (h->fds[2].revents & POLLIN) == POLLIN) {
+		char buf[20];
+		do
+			len = recv(h->cancelrd_fd, buf, sizeof(buf),
+				   MSG_DONTWAIT);
+		while (len == -1 && errno == EINTR);
+		--ready;
+	}
+	have_data = *stdout_buf_sz || *stderr_buf_sz;
+	return have_data ? 1 : have_err ? -1 : 0;
+}
+
+static void
+ssp_cancel_recv(struct SSP_Handle *ssph)
+{
+	struct SSP_Posix *h = GETH(ssph);
+	send(h->cancelwr_fd, h, 1, 0);
+}
+
+static int
+ssp_isalive(struct SSP_Handle *ssph)
+{
+	struct SSP_Posix *h = GETH(ssph);
+	return h->isalive;
+}
+
+static void
+ssp_close(struct SSP_Handle *ssph)
+{
+	struct SSP_Posix *h = GETH(ssph);
+	int status;
+	close(h->cancelrd_fd);
+	close(h->cancelwr_fd);
+	close(h->err_fd);
+	close(h->io_fd);
+	(void)waitpid(h->pid, &status, WNOHANG);
+	free(h);
+}
+
+struct SSP_Handle *
+ssp_spawn(struct SSP_Opts *opts)
+{
+	int io_fds[2] = { -1, -1 }; /* two-way: stdin & stdout */
+	int err_fds[2] = { -1, -1 }; /* stderr, read-only */
+	int unbl_fds[2] = { -1, -1 };
+	int eno;
+	pid_t pid = -1;
+	struct SSP_Posix *res = NULL;
+
+	assert(opts);
+	assert(opts->binary);
+
+	res = (struct SSP_Posix *)calloc(1, sizeof(*res));
+	if (!res)
+		return NULL;
+
+	if (socketpair(AF_LOCAL, SOCK_STREAM, 0, io_fds) == -1 ||
+	    socketpair(AF_LOCAL, SOCK_STREAM, 0, err_fds) == -1 ||
+	    socketpair(AF_LOCAL, SOCK_STREAM, 0, unbl_fds) == -1)
+		goto abort;
+	pid = fork();
+	if (pid == 0) {
+		/* Child: */
+		char *const *it;
+		close(io_fds[parent_end]);
+		close(err_fds[parent_end]);
+		close(unbl_fds[1]);
+		close(unbl_fds[0]);
+		if (dup2(io_fds[child_end], STDIN_FILENO) == -1 ||
+		    dup2(io_fds[child_end], STDOUT_FILENO) == -1 ||
+		    dup2(err_fds[child_end], STDERR_FILENO) == -1)
+			err(EX_OSERR, "dup2");
+
+		if (opts->envp)
+			for (it = opts->envp; *it; ++it)
+				putenv(*it);
+
+		if (opts->binary[0] == '/' || opts->binary[0] == '.') {
+			/* Assume path is included */
+			execv(opts->binary, opts->argv);
+		} else {
+			execvp(opts->binary, opts->argv);
+		}
+		err(EX_OSERR, "cannot execute '%s'", opts->binary);
+		exit(EX_OSERR);
+
+	} else if (pid != -1) {
+		close(io_fds[child_end]);
+		close(err_fds[child_end]);
+		res->handle.send = &ssp_send;
+		res->handle.recv = &ssp_recv;
+		res->handle.cancel_recv = &ssp_cancel_recv;
+		res->handle.isalive = &ssp_isalive;
+		res->handle.close = &ssp_close;
+		res->handle.pid = pid;
+		res->fds[0].fd = io_fds[parent_end];
+		res->fds[0].events = POLLIN;
+		res->fds[1].fd = err_fds[parent_end];
+		res->fds[1].events = POLLIN;
+		res->fds[2].fd = unbl_fds[parent_end];
+		res->fds[2].events = POLLIN;
+		res->pid = pid;
+		res->io_fd = io_fds[parent_end];
+		res->err_fd = err_fds[parent_end];
+		res->cancelwr_fd = unbl_fds[child_end];
+		res->cancelrd_fd = unbl_fds[parent_end];
+		res->timeout_ms = opts->read_timeout_ms;
+		res->isalive = 1;
+		return &res->handle;
+
+	} else {
+		goto abort;
+	}
+abort:
+	eno = errno;
+	if (unbl_fds[1] != -1)
+		close(unbl_fds[1]);
+	if (unbl_fds[0] != -1)
+		close(unbl_fds[0]);
+	if (err_fds[1] != -1)
+		close(err_fds[1]);
+	if (err_fds[0] != -1)
+		close(err_fds[0]);
+	if (io_fds[1] != -1)
+		close(io_fds[1]);
+	if (io_fds[0] != -1)
+		close(io_fds[0]);
+	if (res)
+		free(res);
+	errno = eno;
+	return NULL;
+}
+
+#else
+#error Platform is not supported
+#endif /* POSIX */
diff --git a/src/spsupr.h b/src/spsupr.h
new file mode 100644
index 00000000000..0babf18c7d2
--- /dev/null
+++ b/src/spsupr.h
@@ -0,0 +1,28 @@
+#pragma once
+
+#include <stdlib.h>
+
+struct SSP_Handle {
+  /* Returns # of bytes sent or -1 on error */
+  int (*send) (struct SSP_Handle *ssph, void *buf, size_t sz);
+  /* Returns 0 if no data, 1 if data received and updates ..._buf_sz,
+   * -1 on error */
+  int (*recv) (struct SSP_Handle *ssph, void *stdout_buf, size_t *stdout_buf_sz,
+	       void *stderr_buf, size_t *stderr_buf_sz);
+  /* Interrupts pending recv() so that it will immediately exit with 0 */
+  void (*cancel_recv) (struct SSP_Handle *ssph);
+  /* Returns non-zero while sub-process exists */
+  int (*isalive) (struct SSP_Handle *ssph);
+  void (*close) (struct SSP_Handle *ssph);
+  int pid;
+};
+
+struct SSP_Opts {
+	const char *binary;
+	char *const *argv; /* NULL-terminated */
+	char *const *envp; /* NULL-terminated */
+	/* 0 for polling, -1 for wait forever */
+	int read_timeout_ms;
+};
+
+struct SSP_Handle *ssp_spawn(struct SSP_Opts *opts);
diff --git a/src/thread.c b/src/thread.c
index b8ca56fd372..61484cd8078 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -77,7 +77,7 @@ extern volatile int interrupt_input_blocked;
 
 
 
-static void
+void
 release_global_lock (void)
 {
   sys_mutex_unlock (&global_lock);
@@ -142,7 +142,7 @@ post_acquire_global_lock (struct thread_state *self)
     }
 }
 
-static void
+void
 acquire_global_lock (struct thread_state *self)
 {
   sys_mutex_lock (&global_lock);
diff --git a/src/thread.h b/src/thread.h
index 9b14cc44f35..0fc98893a26 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -311,6 +311,8 @@ extern void finalize_one_thread (struct thread_state *state);
 extern void finalize_one_mutex (struct Lisp_Mutex *);
 extern void finalize_one_condvar (struct Lisp_CondVar *);
 extern void maybe_reacquire_global_lock (void);
+extern void release_global_lock (void);
+extern void acquire_global_lock (struct thread_state *);
 
 extern void init_threads (void);
 extern void syms_of_threads (void);