1
0
mirror of https://github.com/janet-lang/janet synced 2024-06-16 02:09:56 +00:00

Merge branch 'master' into compile-opt

This commit is contained in:
Calvin Rose 2023-08-20 13:08:56 -05:00
commit 5f5e5cf693
13 changed files with 267 additions and 69 deletions

10
examples/sigaction.janet Normal file
View File

@ -0,0 +1,10 @@
(defn action []
(print "Handled SIGHUP!")
(flush))
(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)
(forever))

View File

@ -436,8 +436,8 @@
:each ~(,in ,ds ,k)
:keys k
:pairs ~[,k (,in ,ds ,k)]))
,;body
(set ,k (,next ,ds ,k))))))
(set ,k (,next ,ds ,k))
,;body))))
(defn- iterate-template
[binding expr body]
@ -805,21 +805,31 @@
###
###
(defn- median-of-three [a b c]
(if (not= (> a b) (> a c))
a
(if (not= (> b a) (> b c)) b c)))
(defmacro- median-of-three
[x y z]
~(if (<= ,x ,y)
(if (<= ,y ,z) ,y (if (<= ,z ,x) ,x ,z))
(if (<= ,z ,y) ,y (if (<= ,x ,z) ,x ,z))))
(defmacro- sort-partition-template
[ind before? left right pivot]
~(do
(while (,before? (in ,ind ,left) ,pivot) (++ ,left))
(while (,before? ,pivot (in ,ind ,right)) (-- ,right))))
(defn- sort-help [a lo hi before?]
(when (< lo hi)
(def pivot
(median-of-three (in a hi) (in a lo)
(in a (math/floor (/ (+ lo hi) 2)))))
(def [x y z] [(in a lo)
(in a (div (+ lo hi) 2))
(in a hi)])
(def pivot (median-of-three x y z))
(var left lo)
(var right hi)
(while true
(while (before? (in a left) pivot) (++ left))
(while (before? pivot (in a right)) (-- right))
(case before?
< (sort-partition-template a < left right pivot)
> (sort-partition-template a > left right pivot)
(sort-partition-template a before? left right pivot))
(when (<= left right)
(def tmp (in a left))
(set (a left) (in a right))
@ -827,8 +837,10 @@
(++ left)
(-- right))
(if (>= left right) (break)))
(sort-help a lo right before?)
(sort-help a left hi before?))
(if (< lo right)
(sort-help a lo right before?))
(if (< left hi)
(sort-help a left hi before?)))
a)
(defn sort
@ -836,7 +848,8 @@
If a `before?` comparator function is provided, sorts elements using that,
otherwise uses `<`.``
[ind &opt before?]
(sort-help ind 0 (- (length ind) 1) (or before? <)))
(default before? <)
(sort-help ind 0 (- (length ind) 1) before?))
(defn sort-by
``Sorts `ind` in-place by calling a function `f` on each element and
@ -1411,20 +1424,21 @@
(fn [& r] (f ;more ;r))))
(defn every?
``Returns true if each value in `ind` is truthy, otherwise returns the first
falsey value.``
``Evaluates to the last element of `ind` if all preceding elements are truthy,
otherwise evaluates to the first falsey argument.``
[ind]
(var res true)
(loop [x :in ind :while res]
(if x nil (set res x)))
(set res x))
res)
(defn any?
``Returns the first truthy value in `ind`, otherwise nil.``
``Evaluates to the last element of `ind` if all preceding elements are falsey,
otherwise evaluates to the first truthy element.``
[ind]
(var res nil)
(loop [x :in ind :until res]
(if x (set res x)))
(set res x))
res)
(defn reverse!

View File

@ -221,6 +221,20 @@ JANET_CORE_FN(cfun_buffer_new_filled,
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_frombytes,
"(buffer/from-bytes & byte-vals)",
"Creates a buffer from integer parameters with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.") {
int32_t i;
JanetBuffer *buffer = janet_buffer(argc);
for (i = 0; i < argc; i++) {
int32_t c = janet_getinteger(argv, i);
buffer->data[i] = c & 0xFF;
}
buffer->count = argc;
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_fill,
"(buffer/fill buffer &opt byte)",
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
@ -509,6 +523,7 @@ void janet_lib_buffer(JanetTable *env) {
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),

View File

@ -741,6 +741,7 @@ static const SandboxOption sandbox_options[] = {
{"net-connect", JANET_SANDBOX_NET_CONNECT},
{"net-listen", JANET_SANDBOX_NET_LISTEN},
{"sandbox", JANET_SANDBOX_SANDBOX},
{"signal", JANET_SANDBOX_SIGNAL},
{"subprocess", JANET_SANDBOX_SUBPROCESS},
{NULL, 0}
};
@ -765,6 +766,7 @@ JANET_CORE_FN(janet_core_sandbox,
"* :net-connect - disallow making outbound network connections\n"
"* :net-listen - disallow accepting inbound network connections\n"
"* :sandbox - disallow calling this function\n"
"* :signal - disallow adding or removing signal handlers\n"
"* :subprocess - disallow running subprocesses") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {

View File

@ -562,6 +562,7 @@ void janet_ev_init_common(void) {
janet_vm.tq_capacity = 0;
janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
janet_table_init_raw(&janet_vm.active_tasks, 0);
janet_table_init_raw(&janet_vm.signal_handlers, 0);
janet_rng_seed(&janet_vm.ev_rng, 0);
#ifndef JANET_WINDOWS
pthread_attr_init(&janet_vm.new_thread_attr);
@ -577,6 +578,7 @@ void janet_ev_deinit_common(void) {
janet_vm.listeners = NULL;
janet_table_deinit(&janet_vm.threaded_abstracts);
janet_table_deinit(&janet_vm.active_tasks);
janet_table_deinit(&janet_vm.signal_handlers);
#ifndef JANET_WINDOWS
pthread_attr_destroy(&janet_vm.new_thread_attr);
#endif
@ -601,11 +603,19 @@ void janet_addtimeout(double sec) {
}
void janet_ev_inc_refcount(void) {
janet_vm.extra_listeners++;
#ifdef JANET_WINDOWS
InterlockedIncrement(&janet_vm.extra_listeners);
#else
__atomic_add_fetch(&janet_vm.extra_listeners, 1, __ATOMIC_RELAXED);
#endif
}
void janet_ev_dec_refcount(void) {
janet_vm.extra_listeners--;
#ifdef JANET_WINDOWS
InterlockedDecrement(&janet_vm.extra_listeners);
#else
__atomic_add_fetch(&janet_vm.extra_listeners, -1, __ATOMIC_RELAXED);
#endif
}
/* Channels */
@ -1224,6 +1234,7 @@ static Janet janet_chanat_next(void *p, Janet key) {
static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
JanetChannel *channel = (JanetChannel *)p;
janet_marshal_byte(ctx, channel->is_threaded);
janet_marshal_abstract(ctx, channel);
janet_marshal_byte(ctx, channel->closed);
janet_marshal_int(ctx, channel->limit);
@ -1243,7 +1254,13 @@ static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
}
static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
JanetChannel *abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
uint8_t is_threaded = janet_unmarshal_byte(ctx);
JanetChannel *abst;
if (is_threaded) {
abst = janet_unmarshal_abstract_threaded(ctx, sizeof(JanetChannel));
} else {
abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
}
uint8_t is_closed = janet_unmarshal_byte(ctx);
int32_t limit = janet_unmarshal_int(ctx);
int32_t count = janet_unmarshal_int(ctx);
@ -1283,6 +1300,33 @@ 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;
@ -1340,30 +1384,7 @@ JanetFiber *janet_loop1(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);
}
}
janet_loop1_poll();
/* No fiber was interrupted */
return NULL;
@ -1384,6 +1405,12 @@ 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

@ -1245,6 +1245,18 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
return p;
}
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
#ifdef JANET_THREADS
void *p = janet_abstract_threaded(ctx->at, size);
janet_unmarshal_abstract_reuse(ctx, p);
return p;
#else
(void) ctx;
(void) size;
janet_panic("threaded abstracts not supported");
#endif
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);

View File

@ -706,6 +706,18 @@ static const struct keyword_signal signal_keywords[] = {
#endif
{NULL, 0},
};
static int get_signal_kw(const Janet *argv, int32_t n) {
JanetKeyword signal_kw = janet_getkeyword(argv, n);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
return ptr->signal;
}
ptr++;
}
janet_panicf("undefined signal %v", argv[n]);
}
#endif
JANET_CORE_FN(os_proc_kill,
@ -731,18 +743,7 @@ JANET_CORE_FN(os_proc_kill,
#else
int signal = -1;
if (argc == 3) {
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
signal = ptr->signal;
break;
}
ptr++;
}
if (signal == -1) {
janet_panic("undefined signal");
}
signal = get_signal_kw(argv, 2);
}
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
if (status) {
@ -803,6 +804,102 @@ static void close_handle(JanetHandle handle) {
#endif
}
#ifdef JANET_EV
#ifndef JANET_WINDOWS
static void janet_signal_callback(JanetEVGenericMessage msg) {
int sig = msg.tag;
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 */
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_BLOCK, &set, NULL);
#else
sigprocmask(SIG_BLOCK, &set, NULL);
#endif
raise(sig);
return;
}
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();
}
}
static void janet_signal_trampoline_no_interrupt(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
}
static void janet_signal_trampoline(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
msg.argi = 1;
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.") {
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
janet_arity(argc, 1, 3);
#ifdef JANET_WINDOWS
janet_panic("unsupported on this platform");
#else
/* TODO - per thread signal masks */
int rc;
int sig = get_signal_kw(argv, 0);
JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL);
int can_interrupt = janet_optboolean(argv, argc, 2, 0);
Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(oldhandler, JANET_NIL)) {
janet_gcunroot(oldhandler);
}
if (NULL != handler) {
Janet handlerv = janet_wrap_function(handler);
janet_gcroot(handlerv);
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv);
} else {
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil());
}
struct sigaction action;
sigset_t mask;
sigfillset(&mask);
memset(&action, 0, sizeof(action));
if (can_interrupt) {
action.sa_handler = janet_signal_trampoline;
} else {
action.sa_handler = janet_signal_trampoline_no_interrupt;
}
action.sa_mask = mask;
RETRY_EINTR(rc, sigaction(sig, &action, NULL));
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_UNBLOCK, &set, NULL);
#else
sigprocmask(SIG_UNBLOCK, &set, NULL);
#endif
return janet_wrap_nil();
#endif
}
#endif
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
up by the calling function. If everything goes well, *handle is owned by the calling function,
@ -2536,6 +2633,7 @@ void janet_lib_os(JanetTable *env) {
#ifdef JANET_EV
JANET_CORE_REG("os/open", os_open), /* fs read and write */
JANET_CORE_REG("os/pipe", os_pipe),
JANET_CORE_REG("os/sigaction", os_sigaction),
#endif
#endif
JANET_REG_END

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. */
int auto_suspend;
volatile int auto_suspend;
/* The current running fiber on the current thread.
* Set and unset by functions in vm.c */
@ -157,9 +157,10 @@ struct JanetVM {
JanetListenerState **listeners;
size_t listener_count;
size_t listener_cap;
size_t extra_listeners;
volatile size_t extra_listeners; /* used in signal handler, must be volatile */
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
JanetTable signal_handlers;
#ifdef JANET_WINDOWS
void **iocp;
#elif defined(JANET_EV_EPOLL)

View File

@ -800,13 +800,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_JUMP)
pc += DS;
vm_maybe_auto_suspend(DS < 0);
vm_maybe_auto_suspend(DS <= 0);
vm_next();
VM_OP(JOP_JUMP_IF)
if (janet_truthy(stack[A])) {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
} else {
pc++;
}
@ -817,14 +817,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
}
vm_next();
VM_OP(JOP_JUMP_IF_NIL)
if (janet_checktype(stack[A], JANET_NIL)) {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
} else {
pc++;
}
@ -835,7 +835,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
}
vm_next();

View File

@ -1822,6 +1822,7 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FS_TEMP 1024
#define JANET_SANDBOX_FFI_USE 2048
#define JANET_SANDBOX_FFI_JIT 4096
#define JANET_SANDBOX_SIGNAL 8192
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
@ -2072,6 +2073,7 @@ JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);

View File

@ -113,13 +113,22 @@
# 7478ad11
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= nil (any? [nil false])) "any? 3")
(assert (= false (any? [nil false])) "any? 3")
(assert (= 1 (any? [1])) "any? 4")
(assert (nan? (any? [nil math/nan nil])) "any? 5")
(assert (= true
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
"any? 6")
(assert (= true (every? [])) "every? 1")
(assert (= true (every? [1 true])) "every? 2")
(assert (= 1 (every? [true 1])) "every? 3")
(assert (= nil (every? [nil])) "every? 4")
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
(assert (= false
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
"every? 6")
# Some higher order functions and macros
# 5e2de33
(def my-array @[1 2 3 4 5 6])

View File

@ -77,6 +77,14 @@
(buffer/push-string b5 "456" @"789")
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
# Buffer from bytes
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
(assert (deep= @"0123456789" (buffer/from-bytes ;(range 48 58))) "buffer/from-bytes 3")
(assert (= 0 (length (buffer/from-bytes))) "buffer/from-bytes 4")
(assert (= 5 (length (buffer/from-bytes ;(range 5)))) "buffer/from-bytes 5")
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/from-bytes :abc))
# some tests for buffer/format
# 029394d
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142")
@ -114,8 +122,5 @@
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
"buffer/push-at 3")
# 4782a76
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
(end-suite)

View File

@ -292,5 +292,8 @@
[2 6 4 'z]])
"arg & inner symbolmap")
# 4782a76
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
(end-suite)