Transfer signals to main coroutine

diff --git a/src/coroutine.c b/src/coroutine.c
index 601773aae05d284f99ad543d5e0d69dd0d28b5b7..5eae40bbeedfce36c0f3d43be9822310d533d519 100644 (file)
--- a/src/coroutine.c
+++ b/src/coroutine.c
@@ -73,11 +73,17 @@ coroutine_reset_handlerlist (const int *dummy)
   handlerlist = handlerlist->next;
 }
 
+static bool pending_error;
+
 /* Called on `signal'.  ERR is a pair (SYMBOL . DATA).  */
 static void
 coroutine_handle_signal (Lisp_Object err)
 {
+  eassert (! pending_error);
   print_error_message (err, Qnil, "signal in coroutine caught: ", Qnil);
+  pending_error = true;
+  Vpending_coroutine_error_symbol = XCAR (err);
+  Vpending_coroutine_error_data = XCDR (err);
   taskexit (1);
 }
 
@@ -85,14 +91,22 @@ coroutine_handle_signal (Lisp_Object err)
 static void
 coroutine_handle_throw (Lisp_Object tag_val)
 {
+  eassert (! pending_error);
   print_error_message (tag_val, Qnil, "throw in coroutine caught: ", Qnil);
+  pending_error = true;
+  Vpending_coroutine_error_symbol = Qno_catch;
+  Vpending_coroutine_error_data = list2 (XCAR (tag_val), XCDR (tag_val));
   taskexit (1);
 }
 
 static void
 coroutine_out_of_memory (void)
 {
+  eassert (! pending_error);
   fputs ("OOM in coroutine\n", stderr);
+  pending_error = true;
+  Vpending_coroutine_error_symbol = Qnil;
+  Vpending_coroutine_error_data = Vmemory_signal_data;
   taskexit (1);
 }
 
@@ -124,6 +138,37 @@ DEFUN ("start-coroutine", Fstart_coroutine, Sstart_coroutine, 1, 1, 0,
   return Qnil;
 }
 
+static unsigned int main_task_id;
+
+static bool
+in_main_task (void)
+{
+  return taskid () == main_task_id;
+}
+
+static void
+check_coroutine_signal (void)
+{
+  if (! pending_error)
+    return;
+  if (in_main_task ())
+    {
+      pending_error = false;
+      Lisp_Object symbol = Vpending_coroutine_error_symbol;
+      Lisp_Object data = Vpending_coroutine_error_data;
+      eassert (SYMBOLP (symbol) || CONSP (data));
+      Vpending_coroutine_error_symbol = Qnil;
+      Vpending_coroutine_error_data = Qnil;
+      xsignal (symbol, data);
+    }
+  else
+    {
+      int woken = taskyield ();
+      eassert (woken > 0);
+      eassert (! pending_error);
+    }
+}
+
 static void
 CHECK_CHANNEL (Lisp_Object x)
 {
@@ -149,6 +194,7 @@ CHANNEL must be a communication channel created by `make-channel'.  */)
   Lisp_Object result;
   int status = chanrecv (XCHANNEL (channel)->channel, &result);
   eassert (status == 1);
+  check_coroutine_signal ();
   return result;
 }
 
@@ -177,6 +223,7 @@ created by `make-channel'.  */)
   CHECK_CHANNEL (channel);
   int status = chansend (XCHANNEL (channel)->channel, &value);
   eassert (status == 1);
+  check_coroutine_signal ();
   return Qnil;
 }
 
@@ -315,6 +362,7 @@ is returned.  */)
 
   // Actually perform the select operation.
   int choice = chanalt (alts);
+  check_coroutine_signal ();
 
   if (choice == -1)
     {
@@ -381,9 +429,17 @@ pselect_noblock (int nfds,
   };
   taskcreate (do_pselect, &args, 0x1000);
   tasksleep (&args.rendez);
+  check_coroutine_signal ();
   return args.result;
 }
 
+void
+coroutine_init (void)
+{
+  main_task_id = taskid ();
+  pending_error = false;
+}
+
 void
 syms_of_coroutine (void)
 {
@@ -391,6 +447,16 @@ syms_of_coroutine (void)
   DEFSYM (Qreceive, "receive");
   DEFSYM (Qsend, "send");
 
+  DEFVAR_LISP ("pending-coroutine-error-symbol", Vpending_coroutine_error_symbol,
+               doc: /* Pending error symbol. */);
+  DEFSYM (Qpending_coroutine_error_symbol, "pending-coroutine-error-symbol");
+  Funintern (Qpending_coroutine_error_symbol, Qnil);
+
+  DEFVAR_LISP ("pending-coroutine-error-data", Vpending_coroutine_error_data,
+               doc: /* Pending error data. */);
+  DEFSYM (Qpending_coroutine_error_data, "pending-coroutine-error-data");
+  Funintern (Qpending_coroutine_error_data, Qnil);
+
   defsubr (&Sstart_coroutine);
   defsubr (&Sreceive_from_channel);
   defsubr (&Stry_receive_from_channel);

diff --git a/src/emacs.c b/src/emacs.c
index adb972e1db83b57a8a68ffa9b53d3315b9ee9da8..474e87f42b766e5d3cb2e57b23af619e279e7ad8 100644 (file)
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -748,6 +748,8 @@ taskmain (int argc, char **argv)
   module_init ();
 #endif
 
+  coroutine_init ();
+
   sort_args (argc, argv);
   argc = 0;
   while (argv[argc]) argc++;

diff --git a/src/lisp.h b/src/lisp.h
index 7efdd4573e1bdddb06f3e2f5e7c6f0154b314ad2..3d69f3440f9fc037a73f09ab3ac226fb21b0311b 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3436,6 +3436,7 @@ extern void init_coding_once (void);
 extern void syms_of_coding (void);
 
 /* Defined in coroutine.c.  */
+extern void coroutine_init (void);
 extern void syms_of_coroutine (void);
 
 /* Defined in character.c.  */

diff --git a/test/src/coroutine-tests.el b/test/src/coroutine-tests.el
index d86fe6c61155e93e3ad827a56be955138173a0f3..778f3de687528ad8e70c2e8c1b0b30ed522f9d8d 100644 (file)
--- a/test/src/coroutine-tests.el
+++ b/test/src/coroutine-tests.el
@@ -163,4 +163,9 @@
 ;;     (receive-from-channel ch-2)
 ;;     (send-to-channel ch-1 nil)))
 
+(ert-deftest coroutines-test--signal ()
+  (start-coroutine (lambda () (signal 'beginning-of-buffer '(foo))))
+  (let ((err (should-error (sleep-for 0.1))))
+    (should (equal err '(beginning-of-buffer foo)))))
+
 ;;; coroutine-tests.el ends here