From 28439d822ab4302bb285366876af5b7e28af753b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 22 Aug 2020 15:35:37 -0500 Subject: [PATCH] Add cancel function. This should allow better stack unwinding on a fiber that no longer needs to complete. --- CHANGELOG.md | 4 +++- src/core/asm.c | 1 + src/core/bytecode.c | 1 + src/core/cfuns.c | 4 ++++ src/core/compile.h | 1 + src/core/corelib.c | 9 +++++++++ src/core/vm.c | 21 ++++++++++++++++++++- src/include/janet.h | 1 + test/suite0010.janet | 13 +++++++++++++ 9 files changed, 53 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ff690b43..17b26569 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `cancel`. Resumes a fiber but makes it immediately error at the yield point. +- Allow multi-line paste into built in repl. - Add `(curenv)`. - Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures. - Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop @@ -16,7 +18,7 @@ All notable changes to this project will be documented in this file. - Expose `janet_cryptorand` in C API. - Properly initialize PRF in default janet program - Add `index-of` to core library. -- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile) +- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile) - Fix defaults on Windows for ARM - Fix defaults on NetBSD. diff --git a/src/core/asm.c b/src/core/asm.c index 961b671d..09ffffe2 100644 --- a/src/core/asm.c +++ b/src/core/asm.c @@ -73,6 +73,7 @@ static const JanetInstructionDef janet_ops[] = { {"call", JOP_CALL}, {"clo", JOP_CLOSURE}, {"cmp", JOP_COMPARE}, + {"cncl", JOP_CANCEL}, {"div", JOP_DIVIDE}, {"divim", JOP_DIVIDE_IMMEDIATE}, {"eq", JOP_EQUALS}, diff --git a/src/core/bytecode.c b/src/core/bytecode.c index 4d2a74c3..bd07b5ef 100644 --- a/src/core/bytecode.c +++ b/src/core/bytecode.c @@ -103,6 +103,7 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = { JINT_SSS, /* JOP_NEXT */ JINT_SSS, /* JOP_NOT_EQUALS, */ JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */ + JINT_SSS /* JOP_CANCEL, */ }; /* Verify some bytecode */ diff --git a/src/core/cfuns.c b/src/core/cfuns.c index 41fc18a7..3e5f9ad6 100644 --- a/src/core/cfuns.c +++ b/src/core/cfuns.c @@ -231,6 +231,9 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) { static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) { return opfunction(opts, args, JOP_RESUME, janet_wrap_nil()); } +static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) { + return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil()); +} static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) { /* Push phase */ JanetCompiler *c = opts.compiler; @@ -383,6 +386,7 @@ static const JanetFunOptimizer optimizers[] = { {fixarity2, do_modulo}, {fixarity2, do_remainder}, {fixarity2, do_cmp}, + {fixarity2, do_cancel}, }; const JanetFunOptimizer *janetc_funopt(uint32_t flags) { diff --git a/src/core/compile.h b/src/core/compile.h index 5782bbf1..20f20224 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -61,6 +61,7 @@ #define JANET_FUN_MODULO 29 #define JANET_FUN_REMAINDER 30 #define JANET_FUN_CMP 31 +#define JANET_FUN_CANCEL 32 /* Compiler typedefs */ typedef struct JanetCompiler JanetCompiler; diff --git a/src/core/corelib.c b/src/core/corelib.c index be38cbf2..0ad084e8 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -946,6 +946,10 @@ static const uint32_t resume_asm[] = { JOP_RESUME | (1 << 24), JOP_RETURN }; +static const uint32_t cancel_asm[] = { + JOP_CANCEL | (1 << 24), + JOP_RETURN +}; static const uint32_t in_asm[] = { JOP_IN | (1 << 24), JOP_LOAD_NIL | (3 << 8), @@ -1083,6 +1087,11 @@ JanetTable *janet_core_env(JanetTable *replacements) { "Yield a value to a parent fiber. When a fiber yields, its execution is paused until " "another thread resumes it. The fiber will then resume, and the last yield call will " "return the value that was passed to resume.")); + janet_quick_asm(env, JANET_FUN_CANCEL, + "cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm), + JDOC("(cancel fiber err)\n\n" + "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " + "Returns the same result as resume.")); janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm), JDOC("(resume fiber &opt x)\n\n" diff --git a/src/core/vm.c b/src/core/vm.c index a6c75b02..1cbe47ca 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -380,7 +380,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { &&label_JOP_NEXT, &&label_JOP_NOT_EQUALS, &&label_JOP_NOT_EQUALS_IMMEDIATE, - &&label_unknown_op, + &&label_JOP_CANCEL, &&label_unknown_op, &&label_unknown_op, &&label_unknown_op, @@ -1064,6 +1064,25 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { vm_return((int) sub_status, stack[B]); } + VM_OP(JOP_CANCEL) { + Janet retreg; + vm_assert_type(stack[B], JANET_FIBER); + JanetFiber *child = janet_unwrap_fiber(stack[B]); + if (janet_check_can_resume(child, &retreg)) { + vm_commit(); + janet_panicv(retreg); + } + fiber->child = child; + JanetSignal sig = janet_continue_signal(child, stack[C], &retreg, JANET_SIGNAL_ERROR); + if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) { + vm_return(sig, retreg); + } + fiber->child = NULL; + stack = fiber->data + fiber->frame; + stack[A] = retreg; + vm_checkgc_pcnext(); + } + VM_OP(JOP_PUT) vm_commit(); fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL; diff --git a/src/include/janet.h b/src/include/janet.h index 946cfb16..e9f3e5a6 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1131,6 +1131,7 @@ enum JanetOpCode { JOP_NEXT, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, + JOP_CANCEL, JOP_INSTRUCTION_COUNT }; diff --git a/test/suite0010.janet b/test/suite0010.janet index 0b51aa31..1205d192 100644 --- a/test/suite0010.janet +++ b/test/suite0010.janet @@ -44,4 +44,17 @@ (assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple") (assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array") +# Cancel test +(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti)) +(assert (= 1 (resume f)) "cancel resume 1") +(assert (= 2 (resume f)) "cancel resume 2") +(assert (= :hi (cancel f :hi)) "cancel resume 3") +(assert (= :error (fiber/status f)) "cancel resume 4") + +# Curenv +(assert (= (curenv) (curenv 0)) "curenv 1") +(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2") +(assert (= nil (curenv 1000000)) "curenv 3") +(assert (= root-env (curenv 1)) "curenv 4") + (end-suite)