1 files changed, 116 insertions, 40 deletions

diff --git a/src/thread.c b/src/thread.c
index 0cd1ae33dc2..670680f2b0d 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -25,16 +25,24 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include "process.h"
 #include "coding.h"
 #include "syssignal.h"
+#include "pdumper.h"
+#include "keyboard.h"
 
-static struct thread_state main_thread;
+union aligned_thread_state
+{
+  struct thread_state s;
+  GCALIGNED_UNION_MEMBER
+};
+verify (GCALIGNED (union aligned_thread_state));
+
+static union aligned_thread_state main_thread;
 
-struct thread_state *current_thread = &main_thread;
+struct thread_state *current_thread = &main_thread.s;
 
-static struct thread_state *all_threads = &main_thread;
+static struct thread_state *all_threads = &main_thread.s;
 
 static sys_mutex_t global_lock;
 
-extern int poll_suppress_count;
 extern volatile int interrupt_input_blocked;
 
 
@@ -113,7 +121,7 @@ maybe_reacquire_global_lock (void)
   /* SIGINT handler is always run on the main thread, see
      deliver_process_signal, so reflect that in our thread-tracking
      variables.  */
-  current_thread = &main_thread;
+  current_thread = &main_thread.s;
 
   if (current_thread->not_holding_lock)
     {
@@ -259,7 +267,7 @@ informational only.  */)
   if (!NILP (name))
     CHECK_STRING (name);
 
-  mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX);
+  mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, name, PVEC_MUTEX);
   memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex),
 	  0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex,
 						    mutex));
@@ -378,7 +386,7 @@ informational only.  */)
   if (!NILP (name))
     CHECK_STRING (name);
 
-  condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR);
+  condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, name, PVEC_CONDVAR);
   memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond),
 	  0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar,
 						      cond));
@@ -609,7 +617,7 @@ static void
 mark_one_thread (struct thread_state *thread)
 {
   /* Get the stack top now, in case mark_specpdl changes it.  */
-  void *stack_top = thread->stack_top;
+  void const *stack_top = thread->stack_top;
 
   mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
 
@@ -656,6 +664,12 @@ mark_threads (void)
   flush_stack_call_func (mark_threads_callback, NULL);
 }
 
+void
+unmark_main_thread (void)
+{
+  main_thread.s.header.size &= ~ARRAY_MARK_FLAG;
+}
+
 
 
 static void
@@ -681,7 +695,7 @@ invoke_thread_function (void)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
-  Ffuncall (1, &current_thread->function);
+  current_thread->result = Ffuncall (1, &current_thread->function);
   return unbind_to (count, Qnil);
 }
 
@@ -754,9 +768,21 @@ run_thread (void *state)
   return NULL;
 }
 
+static void
+free_search_regs (struct re_registers *regs)
+{
+  if (regs->num_regs != 0)
+    {
+      xfree (regs->start);
+      xfree (regs->end);
+    }
+}
+
 void
 finalize_one_thread (struct thread_state *state)
 {
+  free_search_regs (&state->m_search_regs);
+  free_search_regs (&state->m_saved_search_regs);
   sys_cond_destroy (&state->thread_condvar);
 }
 
@@ -779,7 +805,7 @@ If NAME is given, it must be a string; it names the new thread.  */)
   if (!NILP (name))
     CHECK_STRING (name);
 
-  new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_stack_bottom,
+  new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, event_object,
 				      PVEC_THREAD);
   memset ((char *) new_thread + offset, 0,
 	  sizeof (struct thread_state) - offset);
@@ -789,6 +815,7 @@ If NAME is given, it must be a string; it names the new thread.  */)
   new_thread->m_last_thing_searched = Qnil; /* copy from parent? */
   new_thread->m_saved_last_thing_searched = Qnil;
   new_thread->m_current_buffer = current_thread->m_current_buffer;
+  new_thread->result = Qnil;
   new_thread->error_symbol = Qnil;
   new_thread->error_data = Qnil;
   new_thread->event_object = Qnil;
@@ -862,7 +889,8 @@ DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0,
 This acts like `signal', but arranges for the signal to be raised
 in THREAD.  If THREAD is the current thread, acts just like `signal'.
 This will interrupt a blocked call to `mutex-lock', `condition-wait',
-or `thread-join' in the target thread.  */)
+or `thread-join' in the target thread.
+If THREAD is the main thread, just the error message is shown.  */)
   (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data)
 {
   struct thread_state *tstate;
@@ -873,13 +901,31 @@ or `thread-join' in the target thread.  */)
   if (tstate == current_thread)
     Fsignal (error_symbol, data);
 
-  /* What to do if thread is already signaled?  */
-  /* What if error_symbol is Qnil?  */
-  tstate->error_symbol = error_symbol;
-  tstate->error_data = data;
+#ifdef THREADS_ENABLED
+  if (main_thread_p (tstate))
+    {
+      /* Construct an event.  */
+      struct input_event event;
+      EVENT_INIT (event);
+      event.kind = THREAD_EVENT;
+      event.frame_or_window = Qnil;
+      event.arg = list3 (Fcurrent_thread (), error_symbol, data);
+
+      /* Store it into the input event queue.  */
+      kbd_buffer_store_event (&event);
+    }
+
+  else
+#endif
+    {
+      /* What to do if thread is already signaled?  */
+      /* What if error_symbol is Qnil?  */
+      tstate->error_symbol = error_symbol;
+      tstate->error_data = data;
 
-  if (tstate->wait_condvar)
-    flush_stack_call_func (thread_signal_callback, tstate);
+      if (tstate->wait_condvar)
+	flush_stack_call_func (thread_signal_callback, tstate);
+    }
 
   return Qnil;
 }
@@ -933,12 +979,13 @@ thread_join_callback (void *arg)
 
 DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0,
        doc: /* Wait for THREAD to exit.
-This blocks the current thread until THREAD exits or until
-the current thread is signaled.
-It is an error for a thread to try to join itself.  */)
+This blocks the current thread until THREAD exits or until the current
+thread is signaled.  It returns the result of the THREAD function.  It
+is an error for a thread to try to join itself.  */)
   (Lisp_Object thread)
 {
   struct thread_state *tstate;
+  Lisp_Object error_symbol, error_data;
 
   CHECK_THREAD (thread);
   tstate = XTHREAD (thread);
@@ -946,10 +993,16 @@ It is an error for a thread to try to join itself.  */)
   if (tstate == current_thread)
     error ("Cannot join current thread");
 
+  error_symbol = tstate->error_symbol;
+  error_data = tstate->error_data;
+
   if (thread_live_p (tstate))
     flush_stack_call_func (thread_join_callback, tstate);
 
-  return Qnil;
+  if (!NILP (error_symbol))
+    Fsignal (error_symbol, error_data);
+
+  return tstate->result;
 }
 
 DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
@@ -973,11 +1026,17 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
   return result;
 }
 
-DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0,
-       doc: /* Return the last error form recorded by a dying thread.  */)
-  (void)
+DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 1, 0,
+       doc: /* Return the last error form recorded by a dying thread.
+If CLEANUP is non-nil, remove this error form from history.  */)
+     (Lisp_Object cleanup)
 {
-  return last_thread_error;
+  Lisp_Object result = last_thread_error;
+
+  if (!NILP (cleanup))
+    last_thread_error = Qnil;
+
+  return result;
 }
 
 
@@ -1004,22 +1063,31 @@ thread_check_current_buffer (struct buffer *buffer)
 static void
 init_main_thread (void)
 {
-  main_thread.header.size
-    = PSEUDOVECSIZE (struct thread_state, m_stack_bottom);
-  XSETPVECTYPE (&main_thread, PVEC_THREAD);
-  main_thread.m_last_thing_searched = Qnil;
-  main_thread.m_saved_last_thing_searched = Qnil;
-  main_thread.name = Qnil;
-  main_thread.function = Qnil;
-  main_thread.error_symbol = Qnil;
-  main_thread.error_data = Qnil;
-  main_thread.event_object = Qnil;
+  main_thread.s.header.size
+    = PSEUDOVECSIZE (struct thread_state, event_object);
+  XSETPVECTYPE (&main_thread.s, PVEC_THREAD);
+  main_thread.s.m_last_thing_searched = Qnil;
+  main_thread.s.m_saved_last_thing_searched = Qnil;
+  main_thread.s.name = Qnil;
+  main_thread.s.function = Qnil;
+  main_thread.s.result = Qnil;
+  main_thread.s.error_symbol = Qnil;
+  main_thread.s.error_data = Qnil;
+  main_thread.s.event_object = Qnil;
+}
+
+bool
+main_thread_p (const void *ptr)
+{
+  return ptr == &main_thread.s;
 }
 
 bool
-main_thread_p (void *ptr)
+in_current_thread (void)
 {
-  return ptr == &main_thread;
+  if (current_thread == NULL)
+    return false;
+  return sys_thread_equal (sys_thread_self (), current_thread->thread_id);
 }
 
 void
@@ -1032,11 +1100,11 @@ void
 init_threads (void)
 {
   init_main_thread ();
-  sys_cond_init (&main_thread.thread_condvar);
+  sys_cond_init (&main_thread.s.thread_condvar);
   sys_mutex_init (&global_lock);
   sys_mutex_lock (&global_lock);
-  current_thread = &main_thread;
-  main_thread.thread_id = sys_thread_self ();
+  current_thread = &main_thread.s;
+  main_thread.s.thread_id = sys_thread_self ();
 }
 
 void
@@ -1078,4 +1146,12 @@ syms_of_threads (void)
   DEFSYM (Qthreadp, "threadp");
   DEFSYM (Qmutexp, "mutexp");
   DEFSYM (Qcondition_variable_p, "condition-variable-p");
+
+  DEFVAR_LISP ("main-thread", Vmain_thread,
+    doc: /* The main thread of Emacs.  */);
+#ifdef THREADS_ENABLED
+  XSETTHREAD (Vmain_thread, &main_thread.s);
+#else
+  Vmain_thread = Qnil;
+#endif
 }