1
0
mirror of https://github.com/janet-lang/janet synced 2024-06-15 18:00:01 +00:00

Merge branch 'master' into compile-opt

This commit is contained in:
Calvin Rose 2023-09-03 10:18:54 -05:00
commit 9b9f67c371
13 changed files with 281 additions and 128 deletions

View File

@ -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")))

View File

@ -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)

View File

@ -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 "")

View File

@ -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),

View File

@ -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());
}
}

View File

@ -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;
}

View File

@ -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) {

View File

@ -24,6 +24,7 @@
#include "features.h"
#include <janet.h>
#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
}

View File

@ -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 */

View File

@ -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()); \
} \

View File

@ -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);

View File

@ -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}]

View File

@ -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)