From 6e8979336d879df0fa0c5883716f94371aa8d340 Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Mon, 21 Aug 2023 12:50:53 +0700 Subject: [PATCH 01/13] speed up `min`, `max` --- src/boot/boot.janet | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 2a27ea08..7e877e21 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -702,30 +702,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." From d9605c2856d1b4bc45fffc2b0e496fa9ca95970b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 22 Aug 2023 19:24:44 -0500 Subject: [PATCH 02/13] Allow iterating over generators with pairs, keys, and values. --- examples/sigaction.janet | 7 ++++--- src/boot/boot.janet | 6 +++--- test/suite-corelib.janet | 5 +++++ 3 files changed, 12 insertions(+), 6 deletions(-) diff --git a/examples/sigaction.janet b/examples/sigaction.janet index 5887ffad..9267baa9 100644 --- a/examples/sigaction.janet +++ b/examples/sigaction.janet @@ -1,10 +1,11 @@ (defn action [] - (print "Handled SIGHUP!") - (flush)) + (print "cleanup") + (os/exit 1)) (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) + (os/sigaction :term action true) + (os/sigaction :int action true) (forever)) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 7e877e21..e32f8aec 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1584,7 +1584,7 @@ (defn keys "Get the keys of an associative data structure." [x] - (def arr (array/new-filled (length x))) + (def arr @[]) (var i 0) (eachk k x (put arr i k) @@ -1594,7 +1594,7 @@ (defn values "Get the values of an associative data structure." [x] - (def arr (array/new-filled (length x))) + (def arr @[]) (var i 0) (each v x (put arr i v) @@ -1604,7 +1604,7 @@ (defn pairs "Get the key-value pairs of an associative data structure." [x] - (def arr (array/new-filled (length x))) + (def arr @[]) (var i 0) (eachp p x (put arr i p) 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) From 21eab7e9ccbb6b18d7f5ca018f84810ad0431f81 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 23 Aug 2023 09:16:59 -0500 Subject: [PATCH 03/13] Update sigaction to help address #1262. Update example to have 4 cases - case 3 was previously broken but should now work. --- examples/sigaction.janet | 44 +++++++++++++++++++++++++++++++++------- src/core/os.c | 1 + 2 files changed, 38 insertions(+), 7 deletions(-) diff --git a/examples/sigaction.janet b/examples/sigaction.janet index 9267baa9..36c59a7c 100644 --- a/examples/sigaction.janet +++ b/examples/sigaction.janet @@ -1,11 +1,41 @@ -(defn action [] - (print "cleanup") +### +### Usage: janet examples/sigaction.janet 1|2|3|4 & +### +### Then at shell: kill -s SIGTERM $! +### + +(defn action + [] + (print "Handled SIGTERM!") + (flush) (os/exit 1)) -(defn main [_] - # Set the interrupt-interpreter argument to `true` to allow - # interrupting the busy loop `(forever)`. By default, will not - # interrupt the interpreter. +(defn main1 + [] (os/sigaction :term action true) - (os/sigaction :int 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/src/core/os.c b/src/core/os.c index 1f1cad35..2d0d7803 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -827,6 +827,7 @@ static void janet_signal_callback(JanetEVGenericMessage msg) { JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL); janet_schedule(fiber, janet_wrap_nil()); if (msg.argi) { + janet_vm.auto_suspend = 0; /* Undo interrupt if it wasn't needed. */ janet_ev_dec_refcount(); } } From 35a8d2a519eaa64473f15f5f69314e78b19b1728 Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Wed, 23 Aug 2023 16:01:16 +0700 Subject: [PATCH 04/13] Optimize nil conditions for while and if --- src/core/specials.c | 74 +++++++++++++++++++++++++++++++-------------- 1 file changed, 52 insertions(+), 22 deletions(-) diff --git a/src/core/specials.c b/src/core/specials.c index d4da602e..dd3b782d 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,9 +828,11 @@ 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 - ? janet_checktype(cond.constant, JANET_NIL) - : !janet_truthy(cond.constant); + 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) { janetc_popscope(c); return janetc_cslot(janet_wrap_nil()); From ffd79c6097d07f9cd0c3abe0d23daa1a9549b94b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 23 Aug 2023 20:14:38 -0500 Subject: [PATCH 05/13] Allow multiple simultaneous interrupts cleanly for #1262 Instead of setting a flag, each interrupt increments an atomic counter. When the interrupt is finally handled, either by scheduling code to run on the event loop or executing some out of band code, the user must now decrement the interrupt counter with janet_interpreter_interrupt_handled. While this counter is non-zero, the event loop will not enter the interpreter. This changes the API a bit but makes it possible and easy to handle signals without race conditions or scheduler hacks, as the runtime can ensure that high priority code is run before re-entering possibly blocking interpreter code again. Also included is a new function janet_schedule_soon, which prepends to the task queue instead of appending, allowing interrupt handler to skip ahead of all other scheduled fibers. Lastly, also update meson default options to include the interpreter_interrupt code and raise a runtime error if os/sigaction is used with interpreter interrupt but that build option is not enabled. --- meson_options.txt | 2 +- src/core/ev.c | 159 +++++++++++++++++++++++++------------------- src/core/os.c | 15 +++-- src/core/state.c | 16 ++++- src/core/state.h | 2 +- src/core/vm.c | 1 - src/include/janet.h | 2 + 7 files changed, 117 insertions(+), 80 deletions(-) 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/core/ev.c b/src/core/ev.c index 5f999764..38fc42e1 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) { @@ -1300,7 +1328,64 @@ int janet_loop_done(void) { janet_vm.extra_listeners); } -static void janet_loop1_poll(void) { +JanetFiber *janet_loop1(void) { + /* Schedule expired timers */ + JanetTimeout to; + JanetTimestamp now = ts_now(); + while (peek_timeout(&to) && to.when <= now) { + pop_timeout(0); + if (to.curr_fiber != NULL) { + if (janet_fiber_can_resume(to.curr_fiber)) { + janet_cancel(to.fiber, janet_cstringv("deadline expired")); + } + } else { + /* This is a timeout (for a function call, not a whole fiber) */ + if (to.fiber->sched_id == to.sched_id) { + if (to.is_error) { + janet_cancel(to.fiber, janet_cstringv("timeout")); + } else { + janet_schedule(to.fiber, janet_wrap_nil()); + } + } + } + } + + /* 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(); + task.fiber->gc.flags &= ~(JANET_FIBER_EV_FLAG_CANCELED | JANET_FIBER_EV_FLAG_SUSPENDED); + if (task.expected_sched_id != task.fiber->sched_id) continue; + Janet res; + JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig); + if (!janet_fiber_can_resume(task.fiber)) { + janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(task.fiber)); + } + void *sv = task.fiber->supervisor_channel; + int is_suspended = sig == JANET_SIGNAL_EVENT || sig == JANET_SIGNAL_YIELD || sig == JANET_SIGNAL_INTERRUPT; + if (is_suspended) { + task.fiber->gc.flags |= JANET_FIBER_EV_FLAG_SUSPENDED; + janet_ev_inc_refcount(); + } + if (NULL == sv) { + if (!is_suspended) { + janet_stacktrace_ext(task.fiber, res, ""); + } + } else if (sig == JANET_SIGNAL_OK || (task.fiber->flags & (1 << sig))) { + JanetChannel *chan = janet_channel_unwrap(sv); + janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig], + task.fiber, chan->is_threaded), 2); + } else if (!is_suspended) { + janet_stacktrace_ext(task.fiber, res, ""); + } + if (sig == JANET_SIGNAL_INTERRUPT) { + return task.fiber; + } + } + /* Poll for events */ if (janet_vm.listener_count || janet_vm.tq_count || janet_vm.extra_listeners) { JanetTimeout to; @@ -1325,66 +1410,6 @@ static void janet_loop1_poll(void) { janet_loop1_impl(has_timeout, to.when); } } -} - -JanetFiber *janet_loop1(void) { - /* Schedule expired timers */ - JanetTimeout to; - JanetTimestamp now = ts_now(); - while (peek_timeout(&to) && to.when <= now) { - pop_timeout(0); - if (to.curr_fiber != NULL) { - if (janet_fiber_can_resume(to.curr_fiber)) { - janet_cancel(to.fiber, janet_cstringv("deadline expired")); - } - } else { - /* This is a timeout (for a function call, not a whole fiber) */ - if (to.fiber->sched_id == to.sched_id) { - if (to.is_error) { - janet_cancel(to.fiber, janet_cstringv("timeout")); - } else { - janet_schedule(to.fiber, janet_wrap_nil()); - } - } - } - } - - /* Run scheduled fibers */ - while (janet_vm.spawn.head != janet_vm.spawn.tail) { - 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(); - task.fiber->gc.flags &= ~(JANET_FIBER_EV_FLAG_CANCELED | JANET_FIBER_EV_FLAG_SUSPENDED); - if (task.expected_sched_id != task.fiber->sched_id) continue; - Janet res; - JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig); - if (!janet_fiber_can_resume(task.fiber)) { - janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(task.fiber)); - } - void *sv = task.fiber->supervisor_channel; - int is_suspended = sig == JANET_SIGNAL_EVENT || sig == JANET_SIGNAL_YIELD || sig == JANET_SIGNAL_INTERRUPT; - if (is_suspended) { - task.fiber->gc.flags |= JANET_FIBER_EV_FLAG_SUSPENDED; - janet_ev_inc_refcount(); - } - if (NULL == sv) { - if (!is_suspended) { - janet_stacktrace_ext(task.fiber, res, ""); - } - } else if (sig == JANET_SIGNAL_OK || (task.fiber->flags & (1 << sig))) { - JanetChannel *chan = janet_channel_unwrap(sv); - janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig], - task.fiber, chan->is_threaded), 2); - } else if (!is_suspended) { - janet_stacktrace_ext(task.fiber, res, ""); - } - if (sig == JANET_SIGNAL_INTERRUPT) { - /* On interrupts, return the interrupted fiber immediately */ - return task.fiber; - } - } - - janet_loop1_poll(); /* No fiber was interrupted */ return NULL; @@ -1405,12 +1430,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 2d0d7803..3038ab79 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,11 +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_vm.auto_suspend = 0; /* Undo interrupt if it wasn't needed. */ - 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) { @@ -838,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) { @@ -846,9 +845,9 @@ 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 @@ -881,7 +880,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/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); From 4ecadfabf42b380ea8f154990a91711c989ab629 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 24 Aug 2023 08:00:26 -0500 Subject: [PATCH 06/13] Fix atomics - warnings on windows --- src/core/ev.c | 10 +++++++++- src/core/os.c | 1 + 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/src/core/ev.c b/src/core/ev.c index 38fc42e1..f2edb205 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -632,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 @@ -640,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 @@ -1377,7 +1385,7 @@ JanetFiber *janet_loop1(void) { } else if (sig == JANET_SIGNAL_OK || (task.fiber->flags & (1 << sig))) { JanetChannel *chan = janet_channel_unwrap(sv); janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig], - task.fiber, chan->is_threaded), 2); + task.fiber, chan->is_threaded), 2); } else if (!is_suspended) { janet_stacktrace_ext(task.fiber, res, ""); } diff --git a/src/core/os.c b/src/core/os.c index 3038ab79..1fcd2102 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -857,6 +857,7 @@ JANET_CORE_FN(os_sigaction, 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 */ From 33d1371186aa8e6d69a65940be14550e842c2d88 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 25 Aug 2023 16:28:41 -0500 Subject: [PATCH 07/13] Update specials.c for formatting. --- src/core/specials.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/specials.c b/src/core/specials.c index dd3b782d..c19c728b 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -831,8 +831,8 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) 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); + ? janet_checktype(cond.constant, JANET_NIL) + : !janet_truthy(cond.constant); if (never_executes) { janetc_popscope(c); return janetc_cslot(janet_wrap_nil()); From 874fd2aba7af3d8402704c4052a964a7767db76b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 27 Aug 2023 13:09:22 -0500 Subject: [PATCH 08/13] don't crash repl if someone sets a bad *pretty-format* --- src/boot/boot.janet | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index e32f8aec..c000f87f 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2877,7 +2877,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 "") From 2f43cb843e15e7a1fccb042886a33f017b805846 Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Mon, 28 Aug 2023 15:43:32 +0700 Subject: [PATCH 09/13] Allow one-term `:range` and `:down` forms --- src/boot/boot.janet | 14 ++++++++------ test/suite-boot.janet | 6 ++++++ 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index c000f87f..012c3fb4 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]) 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}] From f969fb69e16f08029c20c5758aa1f852ca35e988 Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Fri, 1 Sep 2023 13:04:53 +0700 Subject: [PATCH 10/13] add `lengthable?` --- src/core/corelib.c | 8 ++++++++ 1 file changed, 8 insertions(+) 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), From 645109048babcdcbf8081a0e77a1f47bf595333d Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Fri, 1 Sep 2023 13:18:31 +0700 Subject: [PATCH 11/13] update `keys`, `values`, `pairs` --- src/boot/boot.janet | 45 +++++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 012c3fb4..6eb4a9f9 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1586,32 +1586,41 @@ (defn keys "Get the keys of an associative data structure." [x] - (def arr @[]) - (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 @[]) - (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 @[]) - (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." From 4cb1f616c5520a52e3cc3c434ece14e16761902c Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Fri, 1 Sep 2023 15:20:33 +0700 Subject: [PATCH 12/13] allow `reverse` on non-lengthable --- src/boot/boot.janet | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 6eb4a9f9..b198949f 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1435,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] @@ -1455,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 From 61791e4a4cdab8ed6a30746f6118724dacc94148 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 3 Sep 2023 10:18:37 -0500 Subject: [PATCH 13/13] Update docstring. --- src/core/os.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index 1fcd2102..bc82bf46 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -853,7 +853,8 @@ static void janet_signal_trampoline(int sig) { 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