mirror of
https://github.com/janet-lang/janet
synced 2024-11-06 00:36:17 +00:00
Merge branch 'master' into compile-opt
This commit is contained in:
Calvin Rose
commit
9b9f67c371
@ -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")))
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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 "")
|
||||
|
||||
@ -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),
|
||||
|
||||
105
src/core/ev.c
105
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());
|
||||
}
|
||||
}
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
@ -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) {
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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 */
|
||||
|
||||
@ -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()); \
|
||||
} \
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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}]
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user