diff --git a/examples/sigaction.janet b/examples/sigaction.janet index 5887ffad..36c59a7c 100644 --- a/examples/sigaction.janet +++ b/examples/sigaction.janet @@ -1,10 +1,41 @@ -(defn action [] - (print "Handled SIGHUP!") - (flush)) +### +### Usage: janet examples/sigaction.janet 1|2|3|4 & +### +### Then at shell: kill -s SIGTERM $! +### -(defn main [_] - # Set the interrupt-interpreter argument to `true` to allow - # interrupting the busy loop `(forever)`. By default, will not - # interrupt the interpreter. - (os/sigaction :hup action true) +(defn action + [] + (print "Handled SIGTERM!") + (flush) + (os/exit 1)) + +(defn main1 + [] + (os/sigaction :term action true) (forever)) + +(defn main2 + [] + (os/sigaction :term action) + (forever)) + +(defn main3 + [] + (os/sigaction :term action true) + (forever (ev/sleep math/inf))) + +(defn main4 + [] + (os/sigaction :term action) + (forever (ev/sleep math/inf))) + +(defn main + [& args] + (def which (scan-number (get args 1 "1"))) + (case which + 1 (main1) # should work + 2 (main2) # will not work + 3 (main3) # should work + 4 (main4) # should work + (error "bad main"))) diff --git a/meson_options.txt b/meson_options.txt index e9f88c73..91293fa2 100644 --- a/meson_options.txt +++ b/meson_options.txt @@ -18,7 +18,7 @@ option('realpath', type : 'boolean', value : true) option('simple_getline', type : 'boolean', value : false) option('epoll', type : 'boolean', value : false) option('kqueue', type : 'boolean', value : false) -option('interpreter_interrupt', type : 'boolean', value : false) +option('interpreter_interrupt', type : 'boolean', value : true) option('ffi', type : 'boolean', value : true) option('ffi_jit', type : 'boolean', value : true) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index fd26f843..a0defe8d 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -419,9 +419,11 @@ (error (string "expected tuple for range, got " x)))) (defn- range-template - [binding object rest op comparison] + [binding object kind rest op comparison] (let [[start stop step] (check-indexed object)] - (for-template binding start stop (or step 1) comparison op [rest]))) + (case kind + :range (for-template binding (if stop start 0) (or stop start) (or step 1) comparison op [rest]) + :down (for-template binding start (or stop 0) (or step 1) comparison op [rest])))) (defn- each-template [binding inx kind body] @@ -477,10 +479,10 @@ (def {(+ i 2) object} head) (let [rest (loop1 body head (+ i 3))] (case verb - :range (range-template binding object rest + <) - :range-to (range-template binding object rest + <=) - :down (range-template binding object rest - >) - :down-to (range-template binding object rest - >=) + :range (range-template binding object :range rest + <) + :range-to (range-template binding object :range rest + <=) + :down (range-template binding object :down rest - >) + :down-to (range-template binding object :down rest - >=) :keys (each-template binding object :keys [rest]) :pairs (each-template binding object :pairs [rest]) :in (each-template binding object :each [rest]) @@ -702,30 +704,38 @@ [f] (fn [x] (not (f x)))) +(defmacro- do-extreme + [order args] + ~(do + (def ds ,args) + (var k (next ds nil)) + (var ret (get ds k)) + (while (,not= nil (set k (next ds k))) + (def x (in ds k)) + (if (,order x ret) (set ret x))) + ret)) + (defn extreme ``Returns the most extreme value in `args` based on the function `order`. `order` should take two values and return true or false (a comparison). Returns nil if `args` is empty.`` - [order args] - (var [ret] args) - (each x args (if (order x ret) (set ret x))) - ret) + [order args] (do-extreme order args)) (defn max "Returns the numeric maximum of the arguments." - [& args] (extreme > args)) + [& args] (do-extreme > args)) (defn min "Returns the numeric minimum of the arguments." - [& args] (extreme < args)) + [& args] (do-extreme < args)) (defn max-of "Returns the numeric maximum of the argument sequence." - [args] (extreme > args)) + [args] (do-extreme > args)) (defn min-of "Returns the numeric minimum of the argument sequence." - [args] (extreme < args)) + [args] (do-extreme < args)) (defn first "Get the first element from an indexed data structure." @@ -1425,7 +1435,7 @@ (defn every? ``Evaluates to the last element of `ind` if all preceding elements are truthy, - otherwise evaluates to the first falsey argument.`` + otherwise evaluates to the first falsey element.`` [ind] (var res true) (loop [x :in ind :while res] @@ -1445,28 +1455,29 @@ `Reverses the order of the elements in a given array or buffer and returns it mutated.` [t] - (def len-1 (- (length t) 1)) - (def half (/ len-1 2)) - (forv i 0 half - (def j (- len-1 i)) - (def l (in t i)) - (def r (in t j)) - (put t i r) - (put t j l)) + (var i 0) + (var j (length t)) + (while (< i (-- j)) + (def ti (in t i)) + (put t i (in t j)) + (put t j ti) + (++ i)) t) (defn reverse `Reverses the order of the elements in a given array or tuple and returns - a new array. If a string or buffer is provided, returns an array of its - byte values, reversed.` + a new array. If a string or buffer is provided, returns a buffer instead.` [t] - (var n (length t)) - (def ret (if (bytes? t) - (buffer/new-filled n) - (array/new-filled n))) - (each v t - (put ret (-- n) v)) - ret) + (if (lengthable? t) + (do + (var n (length t)) + (def ret (if (bytes? t) + (buffer/new-filled n) + (array/new-filled n))) + (each v t + (put ret (-- n) v)) + ret) + (reverse! (seq [v :in t] v)))) (defn invert ``Given an associative data structure `ds`, returns a new table where the @@ -1576,32 +1587,41 @@ (defn keys "Get the keys of an associative data structure." [x] - (def arr (array/new-filled (length x))) - (var i 0) - (eachk k x - (put arr i k) - (++ i)) - arr) + (if (lengthable? x) + (do + (def arr (array/new-filled (length x))) + (var i 0) + (eachk k x + (put arr i k) + (++ i)) + arr) + (seq [k :keys x] k))) (defn values "Get the values of an associative data structure." [x] - (def arr (array/new-filled (length x))) - (var i 0) - (each v x - (put arr i v) - (++ i)) - arr) + (if (lengthable? x) + (do + (def arr (array/new-filled (length x))) + (var i 0) + (each v x + (put arr i v) + (++ i)) + arr) + (seq [v :in x] v))) (defn pairs "Get the key-value pairs of an associative data structure." [x] - (def arr (array/new-filled (length x))) - (var i 0) - (eachp p x - (put arr i p) - (++ i)) - arr) + (if (lengthable? x) + (do + (def arr (array/new-filled (length x))) + (var i 0) + (eachp p x + (put arr i p) + (++ i)) + arr) + (seq [p :pairs x] p))) (defn frequencies "Get the number of occurrences of each value in an indexed data structure." @@ -2869,7 +2889,12 @@ (if (= :dead fs) (when is-repl (put env '_ @{:value x}) - (printf (get env *pretty-format* "%q") x) + (def pf (get env *pretty-format* "%q")) + (try + (printf pf x) + ([e] + (eprintf "bad pretty format %v: %v" pf e) + (eflush))) (flush)) (do (debug/stacktrace f x "") diff --git a/src/core/corelib.c b/src/core/corelib.c index c89787b9..5e46f33e 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -680,6 +680,13 @@ JANET_CORE_FN(janet_core_is_dictionary, return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY)); } +JANET_CORE_FN(janet_core_is_lengthable, + "(lengthable? x)", + "Check if x is a bytes, indexed, or dictionary.") { + janet_fixarity(argc, 1); + return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE)); +} + JANET_CORE_FN(janet_core_signal, "(signal what x)", "Raise a signal with payload x. ") { @@ -1079,6 +1086,7 @@ static void janet_load_libs(JanetTable *env) { JANET_CORE_REG("bytes?", janet_core_is_bytes), JANET_CORE_REG("indexed?", janet_core_is_indexed), JANET_CORE_REG("dictionary?", janet_core_is_dictionary), + JANET_CORE_REG("lengthable?", janet_core_is_lengthable), JANET_CORE_REG("slice", janet_core_slice), JANET_CORE_REG("range", janet_core_range), JANET_CORE_REG("signal", janet_core_signal), diff --git a/src/core/ev.c b/src/core/ev.c index 5f999764..f2edb205 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -127,7 +127,7 @@ static int32_t janet_q_count(JanetQueue *q) { : (q->tail - q->head); } -static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) { +static int janet_q_maybe_resize(JanetQueue *q, size_t itemsize) { int32_t count = janet_q_count(q); /* Resize if needed */ if (count + 1 >= q->capacity) { @@ -151,11 +151,27 @@ static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) { } q->capacity = newcap; } + return 0; +} + +static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) { + if (janet_q_maybe_resize(q, itemsize)) return 1; memcpy((char *) q->data + itemsize * q->tail, item, itemsize); q->tail = q->tail + 1 < q->capacity ? q->tail + 1 : 0; return 0; } +static int janet_q_push_head(JanetQueue *q, void *item, size_t itemsize) { + if (janet_q_maybe_resize(q, itemsize)) return 1; + int32_t newhead = q->head - 1; + if (newhead < 0) { + newhead += q->capacity; + } + memcpy((char *) q->data + itemsize * newhead, item, itemsize); + q->head = newhead; + return 0; +} + static int janet_q_pop(JanetQueue *q, void *out, size_t itemsize) { if (q->head == q->tail) return 1; memcpy(out, (char *) q->data + itemsize * q->head, itemsize); @@ -468,7 +484,7 @@ const JanetAbstractType janet_stream_type = { }; /* Register a fiber to resume with value */ -void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) { +static void janet_schedule_general(JanetFiber *fiber, Janet value, JanetSignal sig, int soon) { if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return; if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) { Janet task_element = janet_wrap_fiber(fiber); @@ -477,7 +493,19 @@ void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) { JanetTask t = { fiber, value, sig, ++fiber->sched_id }; fiber->gc.flags |= JANET_FIBER_FLAG_ROOT; if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED; - janet_q_push(&janet_vm.spawn, &t, sizeof(t)); + if (soon) { + janet_q_push_head(&janet_vm.spawn, &t, sizeof(t)); + } else { + janet_q_push(&janet_vm.spawn, &t, sizeof(t)); + } +} + +void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) { + janet_schedule_general(fiber, value, sig, 0); +} + +void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig) { + janet_schedule_general(fiber, value, sig, 1); } void janet_cancel(JanetFiber *fiber, Janet value) { @@ -604,7 +632,11 @@ void janet_addtimeout(double sec) { void janet_ev_inc_refcount(void) { #ifdef JANET_WINDOWS +#ifdef JANET_64 + InterlockedIncrement64(&janet_vm.extra_listeners); +#else InterlockedIncrement(&janet_vm.extra_listeners); +#endif #else __atomic_add_fetch(&janet_vm.extra_listeners, 1, __ATOMIC_RELAXED); #endif @@ -612,7 +644,11 @@ void janet_ev_inc_refcount(void) { void janet_ev_dec_refcount(void) { #ifdef JANET_WINDOWS +#ifdef JANET_64 + InterlockedDecrement64(&janet_vm.extra_listeners); +#else InterlockedDecrement(&janet_vm.extra_listeners); +#endif #else __atomic_add_fetch(&janet_vm.extra_listeners, -1, __ATOMIC_RELAXED); #endif @@ -1300,33 +1336,6 @@ int janet_loop_done(void) { janet_vm.extra_listeners); } -static void janet_loop1_poll(void) { - /* Poll for events */ - if (janet_vm.listener_count || janet_vm.tq_count || janet_vm.extra_listeners) { - JanetTimeout to; - memset(&to, 0, sizeof(to)); - int has_timeout; - /* Drop timeouts that are no longer needed */ - while ((has_timeout = peek_timeout(&to))) { - if (to.curr_fiber != NULL) { - if (!janet_fiber_can_resume(to.curr_fiber)) { - janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber)); - pop_timeout(0); - continue; - } - } else if (to.fiber->sched_id != to.sched_id) { - pop_timeout(0); - continue; - } - break; - } - /* Run polling implementation only if pending timeouts or pending events */ - if (janet_vm.tq_count || janet_vm.listener_count || janet_vm.extra_listeners) { - janet_loop1_impl(has_timeout, to.when); - } - } -} - JanetFiber *janet_loop1(void) { /* Schedule expired timers */ JanetTimeout to; @@ -1349,8 +1358,10 @@ JanetFiber *janet_loop1(void) { } } - /* Run scheduled fibers */ + /* Run scheduled fibers unless interrupts need to be handled. */ while (janet_vm.spawn.head != janet_vm.spawn.tail) { + /* Don't run until all interrupts have been marked as handled by calling janet_interpreter_interrupt_handled */ + if (janet_vm.auto_suspend) break; JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0}; janet_q_pop(&janet_vm.spawn, &task, sizeof(task)); if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount(); @@ -1379,12 +1390,34 @@ JanetFiber *janet_loop1(void) { janet_stacktrace_ext(task.fiber, res, ""); } if (sig == JANET_SIGNAL_INTERRUPT) { - /* On interrupts, return the interrupted fiber immediately */ return task.fiber; } } - janet_loop1_poll(); + /* Poll for events */ + if (janet_vm.listener_count || janet_vm.tq_count || janet_vm.extra_listeners) { + JanetTimeout to; + memset(&to, 0, sizeof(to)); + int has_timeout; + /* Drop timeouts that are no longer needed */ + while ((has_timeout = peek_timeout(&to))) { + if (to.curr_fiber != NULL) { + if (!janet_fiber_can_resume(to.curr_fiber)) { + janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber)); + pop_timeout(0); + continue; + } + } else if (to.fiber->sched_id != to.sched_id) { + pop_timeout(0); + continue; + } + break; + } + /* Run polling implementation only if pending timeouts or pending events */ + if (janet_vm.tq_count || janet_vm.listener_count || janet_vm.extra_listeners) { + janet_loop1_impl(has_timeout, to.when); + } + } /* No fiber was interrupted */ return NULL; @@ -1405,12 +1438,6 @@ void janet_loop(void) { while (!janet_loop_done()) { JanetFiber *interrupted_fiber = janet_loop1(); if (NULL != interrupted_fiber) { - /* Allow an extra poll before rescheduling to allow posted events to be handled - * before entering a possibly infinite, blocking loop. */ - Janet x = janet_wrap_fiber(interrupted_fiber); - janet_gcroot(x); - janet_loop1_poll(); - janet_gcunroot(x); janet_schedule(interrupted_fiber, janet_wrap_nil()); } } diff --git a/src/core/os.c b/src/core/os.c index 1f1cad35..bc82bf46 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -809,6 +809,7 @@ static void close_handle(JanetHandle handle) { #ifndef JANET_WINDOWS static void janet_signal_callback(JanetEVGenericMessage msg) { int sig = msg.tag; + if (msg.argi) janet_interpreter_interrupt_handled(NULL); Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig)); if (!janet_checktype(handlerv, JANET_FUNCTION)) { /* Let another thread/process try to handle this */ @@ -825,10 +826,8 @@ static void janet_signal_callback(JanetEVGenericMessage msg) { } JanetFunction *handler = janet_unwrap_function(handlerv); JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL); - janet_schedule(fiber, janet_wrap_nil()); - if (msg.argi) { - janet_ev_dec_refcount(); - } + janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK); + janet_ev_dec_refcount(); } static void janet_signal_trampoline_no_interrupt(int sig) { @@ -837,6 +836,7 @@ static void janet_signal_trampoline_no_interrupt(int sig) { memset(&msg, 0, sizeof(msg)); msg.tag = sig; janet_ev_post_event(&janet_vm, janet_signal_callback, msg); + janet_ev_inc_refcount(); } static void janet_signal_trampoline(int sig) { @@ -845,18 +845,20 @@ static void janet_signal_trampoline(int sig) { memset(&msg, 0, sizeof(msg)); msg.tag = sig; msg.argi = 1; + janet_interpreter_interrupt(NULL); janet_ev_post_event(&janet_vm, janet_signal_callback, msg); janet_ev_inc_refcount(); - janet_interpreter_interrupt(NULL); } #endif JANET_CORE_FN(os_sigaction, "(os/sigaction which &opt handler interrupt-interpreter)", - "Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler.") { + "Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. " + "All signal handlers are the same as supported by `os/proc-kill`.") { janet_sandbox_assert(JANET_SANDBOX_SIGNAL); janet_arity(argc, 1, 3); #ifdef JANET_WINDOWS + (void) argv; janet_panic("unsupported on this platform"); #else /* TODO - per thread signal masks */ @@ -880,7 +882,11 @@ JANET_CORE_FN(os_sigaction, sigfillset(&mask); memset(&action, 0, sizeof(action)); if (can_interrupt) { +#ifdef JANET_NO_INTERPRETER_INTERRUPT + janet_panic("interpreter interrupt not enabled"); +#else action.sa_handler = janet_signal_trampoline; +#endif } else { action.sa_handler = janet_signal_trampoline_no_interrupt; } diff --git a/src/core/specials.c b/src/core/specials.c index d4da602e..c19c728b 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -530,6 +530,32 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) { return ret; } +/* Check if a form matches the pattern (= nil _) or (not= nil _) */ +static int janetc_check_nil_form(JanetFopts opts, Janet x, Janet *capture, uint32_t fun_tag) { + if (!janet_checktype(x, JANET_TUPLE)) return 0; + JanetTuple tup = janet_unwrap_tuple(x); + if (3 != janet_tuple_length(tup)) return 0; + Janet op1 = tup[0]; + if (janet_checktype(op1, JANET_SYMBOL)) { + Janet entry = janet_table_get(opts.compiler->env, op1); + if (janet_checktype(entry, JANET_TABLE)) { + op1 = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("value")); + } + } + if (!janet_checktype(op1, JANET_FUNCTION)) return 0; + JanetFunction *fun = janet_unwrap_function(op1); + uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG; + if (tag != fun_tag) return 0; + if (janet_checktype(tup[1], JANET_NIL)) { + *capture = tup[2]; + return 1; + } else if (janet_checktype(tup[2], JANET_NIL)) { + *capture = tup[1]; + return 1; + } + return 0; +} + /* * :condition * ... @@ -550,6 +576,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { JanetScope condscope, tempscope; const int tail = opts.flags & JANET_FOPTS_TAIL; const int drop = opts.flags & JANET_FOPTS_DROP; + uint8_t ifnjmp = JOP_JUMP_IF_NOT; if (argn < 2 || argn > 3) { janetc_cerror(c, "expected 2 or 3 arguments to if"); @@ -572,7 +599,16 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { /* Compile condition */ janetc_scope(&condscope, c, 0, "if"); - cond = janetc_value(condopts, argv[0]); + + Janet condform = argv[0]; + if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) { + ifnjmp = JOP_JUMP_IF_NOT_NIL; + } + if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) { + ifnjmp = JOP_JUMP_IF_NIL; + } + + cond = janetc_value(condopts, condform); /* Check constant condition. */ /* TODO: Use type info for more short circuits */ @@ -595,7 +631,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { } /* Compile jump to right */ - labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0); + labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0); /* Condition left body */ janetc_scope(&tempscope, c, 0, "if-true"); @@ -605,7 +641,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { /* Compile jump to done */ labeljd = janet_v_count(c->buffer); - if (!tail) janetc_emit(c, JOP_JUMP); + if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP); /* Compile right body */ labelr = janet_v_count(c->buffer); @@ -741,20 +777,6 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) } } -/* Check if a form matches the pattern (not= nil _) */ -static int janetc_check_notnil_form(Janet x, Janet *capture) { - if (!janet_checktype(x, JANET_TUPLE)) return 0; - JanetTuple tup = janet_unwrap_tuple(x); - if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0; - if (3 != janet_tuple_length(tup)) return 0; - JanetFunction *fun = janet_unwrap_function(tup[0]); - uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG; - if (tag != JANET_FUN_NEQ) return 0; - if (!janet_checktype(tup[1], JANET_NIL)) return 0; - *capture = tup[2]; - return 1; -} - /* * :whiletop * ... @@ -771,6 +793,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) JanetScope tempscope; int32_t labelwt, labeld, labeljt, labelc, i; int infinite = 0; + int is_nil_form = 0; int is_notnil_form = 0; uint8_t ifjmp = JOP_JUMP_IF; uint8_t ifnjmp = JOP_JUMP_IF_NOT; @@ -784,11 +807,16 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while"); - /* Check for `(not= nil _)` in condition, and if so, use the + /* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the * jmpnl or jmpnn instructions. This let's us implement `(each ...)` * more efficiently. */ Janet condform = argv[0]; - if (janetc_check_notnil_form(condform, &condform)) { + if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) { + is_nil_form = 1; + ifjmp = JOP_JUMP_IF_NIL; + ifnjmp = JOP_JUMP_IF_NOT_NIL; + } + if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) { is_notnil_form = 1; ifjmp = JOP_JUMP_IF_NOT_NIL; ifnjmp = JOP_JUMP_IF_NIL; @@ -800,7 +828,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) /* Check for constant condition */ if (cond.flags & JANET_SLOT_CONSTANT) { /* Loop never executes */ - int never_executes = is_notnil_form + int never_executes = is_nil_form + ? !janet_checktype(cond.constant, JANET_NIL) + : is_notnil_form ? janet_checktype(cond.constant, JANET_NIL) : !janet_truthy(cond.constant); if (never_executes) { diff --git a/src/core/state.c b/src/core/state.c index eab0b710..4c976dad 100644 --- a/src/core/state.c +++ b/src/core/state.c @@ -24,6 +24,7 @@ #include "features.h" #include #include "state.h" +#include "util.h" #endif JANET_THREAD_LOCAL JanetVM janet_vm; @@ -57,5 +58,18 @@ void janet_vm_load(JanetVM *from) { * use NULL to interrupt the current VM when convenient */ void janet_interpreter_interrupt(JanetVM *vm) { vm = vm ? vm : &janet_vm; - vm->auto_suspend = 1; +#ifdef JANET_WINDOWS + InterlockedIncrement(&vm->auto_suspend); +#else + __atomic_add_fetch(&vm->auto_suspend, 1, __ATOMIC_RELAXED); +#endif +} + +void janet_interpreter_interrupt_handled(JanetVM *vm) { + vm = vm ? vm : &janet_vm; +#ifdef JANET_WINDOWS + InterlockedDecrement(&vm->auto_suspend); +#else + __atomic_add_fetch(&vm->auto_suspend, -1, __ATOMIC_RELAXED); +#endif } diff --git a/src/core/state.h b/src/core/state.h index c7b3534b..a4312768 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -89,7 +89,7 @@ struct JanetVM { /* If this flag is true, suspend on function calls and backwards jumps. * When this occurs, this flag will be reset to 0. */ - volatile int auto_suspend; + volatile int32_t auto_suspend; /* The current running fiber on the current thread. * Set and unset by functions in vm.c */ diff --git a/src/core/vm.c b/src/core/vm.c index 7c2fc47d..6645cfb5 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -116,7 +116,6 @@ #else #define vm_maybe_auto_suspend(COND) do { \ if ((COND) && janet_vm.auto_suspend) { \ - janet_vm.auto_suspend = 0; \ fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \ vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \ } \ diff --git a/src/include/janet.h b/src/include/janet.h index 1ca534ce..37717351 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1388,6 +1388,7 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags); JANET_API void janet_schedule(JanetFiber *fiber, Janet value); JANET_API void janet_cancel(JanetFiber *fiber, Janet value); JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig); +JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig); /* Start a state machine listening for events from a stream */ JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user); @@ -1799,6 +1800,7 @@ JANET_API void janet_vm_free(JanetVM *vm); JANET_API void janet_vm_save(JanetVM *into); JANET_API void janet_vm_load(JanetVM *from); JANET_API void janet_interpreter_interrupt(JanetVM *vm); +JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm); JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out); JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig); JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f); diff --git a/test/suite-boot.janet b/test/suite-boot.janet index bc68fcb7..49f5ee03 100644 --- a/test/suite-boot.janet +++ b/test/suite-boot.janet @@ -204,6 +204,12 @@ (assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to") +# one-term :range forms +(assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x)) + "one-term :range") +(assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x)) + "one-term :down") + # 7880d7320 (def res @{}) (loop [[k v] :pairs @{1 2 3 4 5 6}] diff --git a/test/suite-corelib.janet b/test/suite-corelib.janet index 5107c555..e6fe0fea 100644 --- a/test/suite-corelib.janet +++ b/test/suite-corelib.janet @@ -172,5 +172,10 @@ (assert (= (length (range -10)) 0) "(range -10)") (assert (= (length (range 1 10)) 9) "(range 1 10)") +# iterating over generator +(assert-no-error "iterate over coro 1" (values (generate [x :range [0 10]] x))) +(assert-no-error "iterate over coro 2" (keys (generate [x :range [0 10]] x))) +(assert-no-error "iterate over coro 3" (pairs (generate [x :range [0 10]] x))) + (end-suite)