Add ability to Janet signal from C functions.

While C functions are not re-entrant, signaling from a C function
can be used to implement async returns. When resuming a fiber that
signalled from within a C function, the fiber is started after the
instruction that emitted the signal. The resume argument is used
as the return result from the c function.

src/core/capi.c

@@ -27,20 +27,25 @@
 #include "fiber.h"
 #endif
 
-void janet_panicv(Janet message) {
+void janet_signalv(JanetSignal sig, Janet message) {
     if (janet_vm_return_reg != NULL) {
         *janet_vm_return_reg = message;
+        janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
 #if defined(JANET_BSD) || defined(JANET_APPLE)
-        _longjmp(*janet_vm_jmp_buf, 1);
+        _longjmp(*janet_vm_jmp_buf, sig);
 #else
-        longjmp(*janet_vm_jmp_buf, 1);
+        longjmp(*janet_vm_jmp_buf, sig);
 #endif
     } else {
-        fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
+        fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
         exit(1);
     }
 }
 
+void janet_panicv(Janet message) {
+    janet_signalv(JANET_SIGNAL_ERROR, message);
+}
+
 void janet_panicf(const char *format, ...) {
     va_list args;
     const uint8_t *ret;

src/core/fiber.c

@@ -35,7 +35,7 @@ static void fiber_reset(JanetFiber *fiber) {
     fiber->stackstart = JANET_FRAME_SIZE;
     fiber->stacktop = JANET_FRAME_SIZE;
     fiber->child = NULL;
-    fiber->flags = JANET_FIBER_MASK_YIELD;
+    fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
     fiber->env = NULL;
     janet_fiber_set_status(fiber, JANET_STATUS_NEW);
 }
@@ -369,7 +369,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
     if (argc == 2) {
         int32_t i;
         JanetByteView view = janet_getbytes(argv, 1);
-        fiber->flags = 0;
+        fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
         janet_fiber_set_status(fiber, JANET_STATUS_NEW);
         for (i = 0; i < view.len; i++) {
             if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {

src/core/fiber.h

@@ -27,6 +27,34 @@
 #include <janet.h>
 #endif
 
+/* Fiber signal masks. */
+#define JANET_FIBER_MASK_ERROR 2
+#define JANET_FIBER_MASK_DEBUG 4
+#define JANET_FIBER_MASK_YIELD 8
+
+#define JANET_FIBER_MASK_USER0 (16 << 0)
+#define JANET_FIBER_MASK_USER1 (16 << 1)
+#define JANET_FIBER_MASK_USER2 (16 << 2)
+#define JANET_FIBER_MASK_USER3 (16 << 3)
+#define JANET_FIBER_MASK_USER4 (16 << 4)
+#define JANET_FIBER_MASK_USER5 (16 << 5)
+#define JANET_FIBER_MASK_USER6 (16 << 6)
+#define JANET_FIBER_MASK_USER7 (16 << 7)
+#define JANET_FIBER_MASK_USER8 (16 << 8)
+#define JANET_FIBER_MASK_USER9 (16 << 9)
+
+#define JANET_FIBER_MASK_USERN(N) (16 << (N))
+#define JANET_FIBER_MASK_USER 0x3FF0
+
+#define JANET_FIBER_STATUS_MASK 0xFF0000
+#define JANET_FIBER_STATUS_OFFSET 16
+
+#define JANET_FIBER_BREAKPOINT       0x1000000
+#define JANET_FIBER_RESUME_NO_USEVAL 0x2000000
+#define JANET_FIBER_RESUME_NO_SKIP   0x4000000
+#define JANET_FIBER_DID_LONGJUMP     0x8000000
+#define JANET_FIBER_FLAG_MASK        0xF000000
+
 extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
 
 #define janet_fiber_set_status(f, s) do {\

src/core/os.c

@@ -161,13 +161,16 @@ static Janet os_arch(int32_t argc, Janet *argv) {
 
 static Janet os_exit(int32_t argc, Janet *argv) {
     janet_arity(argc, 0, 1);
+    int status;
     if (argc == 0) {
-        exit(EXIT_SUCCESS);
+        status = EXIT_SUCCESS;
     } else if (janet_checkint(argv[0])) {
-        exit(janet_unwrap_integer(argv[0]));
+        status = janet_unwrap_integer(argv[0]);
     } else {
-        exit(EXIT_FAILURE);
+        status = EXIT_FAILURE;
     }
+    janet_deinit();
+    exit(status);
     return janet_wrap_nil();
 }
 

src/core/util.c

@@ -268,7 +268,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
     size_t bufsize = 0;
     if (NULL != regprefix) {
         prefixlen = strlen(regprefix);
-        bufsize = (prefixlen + 1) * 3;
+        bufsize = prefixlen + 256;
         longname_buffer = malloc(bufsize);
         if (NULL == longname_buffer) {
             JANET_OUT_OF_MEMORY;

src/core/vm.c

@@ -232,7 +232,7 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
 }
 
 /* Interpreter main loop */
-static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
+static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     /* opcode -> label lookup if using clang/GCC */
 #ifdef JANET_USE_COMPUTED_GOTOS
@@ -501,29 +501,38 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
     register JanetFunction *func;
     vm_restore();
 
-    /* Only should be hit if the fiber is either waiting for a child, or
+    if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
-     * waiting to be resumed. In those cases, use input and increment pc. We
+        if (janet_fiber_frame(fiber)->func == NULL) {
-     * DO NOT use input when resuming a fiber that has been interrupted at a
+            /* Inside a c function */
-     * breakpoint. */
+            janet_fiber_popframe(fiber);
-    uint8_t first_opcode;
+            vm_restore();
-    if (status != JANET_STATUS_NEW &&
+        }
-            ((*pc & 0xFF) == JOP_SIGNAL ||
+        /* Check if we were at a tail call instruction. If so, do implicit return */
-             (*pc & 0xFF) == JOP_PROPAGATE ||
+        if ((*pc & 0xFF) == JOP_TAILCALL) {
-             (*pc & 0xFF) == JOP_RESUME)) {
+            /* Tail call resume */
-        stack[A] = in;
+            int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
-        pc++;
+            janet_fiber_popframe(fiber);
-        first_opcode = *pc & 0xFF;
+            if (entrance_frame) {
-    } else if (status == JANET_STATUS_DEBUG) {
+                fiber->flags &= ~JANET_FIBER_FLAG_MASK;
-        first_opcode = *pc & 0x7F;
+                vm_return(JANET_SIGNAL_OK, in);
-    } else {
+            }
-        first_opcode = *pc & 0xFF;
+            vm_restore();
+        }
     }
 
+    if (!(fiber->flags & JANET_FIBER_RESUME_NO_USEVAL)) stack[A] = in;
+    if (!(fiber->flags & JANET_FIBER_RESUME_NO_SKIP)) pc++;
+
+    uint8_t first_opcode = *pc & ((fiber->flags & JANET_FIBER_BREAKPOINT) ? 0x7F : 0xFF);
+
+    fiber->flags &= ~JANET_FIBER_FLAG_MASK;
+
     /* Main interpreter loop. Semantically is a switch on
      * (*pc & 0xFF) inside of an infinite loop. */
     VM_START();
 
     VM_DEFAULT();
+    fiber->flags |= JANET_FIBER_BREAKPOINT | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
     vm_return(JANET_SIGNAL_DEBUG, janet_wrap_nil());
 
     VM_OP(JOP_NOOP)
@@ -876,8 +885,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         JanetFiber *child = janet_unwrap_fiber(stack[B]);
         fiber->child = child;
         JanetSignal sig = janet_continue(child, stack[C], &retreg);
-        if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig)))
+        if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
             vm_return(sig, retreg);
+        }
         fiber->child = NULL;
         stack = fiber->data + fiber->frame;
         stack[A] = retreg;
@@ -901,18 +911,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
             janet_panicf("cannot propagate from fiber with status :%s",
                          janet_status_names[sub_status]);
         }
-        janet_vm_fiber->child = f;
+        fiber->child = f;
         vm_return((int) sub_status, stack[B]);
     }
 
     VM_OP(JOP_PUT)
     vm_commit();
+    fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
     janet_put(stack[A], stack[B], stack[C]);
+    fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
     vm_checkgc_pcnext();
 
     VM_OP(JOP_PUT_INDEX)
     vm_commit();
+    fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
     janet_putindex(stack[A], C, stack[B]);
+    fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
     vm_checkgc_pcnext();
 
     VM_OP(JOP_IN)
@@ -1094,9 +1108,8 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     int handle = janet_gclock();
 
     /* Run vm */
-    JanetSignal signal = run_vm(janet_vm_fiber,
+    janet_vm_fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
-                                janet_wrap_nil(),
+    JanetSignal signal = run_vm(janet_vm_fiber, janet_wrap_nil());
-                                JANET_STATUS_ALIVE);
 
     /* Teardown */
     janet_vm_stackn = oldn;
@@ -1156,14 +1169,16 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
 
     /* Run loop */
     JanetSignal signal;
+    int jmpsig;
 #if defined(JANET_BSD) || defined(JANET_APPLE)
-    if (_setjmp(buf)) {
+    jmpsig = _setjmp(buf);
 #else
-    if (setjmp(buf)) {
+    jmpsig = setjmp(buf);
 #endif
-        signal = JANET_SIGNAL_ERROR;
+    if (jmpsig) {
+        signal = (JanetSignal) jmpsig;
     } else {
-        signal = run_vm(fiber, in, old_status);
+        signal = run_vm(fiber, in);
     }
 
     /* Tear down fiber */

src/include/janet.h

@@ -696,28 +696,6 @@ struct JanetGCObject {
     JanetGCObject *next;
 };
 
-/* Fiber signal masks. */
-#define JANET_FIBER_MASK_ERROR 2
-#define JANET_FIBER_MASK_DEBUG 4
-#define JANET_FIBER_MASK_YIELD 8
-
-#define JANET_FIBER_MASK_USER0 (16 << 0)
-#define JANET_FIBER_MASK_USER1 (16 << 1)
-#define JANET_FIBER_MASK_USER2 (16 << 2)
-#define JANET_FIBER_MASK_USER3 (16 << 3)
-#define JANET_FIBER_MASK_USER4 (16 << 4)
-#define JANET_FIBER_MASK_USER5 (16 << 5)
-#define JANET_FIBER_MASK_USER6 (16 << 6)
-#define JANET_FIBER_MASK_USER7 (16 << 7)
-#define JANET_FIBER_MASK_USER8 (16 << 8)
-#define JANET_FIBER_MASK_USER9 (16 << 9)
-
-#define JANET_FIBER_MASK_USERN(N) (16 << (N))
-#define JANET_FIBER_MASK_USER 0x3FF0
-
-#define JANET_FIBER_STATUS_MASK 0xFF0000
-#define JANET_FIBER_STATUS_OFFSET 16
-
 /* A lightweight green thread in janet. Does not correspond to
  * operating system threads. */
 struct JanetFiber {
@@ -1388,6 +1366,7 @@ JANET_API Janet janet_resolve_core(const char *name);
     } \
     JANET_API void JANET_ENTRY_NAME
 
+JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
 JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
 JANET_NO_RETURN JANET_API void janet_panic(const char *message);
 JANET_NO_RETURN JANET_API void janet_panics(JanetString message);

test/suite3.janet

@@ -203,12 +203,12 @@
 (defn check-match
   [pat text should-match]
   (def result (peg/match pat text))
-  (assert (= (not should-match) (not result)) text))
+  (assert (= (not should-match) (not result)) (string "check-match " text)))
 
 (defn check-deep
   [pat text what]
   (def result (peg/match pat text))
-  (assert (deep= result what) text))
+  (assert (deep= result what) (string "check-deep " text)))
 
 # Just numbers