WIP panic functionality.

src/core/capi.c

@@ -0,0 +1,47 @@
+/*
+* Copyright (c) 2019 Calvin Rose
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+#include <janet/janet.h>
+#include "state.h"
+#include "fiber.h"
+
+void janet_panicv(Janet message) {
+    if (janet_vm_fiber != NULL) {
+        janet_fiber_push(janet_vm_fiber, message);
+        longjmp(janet_vm_fiber->buf, 1);
+    } else {
+        fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
+        exit(1);
+    }
+}
+
+void janet_panic(const char *message) {
+    janet_panicv(janet_cstringv(message));
+}
+
+void janet_panics(const uint8_t *message) {
+    janet_panicv(janet_wrap_string(message));
+}
+
+void janet_panic_type(Janet x, int32_t n, int expected) {
+    janet_panicf("bad slot #%d, expected %T, got %t", n, expected, janet_type(x));
+}

src/core/string.c

@@ -619,6 +619,30 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) {
     return S.buffer;
 }
 
+static const char *typestr(Janet x) {
+    JanetType t = janet_type(x);
+    return (t = JANET_ABSTRACT)
+        ? janet_abstract_type(janet_unwrap_abstract(x))->name
+        : janet_type_names[t];
+}
+
+static void pushtypes(JanetBuffer *buffer, int types) {
+    int first = 1;
+    int i = 0;
+    while (types) {
+        if (1 & types) {
+            if (first) {
+                first = 0;
+            } else {
+                janet_buffer_push_u8(buffer, '|');
+            }
+            janet_buffer_push_cstring(buffer, janet_type_names[i]);
+        }
+        i++;
+        types >>= 1;
+    }
+}
+
 /* Helper function for formatting strings. Useful for generating error messages and the like.
  * Similar to printf, but specialized for operating with janet. */
 const uint8_t *janet_formatc(const char *format, ...) {
@@ -679,7 +703,13 @@ const uint8_t *janet_formatc(const char *format, ...) {
                     }
                     case 't':
                     {
-                        janet_buffer_push_cstring(bufp, janet_type_names[va_arg(args, JanetType)] + 1);
+                        janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
+                        break;
+                    }
+                    case 'T':
+                    {
+                        int types = va_arg(args, int32_t);
+                        pushtypes(bufp, types);
                         break;
                     }
                     case 'V':

src/core/vm.c

@@ -144,6 +144,11 @@ static void *op_lookup[255] = {
     pc = janet_stack_frame(stack)->pc; \
     func = janet_stack_frame(stack)->func; \
 } while (0)
+#define vm_return(sig, val) do { \
+    vm_commit(); \
+    janet_fiber_push(fiber, (val)); \
+    return (sig); \
+} while (0)
 
 /* Next instruction variations */
 #define maybe_collect() do {\
@@ -153,7 +158,7 @@ static void *op_lookup[255] = {
 #define vm_checkgc_pcnext() maybe_collect(); vm_pcnext()
 
 /* Handle certain errors in main vm loop */
-#define vm_throw(e) do { retreg = janet_cstringv(e); goto vm_error; } while (0)
+#define vm_throw(e) do { vm_commit(); janet_panic(e); } while (0)
 #define vm_assert(cond, e) do {if (!(cond)) vm_throw((e)); } while (0)
 #define vm_assert_type(X, T) do { \
     if (!(janet_checktype((X), (T)))) { \
@@ -216,6 +221,33 @@ static void *op_lookup[255] = {
 #define vm_bitop(op) _vm_bitop(op, int32_t)
 #define vm_bitopu(op) _vm_bitop(op, uint32_t)
 
+/* Call a non function type */
+static Janet call_nonfn(JanetFiber *fiber, Janet callee) { 
+    int status;
+    int32_t argn = fiber->stacktop - fiber->stackstart;
+    Janet ds, key, ret;
+    if (!janet_checktypes(callee, JANET_TFLAG_FUNCLIKE)) {
+        janet_panicf("attempted to called %v, expected %t", callee,
+                JANET_TFLAG_CALLABLE);
+    }
+    if (argn != 1) janet_panicf("%v called with arity %d, expected 1", argn);
+    if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)) {
+        ds = callee;
+        key = fiber->data[fiber->stackstart];
+    } else {
+        ds = fiber->data[fiber->stackstart];
+        key = callee;
+    }
+    fiber->stacktop = fiber->stackstart;
+    status = janet_get(ds, key, &ret);
+    if (status == -2) {
+        janet_panic("expected integer key");
+    } else if (status == -1) {
+        janet_panic("expected table or struct");
+    }
+    return ret;
+}
+
 /* Interpreter main loop */
 static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
@@ -232,9 +264,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     /* Expected types on type error */
     uint16_t expected_types;
     
-    /* Signal to return when done */
-    JanetSignal signal = JANET_SIGNAL_OK;
-    
     /* Only should be hit if the fiber is either waiting for a child, or
      * waiting to be resumed. In those cases, use input and increment pc. We
      * DO NOT use input when resuming a fiber that has been interrupted at a 
@@ -257,34 +286,28 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     VM_START();
 
     VM_DEFAULT();
-    signal = JANET_SIGNAL_DEBUG;
+    vm_return(JANET_SIGNAL_DEBUG, janet_wrap_nil());
-    retreg = janet_wrap_nil();
-    goto vm_exit;
 
     VM_OP(JOP_NOOP)
     vm_pcnext();
 
     VM_OP(JOP_ERROR)
-    retreg = stack[A];
+    janet_panicv(stack[A]);
-    goto vm_error;
+    vm_next(); /* pacify compiler warnings */
 
     VM_OP(JOP_TYPECHECK)
     if (!janet_checktypes(stack[A], E)) {
-        JanetArgs tempargs;
+        janet_panicf("expected %T, got %t", E, stack[A]);
-        tempargs.n = A + 1;
-        tempargs.v = stack;
-        janet_typemany_err(tempargs, A, E);
-        goto vm_error;
     }
     vm_pcnext();
 
     VM_OP(JOP_RETURN)
     retreg = stack[D];
-    goto vm_return;
+    goto vm_handle_return;
 
     VM_OP(JOP_RETURN_NIL)
     retreg = janet_wrap_nil();
-    goto vm_return;
+    goto vm_handle_return;
 
     VM_OP(JOP_ADD_IMMEDIATE)
     vm_binop_immediate(+);
@@ -543,15 +566,17 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     VM_OP(JOP_CALL)
     {
         Janet callee = stack[E];
-        if (fiber->maxstack &&
+        if (fiber->stacktop > fiber->maxstack) {
-                fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
         }
         if (janet_checktype(callee, JANET_FUNCTION)) {
             func = janet_unwrap_function(callee);
             janet_stack_frame(stack)->pc = pc;
-            if (janet_fiber_funcframe(fiber, func))
+            if (janet_fiber_funcframe(fiber, func)) {
-                goto vm_arity_error;
+                int32_t n = fiber->stacktop - fiber->stackstart;
+                janet_panicf("%v called with %d argument%s, expected %d",
+                        callee, n, n > 1 ? "s" : "", func->def->arity);
+            }
             stack = fiber->data + fiber->frame;
             pc = func->def->bytecode;
             vm_checkgc_next();
@@ -562,45 +587,16 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             retreg = janet_wrap_nil();
             args.v = fiber->data + fiber->frame;
             args.ret = &retreg;
-            if (janet_unwrap_cfunction(callee)(args)) {
+            vm_commit();
-                signal = JANET_SIGNAL_ERROR;
+            if (janet_unwrap_cfunction(callee)(args)) janet_panicv(retreg);
-                goto vm_exit;
-            }
             janet_fiber_popframe(fiber);
-            if (fiber->frame == 0) goto vm_exit;
+            if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, retreg);
             stack = fiber->data + fiber->frame;
             stack[A] = retreg;
             vm_checkgc_pcnext();
         } else {
-            int status;
+            vm_commit();
-            int32_t argn = fiber->stacktop - fiber->stackstart;
+            stack[A] = call_nonfn(fiber, callee);
-            Janet ds, key;
-            if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)) {
-                if (argn != 1) {
-                    retreg = callee;
-                    goto vm_arity_error_2;
-                }
-                ds = callee;
-                key = fiber->data[fiber->stackstart];
-            } else if (janet_checktypes(callee, JANET_TFLAG_SYMBOL | JANET_TFLAG_KEYWORD)) {
-                if (argn != 1) {
-                    retreg = callee;
-                    goto vm_arity_error_2;
-                }
-                ds = fiber->data[fiber->stackstart];
-                key = callee;
-            } else {
-                expected_types = JANET_TFLAG_CALLABLE;
-                retreg = callee;
-                goto vm_type_error;
-            }
-            fiber->stacktop = fiber->stackstart;
-            status = janet_get(ds, key, stack + A);
-            if (status == -2) {
-                vm_throw("expected integer key");
-            } else if (status == -1) {
-                vm_throw("expected table or struct");
-            }
             vm_pcnext();
         }
     }
@@ -610,8 +606,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         Janet callee = stack[D];
         if (janet_checktype(callee, JANET_FUNCTION)) {
             func = janet_unwrap_function(callee);
-            if (janet_fiber_funcframe_tail(fiber, func))
+            if (janet_fiber_funcframe_tail(fiber, func)) {
-                goto vm_arity_error;
+                int32_t n = fiber->stacktop - fiber->stackstart;
+                janet_panicf("%v called with %d argument%s, expected %d",
+                        callee, n, n > 1 ? "s" : "", func->def->arity);
+            }
             stack = fiber->data + fiber->frame;
             pc = func->def->bytecode;
             vm_checkgc_next();
@@ -622,49 +621,20 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             retreg = janet_wrap_nil();
             args.v = fiber->data + fiber->frame;
             args.ret = &retreg;
-            if (janet_unwrap_cfunction(callee)(args)) {
+            vm_commit();
-                signal = JANET_SIGNAL_ERROR;
+            if (janet_unwrap_cfunction(callee)(args))
-                goto vm_exit;
+                vm_return(JANET_SIGNAL_ERROR, retreg);
-            }
             janet_fiber_popframe(fiber);
-            janet_fiber_popframe(fiber);
-            if (fiber->frame == 0) goto vm_exit;
-            goto vm_reset;
         } else {
-            int status;
+            vm_commit();
-            int32_t argn = fiber->stacktop - fiber->stackstart;
+            retreg = call_nonfn(fiber, callee);
-            Janet ds, key;
-            if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)) {
-                if (argn != 1) {
-                    retreg = callee;
-                    goto vm_arity_error_2;
-                }
-                ds = callee;
-                key = fiber->data[fiber->stackstart];
-            } else if (janet_checktypes(callee, JANET_TFLAG_SYMBOL | JANET_TFLAG_KEYWORD)) {
-                if (argn != 1) {
-                    retreg = callee;
-                    goto vm_arity_error_2;
-                }
-                ds = fiber->data[fiber->stackstart];
-                key = callee;
-            } else {
-                expected_types = JANET_TFLAG_CALLABLE;
-                retreg = callee;
-                goto vm_type_error;
-            }
-            fiber->stacktop = fiber->stackstart;
-            status = janet_get(ds, key, &retreg);
-            if (status == -2) {
-                vm_throw("expected integer key");
-            } else if (status == -1) {
-                vm_throw("expected table or struct");
         }
+        /* Make it a tail call */
         janet_fiber_popframe(fiber);
-            if (fiber->frame == 0) goto vm_exit;
+        if (fiber->frame == 0)
+            vm_return(JANET_SIGNAL_OK, retreg);
         goto vm_reset;
     }
-    }
 
     VM_OP(JOP_RESUME)
     {
@@ -672,10 +642,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         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)))
-            signal = sig;
+            vm_return(sig, retreg);
-            goto vm_exit;
-        }
         fiber->child = NULL;
         stack[A] = retreg;
         vm_checkgc_pcnext();
@@ -686,9 +654,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         int32_t s = C;
         if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9;
         if (s < 0) s = 0;
-        signal = s;
+        vm_return(s, stack[B]);
-        retreg = stack[B];
-        goto vm_exit;
     }
 
     VM_OP(JOP_PUT)
@@ -838,68 +804,27 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     }
 
     /* Handle returning from stack frame. Expect return value in retreg */
-    vm_return:
+    vm_handle_return:
     {
         janet_fiber_popframe(fiber);
-        if (fiber->frame == 0) goto vm_exit;
+        if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, retreg);
         goto vm_reset;
     }
 
-    /* Handle function calls with bad arity */
-    vm_arity_error:
-    {
-        int32_t nargs = fiber->stacktop - fiber->stackstart;
-        retreg = janet_wrap_string(janet_formatc("%v called with %d argument%s, expected %d",
-                    janet_wrap_function(func),
-                    nargs,
-                    nargs == 1 ? "" : "s",
-                    func->def->arity));
-        signal = JANET_SIGNAL_ERROR;
-        goto vm_exit;
-    }
-
-    /* Handle calling a data structure, keyword, or symbol with bad arity */
-    vm_arity_error_2:
-    {
-        int32_t nargs = fiber->stacktop - fiber->stackstart;
-        retreg = janet_wrap_string(janet_formatc("%v called with %d argument%s, expected 1",
-                    retreg,
-                    nargs,
-                    nargs == 1 ? "" : "s"));
-        signal = JANET_SIGNAL_ERROR;
-        goto vm_exit;
-    }
-
     /* Handle type errors. The found type is the type of retreg,
      * the expected types are in the expected_types field. */
     vm_type_error:
     {
         JanetBuffer errbuf;
+        const uint8_t *message;
         janet_buffer_init(&errbuf, 10);
         janet_buffer_push_cstring(&errbuf, "expected ");
         janet_buffer_push_types(&errbuf, expected_types);
         janet_buffer_push_cstring(&errbuf, ", got ");
         janet_buffer_push_cstring(&errbuf, janet_type_names[janet_type(retreg)]);
-        retreg = janet_stringv(errbuf.data, errbuf.count);
+        message = janet_string(errbuf.data, errbuf.count);
         janet_buffer_deinit(&errbuf);
-        signal = JANET_SIGNAL_ERROR;
+        janet_panics(message);
-        goto vm_exit;
-    }
-
-    /* Handle errors from c functions and vm opcodes */
-    vm_error:
-    {
-        signal = JANET_SIGNAL_ERROR;
-        goto vm_exit;
-    }
-
-    /* Exit from vm loop. If signal is not set explicitely, does
-     * a successful return (JANET_SIGNAL_OK). */
-    vm_exit:
-    {
-        janet_stack_frame(stack)->pc = pc;
-        janet_fiber_push(fiber, retreg);
-        return signal;
     }
 
     /* Reset state of machine */
@@ -951,7 +876,12 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
     janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
 
     /* Run loop */
-    JanetSignal signal = run_vm(fiber, in);
+    JanetSignal signal;
+    if (setjmp(fiber->buf)) {
+        signal = JANET_SIGNAL_ERROR;
+    } else {
+        signal = run_vm(fiber, in);
+    }
 
     /* Tear down */
     janet_fiber_set_status(fiber, signal);

src/include/janet/janet.h

@@ -201,6 +201,7 @@ extern "C" {
 #include <string.h>
 #include <stdlib.h>
 #include <stdarg.h>
+#include <setjmp.h>
 
 /* Names of all of the types */
 extern const char *const janet_type_names[16];
@@ -314,11 +315,13 @@ typedef enum JanetType {
 
 /* Some abstractions */
 #define JANET_TFLAG_BOOLEAN (JANET_TFLAG_TRUE | JANET_TFLAG_FALSE)
-#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
 #define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
 #define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
 #define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
 #define JANET_TFLAG_LENGTHABLE (JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)
+#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
+#define JANET_TFLAG_FUNCLIKE (JANET_TFLAG_CALLABLE | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY | \
+        JANET_TFLAG_KEYWORD | JANET_TFLAG_SYMBOL)
 
 /* We provide three possible implemenations of Janets. The preferred
  * nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
@@ -610,6 +613,7 @@ struct JanetFiber {
     int32_t capacity;
     int32_t maxstack; /* Arbitrary defined limit for stack overflow */
     int32_t flags; /* Various flags */
+    jmp_buf buf; /* Handle errors */
 };
 
 /* Mark if a stack frame is a tail call for debugging */
@@ -1124,6 +1128,13 @@ JANET_API int janet_type_err(JanetArgs args, int32_t n, JanetType expected);
 JANET_API int janet_typemany_err(JanetArgs args, int32_t n, int expected);
 JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *at);
 
+/* New C API */
+JANET_API void janet_panicv(Janet message);
+JANET_API void janet_panic(const char *message);
+JANET_API void janet_panics(const uint8_t *message);
+#define janet_panicf(message, ...) janet_panics(janet_formatc(message, __VA_ARGS__))
+JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
+
 /* Helpers for writing modules */
 #define JANET_MODULE_ENTRY JANET_API int _janet_init