From 12cfda1f584576a0e54b82e710a54b5ef66e6dbe Mon Sep 17 00:00:00 2001 From: Andrew Owen Date: Sun, 11 Jul 2021 03:21:55 -0600 Subject: [PATCH 01/12] Add TerminateProcess to janet_proc_gc and os_proc_kill on Windows --- src/core/os.c | 2 ++ test/suite0009.janet | 5 +++++ 2 files changed, 7 insertions(+) diff --git a/src/core/os.c b/src/core/os.c index 4531bec9..1f519202 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -434,6 +434,7 @@ static int janet_proc_gc(void *p, size_t s) { JanetProc *proc = (JanetProc *) p; #ifdef JANET_WINDOWS if (!(proc->flags & JANET_PROC_CLOSED)) { + TerminateProcess(proc->pHandle, 1); CloseHandle(proc->pHandle); CloseHandle(proc->tHandle); } @@ -519,6 +520,7 @@ static Janet os_proc_kill(int32_t argc, Janet *argv) { janet_panicf("cannot close process handle that is already closed"); } proc->flags |= JANET_PROC_CLOSED; + TerminateProcess(proc->pHandle, 1); CloseHandle(proc->pHandle); CloseHandle(proc->tHandle); #else diff --git a/test/suite0009.janet b/test/suite0009.janet index 2b744a73..965a71a7 100644 --- a/test/suite0009.janet +++ b/test/suite0009.janet @@ -47,6 +47,11 @@ (assert-no-error "pipe stdin to process 2" (os/proc-wait p)) (assert (= "hello!" (string/trim x)) "round trip pipeline in process")) +(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)] + (os/proc-kill p) + (def retval (os/proc-wait p)) + (assert (not= retval 24) "Process was *not* terminated by parent")) + # Parallel subprocesses (defn calc-1 From e8a86013dab4334e2f572fdaee8c4ab781db9bdd Mon Sep 17 00:00:00 2001 From: Andrew Owen Date: Sat, 24 Jul 2021 02:30:00 -0600 Subject: [PATCH 02/12] Add fixes for :write on filestreams that come from os/open --- src/core/ev.c | 10 ++++++++++ test/suite0009.janet | 12 ++++++++++++ 2 files changed, 22 insertions(+) diff --git a/src/core/ev.c b/src/core/ev.c index ccd65010..298aad8a 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -1838,6 +1838,16 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event) } else #endif { + // File handles in IOCP need to specify this if they are writing to the + // ends of files, like how this is used here. + // If the underlying resource doesn't support seeking + // byte offsets, they will be ignored + // but this otherwise writes to the end of the file in question + // Right now, os/open streams aren't seekable, so this works. + // for more details see the lpOverlapped parameter in + // https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile + state->overlapped.Offset = (DWORD) 0xFFFFFFFF; + state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF; status = WriteFile(s->stream->handle, bytes, len, NULL, &state->overlapped); if (!status && (ERROR_IO_PENDING != WSAGetLastError())) { janet_cancel(s->fiber, janet_ev_lasterr()); diff --git a/test/suite0009.janet b/test/suite0009.janet index 965a71a7..fdbe1b81 100644 --- a/test/suite0009.janet +++ b/test/suite0009.janet @@ -105,6 +105,18 @@ (file/close outfile) (os/rm "unique.txt")) +# Ensure that the stream created by os/open works + +(assert-no-error "File writing 4.1" + (def outstream (os/open "unique.txt" :wct)) + (defer (:close outstream) + (:write outstream "123\n") + (:write outstream "456\n")) + # Cast to string to enable comparison + (assert (= "123\n456\n" (string (slurp "unique.txt"))) "File writing 4.2") + (os/rm "unique.txt")) + + # ev/gather (assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1") From 202783c67aed224e76c6eeb1ca9488e3b47f56f6 Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sat, 24 Jul 2021 11:55:04 -0500 Subject: [PATCH 03/12] Add :d switch to os/spawn. This allows for starting processes that can be turned into zombies. --- src/core/ev.c | 18 ++++++++++-------- src/core/os.c | 21 +++++++++++++-------- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/core/ev.c b/src/core/ev.c index 13138809..81d28b56 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -1808,14 +1808,16 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event) } else #endif { - // File handles in IOCP need to specify this if they are writing to the - // ends of files, like how this is used here. - // If the underlying resource doesn't support seeking - // byte offsets, they will be ignored - // but this otherwise writes to the end of the file in question - // Right now, os/open streams aren't seekable, so this works. - // for more details see the lpOverlapped parameter in - // https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile + /* + * File handles in IOCP need to specify this if they are writing to the + * ends of files, like how this is used here. + * If the underlying resource doesn't support seeking + * byte offsets, they will be ignored + * but this otherwise writes to the end of the file in question + * Right now, os/open streams aren't seekable, so this works. + * for more details see the lpOverlapped parameter in + * https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile + */ state->overlapped.Offset = (DWORD) 0xFFFFFFFF; state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF; status = WriteFile(s->stream->handle, bytes, len, NULL, &state->overlapped); diff --git a/src/core/os.c b/src/core/os.c index 1f519202..fcd2c279 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -353,6 +353,7 @@ static const JanetAbstractType ProcAT; #define JANET_PROC_OWNS_STDIN 16 #define JANET_PROC_OWNS_STDOUT 32 #define JANET_PROC_OWNS_STDERR 64 +#define JANET_PROC_ALLOW_ZOMBIE 128 typedef struct { int flags; #ifdef JANET_WINDOWS @@ -434,12 +435,14 @@ static int janet_proc_gc(void *p, size_t s) { JanetProc *proc = (JanetProc *) p; #ifdef JANET_WINDOWS if (!(proc->flags & JANET_PROC_CLOSED)) { - TerminateProcess(proc->pHandle, 1); + if (!(proc->flags & JANET_PROC_ALLOW_ZOMBIE)) { + TerminateProcess(proc->pHandle, 1); + } CloseHandle(proc->pHandle); CloseHandle(proc->tHandle); } #else - if (!(proc->flags & JANET_PROC_WAITED)) { + if (!(proc->flags & (JANET_PROC_WAITED | JANET_PROC_ALLOW_ZOMBIE))) { /* Kill and wait to prevent zombies */ kill(proc->pid, SIGKILL); int status; @@ -759,7 +762,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { /* Get flags */ uint64_t flags = 0; if (argc > 1) { - flags = janet_getflags(argv, 1, "epx"); + flags = janet_getflags(argv, 1, "epxd"); } /* Get environment */ @@ -777,7 +780,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) { JanetHandle new_in = JANET_HANDLE_NONE, new_out = JANET_HANDLE_NONE, new_err = JANET_HANDLE_NONE; JanetHandle pipe_in = JANET_HANDLE_NONE, pipe_out = JANET_HANDLE_NONE, pipe_err = JANET_HANDLE_NONE; int pipe_errflag = 0; /* Track errors setting up pipes */ - int pipe_owner_flags = 0; + int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0; /* Get optional redirections */ if (argc > 2) { @@ -1842,6 +1845,7 @@ static Janet os_open(int32_t argc, Janet *argv) { case 'W': shareMode |= FILE_SHARE_WRITE; break; + gg case 'H': flagsAndAttributes |= FILE_ATTRIBUTE_HIDDEN; break; @@ -2094,12 +2098,13 @@ static const JanetReg os_cfuns[] = { "os/execute", os_execute, JDOC("(os/execute args &opt flags env)\n\n" "Execute a program on the system and pass it string arguments. `flags` " - "is a keyword that modifies how the program will execute.\n\n" + "is a keyword that modifies how the program will execute.\n" "* :e - enables passing an environment to the program. Without :e, the " - "current environment is inherited.\n\n" + "current environment is inherited.\n" "* :p - allows searching the current PATH for the binary to execute. " - "Without this flag, binaries must use absolute paths.\n\n" - "* :x - raise error if exit code is non-zero.\n\n" + "Without this flag, binaries must use absolute paths.\n" + "* :x - raise error if exit code is non-zero.\n" + "* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n" "`env` is a table or struct mapping environment variables to values. It can also " "contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. " "These arguments should be core/file values. " From aafc595e3a3965055e438746fc5885b3603793fe Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sat, 24 Jul 2021 12:47:51 -0500 Subject: [PATCH 04/12] Fix typo. --- src/core/os.c | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index fcd2c279..2bd7f3ed 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1845,7 +1845,6 @@ static Janet os_open(int32_t argc, Janet *argv) { case 'W': shareMode |= FILE_SHARE_WRITE; break; - gg case 'H': flagsAndAttributes |= FILE_ATTRIBUTE_HIDDEN; break; From 160dd830a0a3b3fa2adae7fa22e13088d0e9b540 Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sat, 24 Jul 2021 15:14:37 -0500 Subject: [PATCH 05/12] Add janet_interpreter_interrupt for custom scheduling. This would allow an embedder to suspend the current Janet fiber via an external event like a signal, other thread, or really anything. This is a useful primitive for custom schedulers that would call janet_interpreter_interupt periodically (say, in an interval with SIG_ALRM), do some work, and then use janet_continue on the janet_root_fiber, or for embedding into other soft-realtime applications like a game. To say, only allow about 5ms per frame of interpreter time. --- meson.build | 1 + meson_options.txt | 1 + src/conf/janetconf.h | 1 + src/core/state.c | 15 +++++++++++++++ src/core/state.h | 4 ++++ src/core/vm.c | 22 ++++++++++++++++++++++ src/include/janet.h | 2 ++ 7 files changed, 46 insertions(+) diff --git a/meson.build b/meson.build index 30888bd8..772d0c99 100644 --- a/meson.build +++ b/meson.build @@ -74,6 +74,7 @@ conf.set('JANET_NO_PROCESSES', not get_option('processes')) conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline')) conf.set('JANET_EV_NO_EPOLL', not get_option('epoll')) conf.set('JANET_NO_THREADS', get_option('threads')) +conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt')) if get_option('os_name') != '' conf.set('JANET_OS_NAME', get_option('os_name')) endif diff --git a/meson_options.txt b/meson_options.txt index 7d1c0e01..9a2818e6 100644 --- a/meson_options.txt +++ b/meson_options.txt @@ -18,6 +18,7 @@ option('umask', type : 'boolean', value : true) option('realpath', type : 'boolean', value : true) option('simple_getline', type : 'boolean', value : false) option('epoll', type : 'boolean', value : false) +option('interpreter_interrupt', type : 'boolean', value : false) option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024) option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200) diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index dfabc1cb..9beb8657 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -48,6 +48,7 @@ /* #define JANET_OS_NAME my-custom-os */ /* #define JANET_ARCH_NAME pdp-8 */ /* #define JANET_EV_NO_EPOLL */ +/* #define JANET_NO_INTERPRETER_INTERRUPT */ /* Custom vm allocator support */ /* #include */ diff --git a/src/core/state.c b/src/core/state.c index c2d4d4bd..027fa4a0 100644 --- a/src/core/state.c +++ b/src/core/state.c @@ -28,6 +28,10 @@ JANET_THREAD_LOCAL JanetVM janet_vm; +JanetVM *janet_local_vm(void) { + return &janet_vm; +} + JanetVM *janet_vm_alloc(void) { JanetVM *mem = janet_malloc(sizeof(JanetVM)); if (NULL == mem) { @@ -47,3 +51,14 @@ void janet_vm_save(JanetVM *into) { void janet_vm_load(JanetVM *from) { janet_vm = *from; } + +/* Trigger suspension of the Janet vm by trying to + * exit the interpeter loop when convenient. You can optionally + * use NULL to interrupt the current VM when convenient */ +void janet_interpreter_interrupt(JanetVM *vm) { + if (NULL == vm) { + janet_vm.auto_suspend = 1; + } else { + vm->auto_suspend = 1; + } +} diff --git a/src/core/state.h b/src/core/state.h index c048464f..9f0ab5f8 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -72,6 +72,10 @@ struct JanetVM { /* How many VM stacks have been entered */ int stackn; + /* 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; + /* The current running fiber on the current thread. * Set and unset by janet_run. */ JanetFiber *fiber; diff --git a/src/core/vm.c b/src/core/vm.c index f624b9e2..3a8db3ae 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -111,6 +111,17 @@ janet_panicf("expected %T, got %v", (TS), (X)); \ } \ } while (0) +#ifdef JANET_NO_INTERPRETER_INTERRUPT +#define vm_maybe_auto_suspend(COND) +#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_EVENT, janet_wrap_nil()); \ + } \ +} while (0) +#endif /* Templates for certain patterns in opcodes */ #define vm_binop_immediate(op)\ @@ -746,11 +757,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { VM_OP(JOP_JUMP) pc += DS; + 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); } else { pc++; } @@ -761,12 +774,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { pc++; } else { pc += ES; + 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); } else { pc++; } @@ -777,6 +792,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { pc++; } else { pc += ES; + vm_maybe_auto_suspend(ES < 0); } vm_next(); @@ -950,6 +966,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { vm_checkgc_pcnext(); VM_OP(JOP_CALL) { + vm_maybe_auto_suspend(1); Janet callee = stack[E]; if (fiber->stacktop > fiber->maxstack) { vm_throw("stack overflow"); @@ -989,6 +1006,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { } VM_OP(JOP_TAILCALL) { + vm_maybe_auto_suspend(1); Janet callee = stack[D]; if (fiber->stacktop > fiber->maxstack) { vm_throw("stack overflow"); @@ -1035,6 +1053,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { VM_OP(JOP_RESUME) { Janet retreg; + vm_maybe_auto_suspend(1); vm_assert_type(stack[B], JANET_FIBER); JanetFiber *child = janet_unwrap_fiber(stack[B]); if (janet_check_can_resume(child, &retreg)) { @@ -1519,6 +1538,9 @@ int janet_init(void) { /* Core env */ janet_vm.core_env = NULL; + /* Auto suspension */ + janet_vm.auto_suspend = 0; + /* Dynamic bindings */ janet_vm.top_dyns = NULL; diff --git a/src/include/janet.h b/src/include/janet.h index 7e68236e..61f0e7ad 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1660,9 +1660,11 @@ JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *i JANET_API int janet_init(void); JANET_API void janet_deinit(void); JANET_API JanetVM *janet_vm_alloc(void); +JANET_API JanetVM *janet_local_vm(void); 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 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 2769a62bb35c2d65b424ece92c6ded5b77f25b9b Mon Sep 17 00:00:00 2001 From: John Gabriele Date: Sat, 24 Jul 2021 16:58:21 -0400 Subject: [PATCH 06/12] Add some clarifying backticks to docs --- src/core/array.c | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/core/array.c b/src/core/array.c index 8e1e3f6b..c697fa97 100644 --- a/src/core/array.c +++ b/src/core/array.c @@ -307,12 +307,12 @@ static const JanetReg array_cfuns[] = { { "array/new-filled", cfun_array_new_filled, JDOC("(array/new-filled count &opt value)\n\n" - "Creates a new array of count elements, all set to value, which defaults to nil. Returns the new array.") + "Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") }, { "array/fill", cfun_array_fill, JDOC("(array/fill arr &opt value)\n\n" - "Replace all elements of an array with value (defaulting to nil) without changing the length of the array. " + "Replace all elements of an array with `value` (defaulting to nil) without changing the length of the array. " "Returns the modified array.") }, { @@ -334,7 +334,7 @@ static const JanetReg array_cfuns[] = { { "array/ensure", cfun_array_ensure, JDOC("(array/ensure arr capacity growth)\n\n" - "Ensures that the memory backing the array is large enough for capacity " + "Ensures that the memory backing the array is large enough for `capacity` " "items at the given rate of growth. Capacity and growth must be integers. " "If the backing capacity is already enough, then this function does nothing. " "Otherwise, the backing memory will be reallocated so that there is enough space.") @@ -342,34 +342,34 @@ static const JanetReg array_cfuns[] = { { "array/slice", cfun_array_slice, JDOC("(array/slice arrtup &opt start end)\n\n" - "Takes a slice of array or tuple from start to end. The range is half open, " - "[start, end). Indexes can also be negative, indicating indexing from the end of the " - "end of the array. By default, start is 0 and end is the length of the array. " - "Note that index -1 is synonymous with index (length arrtup) to allow a full " + "Takes a slice of array or tuple from `start` to `end`. The range is half open, " + "[start, end). Indexes can also be negative, indicating indexing from the " + "end of the array. By default, `start` is 0 and `end` is the length of the array. " + "Note that index -1 is synonymous with index `(length arrtup)` to allow a full " "negative slice range. Returns a new array.") }, { "array/concat", cfun_array_concat, JDOC("(array/concat arr & parts)\n\n" - "Concatenates a variable number of arrays (and tuples) into the first argument " + "Concatenates a variable number of arrays (and tuples) into the first argument, " "which must be an array. If any of the parts are arrays or tuples, their elements will " - "be inserted into the array. Otherwise, each part in parts will be appended to arr in order. " - "Return the modified array arr.") + "be inserted into the array. Otherwise, each part in `parts` will be appended to `arr` in order. " + "Return the modified array `arr`.") }, { "array/insert", cfun_array_insert, JDOC("(array/insert arr at & xs)\n\n" - "Insert all xs into array arr at index at. at should be an integer between " - "0 and the length of the array. A negative value for at will index backwards from " + "Insert all `xs` into array `arr` at index `at`. `at` should be an integer between " + "0 and the length of the array. A negative value for `at` will index backwards from " "the end of the array, such that inserting at -1 appends to the array. " "Returns the array.") }, { "array/remove", cfun_array_remove, JDOC("(array/remove arr at &opt n)\n\n" - "Remove up to n elements starting at index at in array arr. at can index from " - "the end of the array with a negative index, and n must be a non-negative integer. " - "By default, n is 1. " + "Remove up to `n` elements starting at index `at` in array `arr`. `at` can index from " + "the end of the array with a negative index, and `n` must be a non-negative integer. " + "By default, `n` is 1. " "Returns the array.") }, { From 76acbf9bb656b27ed21d4327d6e0a9b094211ce0 Mon Sep 17 00:00:00 2001 From: John Gabriele Date: Sat, 24 Jul 2021 18:44:49 -0400 Subject: [PATCH 07/12] Clarify docs on take and drop functions Pass in indexed and bytes, return tuples and strings, respectively. --- src/boot/boot.janet | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index d7e1bbe2..45377a5e 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1027,7 +1027,7 @@ ret) (defn take - "Take first n elements in an indexed type. Returns new indexed instance." + "Take the first n elements of an indexed or bytes type. Returns a new tuple or string, respectively." [n ind] (def use-str (bytes? ind)) (def f (if use-str string/slice tuple/slice)) @@ -1038,7 +1038,7 @@ (f ind 0 end)) (defn take-until - "Same as (take-while (complement pred) ind)." + "Same as `(take-while (complement pred) ind)`." [pred ind] (def use-str (bytes? ind)) (def f (if use-str string/slice tuple/slice)) @@ -1048,13 +1048,14 @@ (f ind 0 end)) (defn take-while - `Given a predicate, take only elements from an indexed type that satisfy - the predicate, and abort on first failure. Returns a new array.` + `Given a predicate, take only elements from an indexed or bytes type that satisfy + the predicate, and abort on first failure. Returns a new tuple or string, respectively.` [pred ind] (take-until (complement pred) ind)) (defn drop - "Drop first n elements in an indexed type. Returns new indexed instance." + ``Drop the first n elements in an indexed or bytes type. Returns a new tuple or string + instance, respectively.`` [n ind] (def use-str (bytes? ind)) (def f (if use-str string/slice tuple/slice)) @@ -1065,7 +1066,7 @@ (f ind start -1)) (defn drop-until - "Same as (drop-while (complement pred) ind)." + "Same as `(drop-while (complement pred) ind)`." [pred ind] (def use-str (bytes? ind)) (def f (if use-str string/slice tuple/slice)) @@ -1075,8 +1076,8 @@ (f ind start)) (defn drop-while - `Given a predicate, remove elements from an indexed type that satisfy - the predicate, and abort on first failure. Returns a new array.` + `Given a predicate, remove elements from an indexed or bytes type that satisfy + the predicate, and abort on first failure. Returns a new tuple or string, respectively.` [pred ind] (drop-until (complement pred) ind)) From 6f1695ecd4ad85562719288096a92ce32e43d6d4 Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sat, 24 Jul 2021 20:30:36 -0500 Subject: [PATCH 08/12] Add utitities for interrupting the event loop. janet_loop1_interrupt makes the event loop compatible with safe interruptions for custom scheduling. Does this by exposing custom events on the event loop. A custom event schedules a function pointer to run in a way that can interrupt epoll_wait/poll/GetQueuedCompletionStatus. --- src/core/ev.c | 115 ++++++++++++++++++++++++++++++++++---------- src/core/os.c | 1 + src/core/state.c | 7 +-- src/core/vm.c | 2 +- src/include/janet.h | 35 +++++++++++++- 5 files changed, 128 insertions(+), 32 deletions(-) diff --git a/src/core/ev.c b/src/core/ev.c index 81d28b56..ecc945ad 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -520,21 +520,6 @@ static Janet make_supervisor_event(const char *name, JanetFiber *fiber) { return janet_wrap_tuple(janet_tuple_n(tup, 2)); } -/* Run a top level task */ -static void run_one(JanetFiber *fiber, Janet value, JanetSignal sigin) { - fiber->flags &= ~JANET_FIBER_FLAG_SCHEDULED; - Janet res; - JanetSignal sig = janet_continue_signal(fiber, value, &res, sigin); - JanetChannel *chan = (JanetChannel *)(fiber->supervisor_channel); - if (NULL == chan) { - if (sig != JANET_SIGNAL_EVENT && sig != JANET_SIGNAL_YIELD) { - janet_stacktrace(fiber, res); - } - } else if (sig == JANET_SIGNAL_OK || (fiber->flags & (1 << sig))) { - janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig], fiber), 2); - } -} - /* Common init code */ void janet_ev_init_common(void) { janet_q_init(&janet_vm.spawn); @@ -864,7 +849,14 @@ static Janet janet_chanat_next(void *p, Janet key) { void janet_loop1_impl(int has_timeout, JanetTimestamp timeout); -void janet_loop1(void) { +int janet_loop_done(void) { + return !(janet_vm.listener_count || + (janet_vm.spawn.head != janet_vm.spawn.tail) || + janet_vm.tq_count || + janet_vm.extra_listeners); +} + +JanetFiber *janet_loop1(void) { /* Schedule expired timers */ JanetTimeout to; JanetTimestamp now = ts_now(); @@ -899,7 +891,21 @@ void janet_loop1(void) { while (janet_vm.spawn.head != janet_vm.spawn.tail) { JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK}; janet_q_pop(&janet_vm.spawn, &task, sizeof(task)); - run_one(task.fiber, task.value, task.sig); + task.fiber->flags &= ~JANET_FIBER_FLAG_SCHEDULED; + Janet res; + JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig); + JanetChannel *chan = (JanetChannel *)(task.fiber->supervisor_channel); + if (NULL == chan) { + if (sig != JANET_SIGNAL_EVENT && sig != JANET_SIGNAL_YIELD && sig != JANET_SIGNAL_INTERRUPT) { + janet_stacktrace(task.fiber, res); + } + } else if (sig == JANET_SIGNAL_OK || (task.fiber->flags & (1 << sig))) { + janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig], task.fiber), 2); + } + if (sig == JANET_SIGNAL_INTERRUPT) { + /* On interrupts, return the interrupted fiber immediately */ + return task.fiber; + } } /* Poll for events */ @@ -916,11 +922,28 @@ void janet_loop1(void) { janet_loop1_impl(has_timeout, to.when); } } + + /* No fiber was interrupted */ + return NULL; +} + +/* Same as janet_interpreter_interrupt, but will also + * break out of the event loop if waiting for an event + * (say, waiting for ev/sleep to finish). Does this by pushing + * an empty event to the event loop. */ +void janet_loop1_interrupt(JanetVM *vm) { + janet_interpreter_interrupt(vm); + JanetEVGenericMessage msg = {0}; + JanetCallback cb = NULL; + janet_ev_post_event(vm, cb, msg); } void janet_loop(void) { - while (janet_vm.listener_count || (janet_vm.spawn.head != janet_vm.spawn.tail) || janet_vm.tq_count || janet_vm.extra_listeners) { - janet_loop1(); + while (!janet_loop_done()) { + JanetFiber *interrupted_fiber = janet_loop1(); + if (NULL != interrupted_fiber) { + janet_schedule(interrupted_fiber, janet_wrap_nil()); + } } } @@ -945,8 +968,9 @@ static void janet_ev_setup_selfpipe(void) { static void janet_ev_handle_selfpipe(void) { JanetSelfPipeEvent response; while (read(janet_vm.selfpipe[0], &response, sizeof(response)) > 0) { - response.cb(response.msg); - janet_ev_dec_refcount(); + if (NULL != response.cb) { + response.cb(response.msg); + } } } @@ -1014,9 +1038,10 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) { if (0 == completionKey) { /* Custom event */ JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped); - response->cb(response->msg); + if (NULL != response->cb) { + response->cb(response->msg); + } janet_free(response); - janet_ev_dec_refcount(); } else { /* Normal event */ JanetStream *stream = (JanetStream *) completionKey; @@ -1310,6 +1335,45 @@ void janet_ev_deinit(void) { * End poll implementation */ +/* + * Generic Callback system. Post a function pointer + data to the event loop (from another + * thread or even a signal handler). Allows posting events from another thread or signal handler. + */ +void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage msg) { + vm = vm ? vm : &janet_vm; +#ifdef JANET_WINDOWS + JanetHandle iocp = vm->iocp; + JanetSelfPipeEvent *event = janet_malloc(sizeof(JanetSelfPipeEvent)); + if (NULL == event) { + JANET_OUT_OF_MEMORY; + } + event->msg = msg; + event->cb = cb; + janet_assert(PostQueuedCompletionStatus(iocp, + sizeof(JanetSelfPipeEvent), + 0, + (LPOVERLAPPED) event), + "failed to post completion event"); +#else + JanetSelfPipeEvent event; + event.msg = msg; + event.cb = cb; + int fd = vm->selfpipe; + /* handle a bit of back pressure before giving up. */ + int tries = 4; + while (tries > 0) { + int status; + do { + status = write(fd, &event, sizeof(event)); + } while (status == -1 && errno == EINTR); + if (status > 0) break; + sleep(1); + tries--; + } + janet_assert(tries > 0, "failed to write event to self-pipe"); +#endif +} + /* * Threaded calls */ @@ -1391,6 +1455,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar /* Default callback for janet_ev_threaded_await. */ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) { + janet_ev_dec_refcount(); if (return_value.fiber == NULL) { return; } @@ -1808,8 +1873,8 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event) } else #endif { - /* - * File handles in IOCP need to specify this if they are writing to the + /* + * File handles in IOCP need to specify this if they are writing to the * ends of files, like how this is used here. * If the underlying resource doesn't support seeking * byte offsets, they will be ignored diff --git a/src/core/os.c b/src/core/os.c index 2bd7f3ed..47aba63e 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -411,6 +411,7 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) { /* Callback that is called in main thread when subroutine completes. */ static void janet_proc_wait_cb(JanetEVGenericMessage args) { + janet_ev_dec_refcount(); int status = args.argi; JanetProc *proc = (JanetProc *) args.argp; if (NULL != proc) { diff --git a/src/core/state.c b/src/core/state.c index 027fa4a0..ffe9e660 100644 --- a/src/core/state.c +++ b/src/core/state.c @@ -56,9 +56,6 @@ void janet_vm_load(JanetVM *from) { * exit the interpeter loop when convenient. You can optionally * use NULL to interrupt the current VM when convenient */ void janet_interpreter_interrupt(JanetVM *vm) { - if (NULL == vm) { - janet_vm.auto_suspend = 1; - } else { - vm->auto_suspend = 1; - } + vm = vm ? vm : &janet_vm; + vm->auto_suspend = 1; } diff --git a/src/core/vm.c b/src/core/vm.c index 3a8db3ae..175aa0ae 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -118,7 +118,7 @@ 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_EVENT, janet_wrap_nil()); \ + vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \ } \ } while (0) #endif diff --git a/src/include/janet.h b/src/include/janet.h index 61f0e7ad..09b46530 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -355,6 +355,7 @@ typedef enum { } JanetSignal; #define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9 +#define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8 /* Fiber statuses - mostly corresponds to signals. */ typedef enum { @@ -1281,6 +1282,31 @@ extern JANET_API const JanetAbstractType janet_stream_type; /* Run the event loop */ JANET_API void janet_loop(void); +/* Run the event loop, but allow for user scheduled interrupts triggered + * by janet_loop1_interrupt being called in library code, a signal handler, or + * another thread. + * + * Example: + * + * while (!janet_loop_done()) { + * // One turn of the event loop + * JanetFiber *interrupted_fiber = janet_loop1(); + * // interrupted_fiber may be NULL + * // do some work here periodically... + * if (NULL != interrupted_fiber) { + * if (cancel_interrupted_fiber) { + * janet_cancel(interrupted_fiber, janet_cstringv("fiber was interrupted for [reason]")); + * } else { + * janet_schedule(interrupted_fiber, janet_wrap_nil()); + * } + * } + * } + * + */ +JANET_API int janet_loop_done(void); +JANET_API JanetFiber *janet_loop1(void); +JANET_API void janet_loop1_interrupt(JanetVM *vm); + /* Wrapper around streams */ JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods); JANET_API void janet_stream_close(JanetStream *stream); @@ -1344,13 +1370,20 @@ typedef struct { /* Function pointer that is run in the thread pool */ typedef JanetEVGenericMessage(*JanetThreadedSubroutine)(JanetEVGenericMessage arguments); -/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine */ +/* Handler for events posted to the event loop */ +typedef void (*JanetCallback)(JanetEVGenericMessage return_value); + +/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine (same as JanetCallback) */ typedef void (*JanetThreadedCallback)(JanetEVGenericMessage return_value); /* API calls for quickly offloading some work in C to a new thread or thread pool. */ JANET_API void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb); JANET_NO_RETURN JANET_API void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp); +/* Post callback + userdata to an event loop. Takes the vm parameter to allow posting from other + * threads or signal handlers. Use NULL to post to the current thread. */ +JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage msg); + /* Callback used by janet_ev_threaded_await */ JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value); From 7fba44ccce553c6e5d54faaa3e614604a96c55fe Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sun, 25 Jul 2021 13:03:01 -0500 Subject: [PATCH 09/12] Add macro mechanism for defining C source information for functions. This wil let us track source code for C functions more easily. --- src/core/asm.c | 66 ++++++++--------- src/core/util.c | 176 ++++++++++++++++++++++++++++++++------------ src/core/util.h | 8 ++ src/include/janet.h | 57 ++++++++++++++ 4 files changed, 223 insertions(+), 84 deletions(-) diff --git a/src/core/asm.c b/src/core/asm.c index f453388f..9d8e37c0 100644 --- a/src/core/asm.c +++ b/src/core/asm.c @@ -942,8 +942,12 @@ Janet janet_disasm(JanetFuncDef *def) { return janet_wrap_struct(janet_table_to_struct(ret)); } -/* C Function for assembly */ -static Janet cfun_asm(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_asm, + "(asm assembly)", + "Returns a new function that is the compiled result of the assembly.\n" + "The syntax for the assembly can be found on the Janet website, and should correspond\n" + "to the return value of disasm. Will throw an\n" + "error on invalid assembly.") { janet_fixarity(argc, 1); JanetAssembleResult res; res = janet_asm(argv[0], 0); @@ -953,7 +957,24 @@ static Janet cfun_asm(int32_t argc, Janet *argv) { return janet_wrap_function(janet_thunk(res.funcdef)); } -static Janet cfun_disasm(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_disasm, + "(disasm func &opt field)", + "Returns assembly that could be used to compile the given function. " + "func must be a function, not a c function. Will throw on error on a badly " + "typed argument. If given a field name, will only return that part of the function assembly. " + "Possible fields are:\n\n" + "* :arity - number of required and optional arguments.\n" + "* :min-arity - minimum number of arguments function can be called with.\n" + "* :max-arity - maximum number of arguments function can be called with.\n" + "* :vararg - true if function can take a variable number of arguments.\n" + "* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n" + "* :source - name of source file that this function was compiled from.\n" + "* :name - name of function.\n" + "* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n" + "* :constants - an array of constants referenced by this function.\n" + "* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n" + "* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n" + "* :defs - other function definitions that this function may instantiate.\n") { janet_arity(argc, 1, 2); JanetFunction *f = janet_getfunction(argv, 0); if (argc == 2) { @@ -976,41 +997,14 @@ static Janet cfun_disasm(int32_t argc, Janet *argv) { } } -static const JanetReg asm_cfuns[] = { - { - "asm", cfun_asm, - JDOC("(asm assembly)\n\n" - "Returns a new function that is the compiled result of the assembly.\n" - "The syntax for the assembly can be found on the Janet website, and should correspond\n" - "to the return value of disasm. Will throw an\n" - "error on invalid assembly.") - }, - { - "disasm", cfun_disasm, - JDOC("(disasm func &opt field)\n\n" - "Returns assembly that could be used to compile the given function.\n" - "func must be a function, not a c function. Will throw on error on a badly\n" - "typed argument. If given a field name, will only return that part of the function assembly.\n" - "Possible fields are:\n\n" - "* :arity - number of required and optional arguments.\n\n" - "* :min-arity - minimum number of arguments function can be called with.\n\n" - "* :max-arity - maximum number of arguments function can be called with.\n\n" - "* :vararg - true if function can take a variable number of arguments.\n\n" - "* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n\n" - "* :source - name of source file that this function was compiled from.\n\n" - "* :name - name of function.\n\n" - "* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n\n" - "* :constants - an array of constants referenced by this function.\n\n" - "* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n\n" - "* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n\n" - "* :defs - other function definitions that this function may instantiate.\n") - }, - {NULL, NULL, NULL} -}; - /* Load the library */ void janet_lib_asm(JanetTable *env) { - janet_core_cfuns(env, NULL, asm_cfuns); + JanetRegExt asm_cfuns[] = { + JANET_CORE_REG("asm", cfun_asm), + JANET_CORE_REG("disasm", cfun_disasm), + JANET_REG_END + }; + janet_core_cfuns_ext(env, NULL, asm_cfuns); } #endif diff --git a/src/core/util.c b/src/core/util.c index adcebcf2..2188c155 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -369,82 +369,148 @@ void janet_register(const char *name, JanetCFunction cfun) { janet_table_put(janet_vm.registry, key, value); } +/* Add sourcemapping and documentation to a binding table */ +static void janet_add_meta(JanetTable *table, const char *doc, const char *source_file, int32_t source_line) { + if (doc) { + janet_table_put(table, janet_ckeywordv("doc"), janet_cstringv(doc)); + } + if (source_file && source_line) { + Janet triple[3]; + triple[0] = janet_cstringv(source_file); + triple[1] = janet_wrap_integer(source_line); + triple[2] = janet_wrap_integer(1); + Janet value = janet_wrap_tuple(janet_tuple_n(triple, 3)); + janet_table_put(table, janet_ckeywordv("source-map"), value); + } +} + /* Add a def to an environment */ -void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) { +void janet_def_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) { JanetTable *subt = janet_table(2); janet_table_put(subt, janet_ckeywordv("value"), val); - if (doc) - janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc)); + janet_add_meta(subt, doc, source_file, source_line); janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt)); } +void janet_def(JanetTable *env, const char *name, Janet value, const char *doc) { + janet_def_sm(env, name, value, doc, NULL, 0); +} /* Add a var to the environment */ -void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) { +void janet_var_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) { JanetArray *array = janet_array(1); JanetTable *subt = janet_table(2); janet_array_push(array, val); janet_table_put(subt, janet_ckeywordv("ref"), janet_wrap_array(array)); - if (doc) - janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc)); + janet_add_meta(subt, doc, source_file, source_line); janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt)); } +void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) { + janet_var_sm(env, name, val, doc, NULL, 0); +} /* Load many cfunctions at once */ -static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) { - uint8_t *longname_buffer = NULL; - size_t prefixlen = 0; - size_t bufsize = 0; +typedef struct { + uint8_t *longname_buffer; + size_t prefixlen; + size_t bufsize; +} JanetNameBuffer; + +static void cfuns_namebuf_init(JanetNameBuffer *nb, const char *regprefix) { + nb->longname_buffer = NULL; + nb->prefixlen = 0; + nb->bufsize = 0; if (NULL != regprefix) { - prefixlen = strlen(regprefix); - bufsize = prefixlen + 256; - longname_buffer = janet_malloc(bufsize); - if (NULL == longname_buffer) { + nb->prefixlen = strlen(regprefix); + nb->bufsize = nb->prefixlen + 256; + nb->longname_buffer = janet_malloc(nb->bufsize); + if (NULL == nb->longname_buffer) { JANET_OUT_OF_MEMORY; } - safe_memcpy(longname_buffer, regprefix, prefixlen); - longname_buffer[prefixlen] = '/'; - prefixlen++; + safe_memcpy(nb->longname_buffer, regprefix, nb->prefixlen); + nb->longname_buffer[nb->prefixlen] = '/'; + nb->prefixlen++; } - while (cfuns->name) { - Janet name; - if (NULL != regprefix) { - int32_t nmlen = 0; - while (cfuns->name[nmlen]) nmlen++; - int32_t totallen = (int32_t) prefixlen + nmlen; - if ((size_t) totallen > bufsize) { - bufsize = (size_t)(totallen) + 128; - longname_buffer = janet_realloc(longname_buffer, bufsize); - if (NULL == longname_buffer) { - JANET_OUT_OF_MEMORY; - } +} + +static Janet cfuns_namebuf_getname(JanetNameBuffer *nb, const char *suffix) { + if (nb->prefixlen) { + int32_t nmlen = 0; + while (suffix[nmlen]) nmlen++; + int32_t totallen = (int32_t) nb->prefixlen + nmlen; + if ((size_t) totallen > nb->bufsize) { + nb->bufsize = (size_t)(totallen) + 128; + nb->longname_buffer = janet_realloc(nb->longname_buffer, nb->bufsize); + if (NULL == nb->longname_buffer) { + JANET_OUT_OF_MEMORY; } - safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen); - name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen)); - } else { - name = janet_csymbolv(cfuns->name); } - Janet fun = janet_wrap_cfunction(cfuns->cfun); - if (defprefix) { - JanetTable *subt = janet_table(2); - janet_table_put(subt, janet_ckeywordv("value"), fun); - if (cfuns->documentation) - janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation)); - janet_table_put(env, name, janet_wrap_table(subt)); - } else { - janet_def(env, cfuns->name, fun, cfuns->documentation); - } - janet_table_put(janet_vm.registry, fun, name); - cfuns++; + safe_memcpy(nb->longname_buffer + nb->prefixlen, suffix, nmlen); + return janet_wrap_symbol(janet_symbol(nb->longname_buffer, totallen)); + } else { + return janet_csymbolv(suffix); } - (janet_free)(longname_buffer); +} + +static void cfuns_namebuf_deinit(JanetNameBuffer *nb) { + janet_free(nb->longname_buffer); } void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { - _janet_cfuns_prefix(env, regprefix, cfuns, 1); + JanetNameBuffer nb; + cfuns_namebuf_init(&nb, regprefix); + while (cfuns->name) { + Janet name = cfuns_namebuf_getname(&nb, cfuns->name); + Janet fun = janet_wrap_cfunction(cfuns->cfun); + janet_def(env, cfuns->name, fun, cfuns->documentation); + janet_table_put(janet_vm.registry, fun, name); + cfuns++; + } + cfuns_namebuf_deinit(&nb); } void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { - _janet_cfuns_prefix(env, regprefix, cfuns, 0); + JanetNameBuffer nb; + cfuns_namebuf_init(&nb, regprefix); + while (cfuns->name) { + Janet name = cfuns_namebuf_getname(&nb, cfuns->name); + Janet fun = janet_wrap_cfunction(cfuns->cfun); + JanetTable *subt = janet_table(2); + janet_table_put(subt, janet_ckeywordv("value"), fun); + janet_add_meta(subt, cfuns->documentation, NULL, 0); + janet_table_put(env, name, janet_wrap_table(subt)); + janet_table_put(janet_vm.registry, fun, name); + cfuns++; + } + cfuns_namebuf_deinit(&nb); +} + +void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) { + JanetNameBuffer nb; + cfuns_namebuf_init(&nb, regprefix); + while (cfuns->name) { + Janet name = cfuns_namebuf_getname(&nb, cfuns->name); + Janet fun = janet_wrap_cfunction(cfuns->cfun); + janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line); + janet_table_put(janet_vm.registry, fun, name); + cfuns++; + } + cfuns_namebuf_deinit(&nb); +} + +void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) { + JanetNameBuffer nb; + cfuns_namebuf_init(&nb, regprefix); + while (cfuns->name) { + Janet name = cfuns_namebuf_getname(&nb, cfuns->name); + Janet fun = janet_wrap_cfunction(cfuns->cfun); + JanetTable *subt = janet_table(2); + janet_table_put(subt, janet_ckeywordv("value"), fun); + janet_add_meta(subt, cfuns->documentation, cfuns->source_file, cfuns->source_line); + janet_table_put(env, name, janet_wrap_table(subt)); + janet_table_put(janet_vm.registry, fun, name); + cfuns++; + } + cfuns_namebuf_deinit(&nb); } /* Abstract type introspection */ @@ -485,6 +551,20 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf cfuns++; } } + +void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) { + (void) sf, sl; + janet_core_def(env, name, x, p); +} + +void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) { + (void) regprefix; + while (cfuns->name) { + Janet fun = janet_wrap_cfunction(cfuns->cfun); + janet_core_def(env, cfuns->name, fun, cfuns->documentation); + cfuns++; + } +} #endif JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { diff --git a/src/core/util.h b/src/core/util.h index e596ceed..90bf690c 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -90,11 +90,19 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter); /* Inside the janet core, defining globals is different * at bootstrap time and normal runtime */ #ifdef JANET_BOOTSTRAP +#define JANET_CORE_REG JANET_REG +#define JANET_CORE_FN JANET_FN #define janet_core_def janet_def #define janet_core_cfuns janet_cfuns +#define janet_core_def_sm janet_def_sm +#define janet_core_cfuns_ext janet_cfuns_ext #else +#define JANET_CORE_REG JANET_REG_ +#define JANET_CORE_FN JANET_FN_ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p); void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns); +void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl); +void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns); #endif /* Clock gettime */ diff --git a/src/include/janet.h b/src/include/janet.h index 09b46530..13a235f8 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -403,6 +403,7 @@ typedef struct JanetKV JanetKV; typedef struct JanetStackFrame JanetStackFrame; typedef struct JanetAbstractType JanetAbstractType; typedef struct JanetReg JanetReg; +typedef struct JanetRegExt JanetRegExt; typedef struct JanetMethod JanetMethod; typedef struct JanetSourceMapping JanetSourceMapping; typedef struct JanetView JanetView; @@ -1093,6 +1094,14 @@ struct JanetReg { const char *documentation; }; +struct JanetRegExt { + const char *name; + JanetCFunction cfun; + const char *documentation; + const char *source_file; + int32_t source_line; +}; + struct JanetMethod { const char *name; JanetCFunction cfun; @@ -1750,6 +1759,54 @@ JANET_API Janet janet_resolve_core(const char *name); /* Shorthand for janet C function declarations */ #define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv) +/* Declare a C function with documentation and source mapping */ +#define JANET_REG_END {NULL, NULL, NULL, NULL, 0} + +/* no docstrings or sourcemaps */ +#define JANET_REG_(JNAME, CNAME) {JNAME, CNAME, NULL, NULL, 0} +#define JANET_FN_(CNAME, USAGE, DOCSTRING) \ + static Janet CNAME (int32_t argc, Janet *argv) + +/* sourcemaps only */ +#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_} +#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \ + static int32_t CNAME##_sourceline_ = __LINE__; \ + static Janet CNAME (int32_t argc, Janet *argv) + +/* docstring only */ +#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0} +#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \ + static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \ + static Janet CNAME (int32_t argc, Janet *argv) + +/* sourcemaps and docstrings */ +#define JANET_REG_SD(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, __FILE__, CNAME##_sourceline_} +#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \ + static int32_t CNAME##_sourceline_ = __LINE__; \ + static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \ + static Janet CNAME (int32_t argc, Janet *argv) + +/* Choose defaults for source mapping and docstring based on config defs */ +#if defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS) +#define JANET_REG JANET_REG_ +#define JANET_FN JANET_FN_ +#elif defined(JANET_NO_SOURCEMAPS) && !defined(JANET_NO_DOCSTRINGS) +#define JANET_REG JANET_REG_D +#define JANET_FN JANET_FN_D +#elif !defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS) +#define JANET_REG JANET_REG_S +#define JANET_FN JANET_FN_S +#elif !defined(JANET_NO_SOURCEMAPS) && !defined(JANET_NO_DOCSTRINGS) +#define JANET_REG JANET_REG_SD +#define JANET_FN JANET_FN_SD +#endif + +/* Define things with source mapping information */ +JANET_API void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns); +JANET_API void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns); +JANET_API void janet_def_sm(JanetTable *env, const char *name, Janet val, const char *documentation, const char *source_file, int32_t source_line); +JANET_API void janet_var_sm(JanetTable *env, const char *name, Janet val, const char *documentation, const char *source_file, int32_t source_line); + /* Allow setting entry name for static libraries */ #ifdef __cplusplus #define JANET_MODULE_PREFIX extern "C" From 4452d0e0f5c8dd3c456102321d9af4368d376c9a Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sun, 25 Jul 2021 13:08:17 -0500 Subject: [PATCH 10/12] Update CHANGELOG.md --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5af5cb6d..f2c91616 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## 1.17.0 - Unreleased +- Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information. +- Add `janet_interpreter_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running. - Add `table/clear` - Add build option to disable the threading library without disabling all threads. - Remove JPM from the main Janet distribution. Instead, JPM must be installed From 7e8154e648eca16d21d0be41fe04fea4ff9cff8d Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sun, 25 Jul 2021 14:54:25 -0500 Subject: [PATCH 11/12] Update peg.c with new style core function declarations. --- src/core/peg.c | 77 +++++++++++++++++++++----------------------------- 1 file changed, 32 insertions(+), 45 deletions(-) diff --git a/src/core/peg.c b/src/core/peg.c index a66826db..52070c6e 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -1541,7 +1541,11 @@ static JanetPeg *compile_peg(Janet x) { * C Functions */ -static Janet cfun_peg_compile(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_peg_compile, + "(peg/compile peg)", + "Compiles a peg source data structure into a . This will speed up matching " + "if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment " + "the grammar of the peg for otherwise undefined peg keywords.") { janet_fixarity(argc, 1); JanetPeg *peg = compile_peg(argv[0]); return janet_wrap_abstract(peg); @@ -1604,13 +1608,18 @@ static void peg_call_reset(PegCall *c) { c->s.tags->count = 0; } -static Janet cfun_peg_match(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_peg_match, + "(peg/match peg text &opt start & args)", + "Match a Parsing Expression Grammar to a byte string and return an array of captured values. " + "Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.") { PegCall c = peg_cfun_init(argc, argv, 0); const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start); return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil(); } -static Janet cfun_peg_find(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_peg_find, + "(peg/find peg text &opt start & args)", + "Find first index where the peg matches in text. Returns an integer, or nil if not found.") { PegCall c = peg_cfun_init(argc, argv, 0); for (int32_t i = c.start; i < c.bytes.len; i++) { peg_call_reset(&c); @@ -1620,7 +1629,9 @@ static Janet cfun_peg_find(int32_t argc, Janet *argv) { return janet_wrap_nil(); } -static Janet cfun_peg_find_all(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_peg_find_all, + "(peg/find-all peg text &opt start & args)", + "Find all indexes where the peg matches in text. Returns an array of integers.") { PegCall c = peg_cfun_init(argc, argv, 0); JanetArray *ret = janet_array(0); for (int32_t i = c.start; i < c.bytes.len; i++) { @@ -1659,11 +1670,16 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) { return janet_wrap_buffer(ret); } -static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_peg_replace_all, + "(peg/replace-all peg repl text &opt start & args)", + "Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") { return cfun_peg_replace_generic(argc, argv, 0); } -static Janet cfun_peg_replace(int32_t argc, Janet *argv) { +JANET_CORE_FN(cfun_peg_replace, + "(peg/replace peg repl text &opt start & args)", + "Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. " + "If no matches are found, returns the input string in a new buffer.") { return cfun_peg_replace_generic(argc, argv, 1); } @@ -1688,47 +1704,18 @@ static Janet peg_next(void *p, Janet key) { return janet_nextmethod(peg_methods, key); } -static const JanetReg peg_cfuns[] = { - { - "peg/compile", cfun_peg_compile, - JDOC("(peg/compile peg)\n\n" - "Compiles a peg source data structure into a . This will speed up matching " - "if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment " - "the grammar of the peg for otherwise undefined peg keywords.") - }, - { - "peg/match", cfun_peg_match, - JDOC("(peg/match peg text &opt start & args)\n\n" - "Match a Parsing Expression Grammar to a byte string and return an array of captured values. " - "Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.") - }, - { - "peg/find", cfun_peg_find, - JDOC("(peg/find peg text &opt start & args)\n\n" - "Find first index where the peg matches in text. Returns an integer, or nil if not found.") - }, - { - "peg/find-all", cfun_peg_find_all, - JDOC("(peg/find-all peg text &opt start & args)\n\n" - "Find all indexes where the peg matches in text. Returns an array of integers.") - }, - { - "peg/replace", cfun_peg_replace, - JDOC("(peg/replace peg repl text &opt start & args)\n\n" - "Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. " - "If no matches are found, returns the input string in a new buffer.") - }, - { - "peg/replace-all", cfun_peg_replace_all, - JDOC("(peg/replace-all peg repl text &opt start & args)\n\n" - "Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") - }, - {NULL, NULL, NULL} -}; - /* Load the peg module */ void janet_lib_peg(JanetTable *env) { - janet_core_cfuns(env, NULL, peg_cfuns); + JanetRegExt cfuns[] = { + JANET_CORE_REG("peg/compile", cfun_peg_compile), + JANET_CORE_REG("peg/match", cfun_peg_match), + JANET_CORE_REG("peg/find", cfun_peg_find), + JANET_CORE_REG("peg/find-all", cfun_peg_find_all), + JANET_CORE_REG("peg/replace", cfun_peg_replace), + JANET_CORE_REG("peg/replace-all", cfun_peg_replace_all), + JANET_REG_END + }; + janet_core_cfuns_ext(env, NULL, cfuns); janet_register_abstract_type(&janet_peg_type); } From 4cae7e6d5d2b5618ab0438692ba983dd21803135 Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sun, 25 Jul 2021 15:53:38 -0500 Subject: [PATCH 12/12] When building amalgamated build on windows, patch source-map. We don't want any backslahes cropping up in the offical distribution of janet.c. --- src/boot/boot.janet | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 45377a5e..dde897e2 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3616,6 +3616,9 @@ (put flat :doc nil)) (when (boot/config :no-sourcemaps) (put flat :source-map nil)) + # Fix directory separators on windows to make image identical between windows and non-windows + (when-let [sm (get flat :source-map)] + (put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)])) (if (v :private) (put root-env k nil) (put root-env k flat)))