diff --git a/CHANGELOG.md b/CHANGELOG.md index ec07594f..08e04422 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,18 +1,26 @@ # Changelog All notable changes to this project will be documented in this file. -## Unlreleased - ??? +## Unreleased - ??? +- Add `-i` flag to janet binary to make it easier to run image files from the command line +- Remove `thread/` module. +- Add `(number ...)` pattern to peg for more efficient number parsing using Janet's + scan-number function without immediate string creation. + +## 1.17.2 - 2021-09-18 +- Remove include of windows.h from janet.h. This caused issues on certain projects. +- Fix formatting in doc-format to better handle special characters in signatures. - Fix some marshalling bugs. - Add optional Makefile target to install jpm as well. -- Supervisor channels in threads will no longer include a wastful copy of the fiber in every +- Supervisor channels in threads will no longer include a wasteful copy of the fiber in every message across a thread. -- Allow passing a closure to `ev/thead` as well as a whole fiber. +- Allow passing a closure to `ev/thread` as well as a whole fiber. - Allow passing a closure directly to `ev/go` to spawn fibers on the event loop. ## 1.17.1 - 2021-08-29 - Fix docstring typos -- Add `make install-jpm-git` to make jpm co-install simpler if using makefile. -- Fix bugs with starting ev/threads and fiber marshling. +- Add `make install-jpm-git` to make jpm co-install simpler if using the Makefile. +- Fix bugs with starting ev/threads and fiber marshaling. ## 1.17.0 - 2021-08-21 - Add the `-E` flag for one-liners with the `short-fn` syntax for argument passing. diff --git a/Makefile b/Makefile index 3b331383..123607db 100644 --- a/Makefile +++ b/Makefile @@ -120,7 +120,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \ src/core/struct.c \ src/core/symcache.c \ src/core/table.c \ - src/core/thread.c \ src/core/tuple.c \ src/core/util.c \ src/core/value.c \ @@ -159,7 +158,7 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet ##### Amalgamation ##### ######################## -SONAME=libjanet.so.1.17 +SONAME=libjanet.so.1.18 build/c/shell.c: src/mainclient/shell.c cp $< $@ diff --git a/janet.1 b/janet.1 index bd4ee7f3..2bb8560a 100644 --- a/janet.1 +++ b/janet.1 @@ -3,7 +3,7 @@ janet \- run the Janet language abstract machine .SH SYNOPSIS .B janet -[\fB\-hvsrpnqk\fR] +[\fB\-hvsrpnqik\fR] [\fB\-e\fR \fISOURCE\fR] [\fB\-E\fR \fISOURCE ...ARGUMENTS\fR] [\fB\-l\fR \fIMODULE\fR] @@ -213,6 +213,11 @@ Precompiles Janet source code into an image, a binary dump that can be efficient Source should be a path to the Janet module to compile, and output should be the file path of resulting image. Output should usually end with the .jimage extension. +.TP +.BR \-i +When this flag is passed, a script passed to the interpreter will be treated as a janet image file +rather than a janet source file. + .TP .BR \-l\ lib Import a Janet module before running a script or repl. Multiple files can be loaded diff --git a/meson.build b/meson.build index 0f52020c..32100a18 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.17.1') + version : '1.18.0') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') @@ -74,7 +74,6 @@ 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_EV_NO_KQUEUE', not get_option('kqueue')) -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')) @@ -136,7 +135,6 @@ core_src = [ 'src/core/struct.c', 'src/core/symcache.c', 'src/core/table.c', - 'src/core/thread.c', 'src/core/tuple.c', 'src/core/util.c', 'src/core/value.c', diff --git a/meson_options.txt b/meson_options.txt index 003ca6db..afc8f353 100644 --- a/meson_options.txt +++ b/meson_options.txt @@ -1,7 +1,6 @@ option('git_hash', type : 'string', value : 'meson') option('single_threaded', type : 'boolean', value : false) -option('threads', type : 'boolean', value : true) option('nanbox', type : 'boolean', value : true) option('dynamic_modules', type : 'boolean', value : true) option('docstrings', type : 'boolean', value : true) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index e323a91c..528c619f 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2786,8 +2786,8 @@ (def delimiters (if has-color {:underline ["\e[4m" "\e[24m"] - :code ["\e[3;97m" "\e[39;23m"] - :italics ["\e[3m" "\e[23m"] + :code ["\e[97m" "\e[39m"] + :italics ["\e[4m" "\e[24m"] :bold ["\e[1m" "\e[22m"]} {:underline ["_" "_"] :code ["`" "`"] @@ -2820,7 +2820,7 @@ (c++) (- cursor x)) - # Detection helpers - return number of characters natched + # Detection helpers - return number of characters matched (defn ul? [] (let [x (c) x1 (cn 1)] (and @@ -2954,6 +2954,14 @@ (finish-p) new-indent)) + # Handle first line specially for defn, defmacro, etc. + (when (= (chr "(") (in str 0)) + (skipline) + (def first-line (string/slice str 0 (- cursor 1))) + (def fl-open (if has-color "\e[97m" "")) + (def fl-close (if has-color "\e[39m" "")) + (push [[(string fl-open first-line fl-close) (length first-line)]])) + (parse-blocks 0) # Emission state @@ -3500,6 +3508,12 @@ # conditional compilation for reduced os (def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&]))) +(defn- run-main + [env subargs arg] + (if-let [main (get (in env 'main) :value)] + (let [thunk (compile [main ;subargs] env arg)] + (if (function? thunk) (thunk) (error (thunk :error)))))) + (defn cli-main `Entrance for the Janet CLI tool. Call this function with the command line arguments as an array or tuple of strings to invoke the CLI interface.` @@ -3507,17 +3521,18 @@ (setdyn :args args) - (var *should-repl* false) - (var *no-file* true) - (var *quiet* false) - (var *raw-stdin* false) - (var *handleopts* true) - (var *exit-on-error* true) - (var *colorize* true) - (var *debug* false) - (var *compile-only* false) - (var *warn-level* nil) - (var *error-level* nil) + (var should-repl false) + (var no-file true) + (var quiet false) + (var raw-stdin false) + (var handleopts true) + (var exit-on-error true) + (var colorize true) + (var debug-flag false) + (var compile-only false) + (var warn-level nil) + (var error-level nil) + (var expect-image false) (if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp)) (if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn :profilepath jprofile)) @@ -3547,8 +3562,9 @@ -k : Compile scripts but do not execute (flycheck) -m syspath : Set system path for loading global modules -c source output : Compile janet source code into an image + -i : Load the script argument as an image file instead of source code -n : Disable ANSI color output in the REPL - -l lib : Import a module before processing more arguments + -l lib : Use a module before processing more arguments -w level : Set the lint warning level - default is "normal" -x level : Set the lint error level - default is "none" -- : Stop handling options @@ -3556,29 +3572,31 @@ (os/exit 0) 1) "v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1) - "s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1) - "r" (fn [&] (set *should-repl* true) 1) - "p" (fn [&] (set *exit-on-error* false) 1) - "q" (fn [&] (set *quiet* true) 1) - "k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1) - "n" (fn [&] (set *colorize* false) 1) + "s" (fn [&] (set raw-stdin true) (set should-repl true) 1) + "r" (fn [&] (set should-repl true) 0) + "p" (fn [&] (set exit-on-error false) 1) + "q" (fn [&] (set quiet true) 1) + "i" (fn [&] (set expect-image true) 1) + "k" (fn [&] (set compile-only true) (set exit-on-error false) 1) + "n" (fn [&] (set colorize false) 1) "m" (fn [i &] (setdyn :syspath (in args (+ i 1))) 2) "c" (fn c-switch [i &] - (def e (dofile (in args (+ i 1)))) + (def path (in args (+ i 1))) + (def e (dofile path)) (spit (in args (+ i 2)) (make-image e)) - (set *no-file* false) + (set no-file false) 3) - "-" (fn [&] (set *handleopts* false) 1) + "-" (fn [&] (set handleopts false) 1) "l" (fn l-switch [i &] (import* (in args (+ i 1)) - :prefix "" :exit *exit-on-error*) + :prefix "" :exit exit-on-error) 2) "e" (fn e-switch [i &] - (set *no-file* false) + (set no-file false) (eval-string (in args (+ i 1))) 2) "E" (fn E-switch [i &] - (set *no-file* false) + (set no-file false) (def subargs (array/slice args (+ i 2))) (def src ~|,(parse (in args (+ i 1)))) (def thunk (compile src)) @@ -3586,9 +3604,9 @@ ((thunk) ;subargs) (error (get thunk :error))) math/inf) - "d" (fn [&] (set *debug* true) 1) - "w" (fn [i &] (set *warn-level* (get-lint-level i)) 2) - "x" (fn [i &] (set *error-level* (get-lint-level i)) 2) + "d" (fn [&] (set debug-flag true) 1) + "w" (fn [i &] (set warn-level (get-lint-level i)) 2) + "x" (fn [i &] (set error-level (get-lint-level i)) 2) "R" (fn [&] (setdyn :profilepath nil) 1)}) (defn- dohandler [n i &] @@ -3600,29 +3618,37 @@ (def lenargs (length args)) (while (< i lenargs) (def arg (in args i)) - (if (and *handleopts* (= "-" (string/slice arg 0 1))) + (if (and handleopts (= "-" (string/slice arg 0 1))) (+= i (dohandler (string/slice arg 1) i)) (do - (set *no-file* false) - (def env (make-env)) (def subargs (array/slice args i)) - (put env :args subargs) - (put env :lint-error *error-level*) - (put env :lint-warn *warn-level*) - (if *compile-only* - (flycheck arg :exit *exit-on-error* :env env) + (set no-file false) + (if expect-image (do - (dofile arg :exit *exit-on-error* :env env) - (if-let [main (get (in env 'main) :value)] - (let [thunk (compile [main ;(tuple/slice args i)] env arg)] - (if (function? thunk) (thunk) (error (thunk :error))))))) + (def env (load-image (slurp arg))) + (put env :args subargs) + (put env :lint-error error-level) + (put env :lint-warn warn-level) + (if debug-flag (put env :debug true)) + (run-main env subargs arg)) + (do + (def env (make-env)) + (put env :args subargs) + (put env :lint-error error-level) + (put env :lint-warn warn-level) + (if debug-flag (put env :debug true)) + (if compile-only + (flycheck arg :exit exit-on-error :env env) + (do + (dofile arg :exit exit-on-error :env env) + (run-main env subargs arg))))) (set i lenargs)))) - (if (or *should-repl* *no-file*) + (if (or should-repl no-file) (if - *compile-only* (flycheck stdin :source "stdin" :exit *exit-on-error*) + compile-only (flycheck stdin :source "stdin" :exit exit-on-error) (do - (if-not *quiet* + (if-not quiet (print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help")) (flush) (defn getprompt [p] @@ -3636,15 +3662,15 @@ (when-let [profile.janet (dyn :profilepath)] (def new-env (dofile profile.janet :exit true)) (merge-module env new-env "" false)) - (if *debug* (put env :debug true)) - (def getter (if *raw-stdin* getstdin getline)) + (if debug-flag (put env :debug true)) + (def getter (if raw-stdin getstdin getline)) (defn getchunk [buf p] (getter (getprompt p) buf env)) - (setdyn :pretty-format (if *colorize* "%.20Q" "%.20q")) - (setdyn :err-color (if *colorize* true)) - (setdyn :doc-color (if *colorize* true)) - (setdyn :lint-error *error-level*) - (setdyn :lint-warn *error-level*) + (setdyn :pretty-format (if colorize "%.20Q" "%.20q")) + (setdyn :err-color (if colorize true)) + (setdyn :doc-color (if colorize true)) + (setdyn :lint-error error-level) + (setdyn :lint-warn error-level) (repl getchunk nil env))))) ### @@ -3668,12 +3694,6 @@ (when-let [v (get root-env 'file/popen)] (put v :deprecated true)) - # Deprecate thread library - (loop [[k v] :in (pairs root-env) - :when (symbol? k) - :when (string/has-prefix? "thread/" k)] - (put v :deprecated true)) - # Modify root-env to remove private symbols and # flatten nested tables. (loop [[k v] :in (pairs root-env) @@ -3758,7 +3778,6 @@ "src/core/struct.c" "src/core/symcache.c" "src/core/table.c" - "src/core/thread.c" "src/core/tuple.c" "src/core/util.c" "src/core/value.c" diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index bc11666d..d78e3257 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -4,10 +4,10 @@ #define JANETCONF_H #define JANET_VERSION_MAJOR 1 -#define JANET_VERSION_MINOR 17 -#define JANET_VERSION_PATCH 1 -#define JANET_VERSION_EXTRA "" -#define JANET_VERSION "1.17.1" +#define JANET_VERSION_MINOR 18 +#define JANET_VERSION_PATCH 0 +#define JANET_VERSION_EXTRA "-dev" +#define JANET_VERSION "1.18.0-dev" /* #define JANET_BUILD "local" */ diff --git a/src/core/corelib.c b/src/core/corelib.c index 1344d216..60485b00 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -979,9 +979,6 @@ static void janet_load_libs(JanetTable *env) { #ifdef JANET_INT_TYPES janet_lib_inttypes(env); #endif -#ifdef JANET_THREADS - janet_lib_thread(env); -#endif #ifdef JANET_EV janet_lib_ev(env); #endif diff --git a/src/core/ev.c b/src/core/ev.c index 63b1fdb6..7732b14d 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -1689,11 +1689,11 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) { struct kevent timer; if (janet_vm.timer_enabled || has_timeout) { EV_SETx(&timer, - JANET_KQUEUE_TIMER_IDENT, - EVFILT_TIMER, - JANET_KQUEUE_TF, - NOTE_MSECONDS | NOTE_ABSTIME, - JANET_KQUEUE_TS(timeout), &janet_vm.timer); + JANET_KQUEUE_TIMER_IDENT, + EVFILT_TIMER, + JANET_KQUEUE_TF, + NOTE_MSECONDS | NOTE_ABSTIME, + JANET_KQUEUE_TS(timeout), &janet_vm.timer); add_kqueue_events(&timer, 1); } janet_vm.timer_enabled = has_timeout; @@ -1709,7 +1709,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) { /* Step state machines */ for (int i = 0; i < status; i++) { - void *p = (void*) events[i].udata; + void *p = (void *) events[i].udata; if (&janet_vm.timer == p) { /* Timer expired, ignore */; } else if (janet_vm.selfpipe == p) { @@ -2235,7 +2235,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) { case JANET_ASYNC_EVENT_READ: { JanetBuffer *buffer = state->buf; int32_t bytes_left = state->bytes_left; - int32_t read_limit = bytes_left > 4096 ? 4096 : bytes_left; + int32_t read_limit = state->is_chunk ? (bytes_left > 4096 ? 4096 : bytes_left) : bytes_left; janet_buffer_extra(buffer, read_limit); ssize_t nread; #ifdef JANET_NET diff --git a/src/core/peg.c b/src/core/peg.c index 48a3dc70..61c6b4a3 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -387,6 +387,24 @@ tail: return result; } + case RULE_CAPTURE_NUM: { + down1(s); + const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text); + up1(s); + if (!result) return NULL; + /* check number parsing */ + double x = 0.0; + if (janet_scan_number(text, (int32_t)(result - text), &x)) return NULL; + /* Specialized pushcap - avoid intermediate string creation */ + if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) { + janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text)); + } else { + uint32_t tag = rule[2]; + pushcap(s, janet_wrap_number(x), tag); + } + return result; + } + case RULE_ACCUMULATE: { uint32_t tag = rule[2]; int oldmode = s->mode; @@ -965,6 +983,9 @@ static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) static void spec_capture(Builder *b, int32_t argc, const Janet *argv) { spec_cap1(b, argc, argv, RULE_CAPTURE); } +static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) { + spec_cap1(b, argc, argv, RULE_CAPTURE_NUM); +} static void spec_accumulate(Builder *b, int32_t argc, const Janet *argv) { spec_cap1(b, argc, argv, RULE_ACCUMULATE); } @@ -1118,6 +1139,7 @@ static const SpecialPair peg_specials[] = { {"line", spec_line}, {"look", spec_look}, {"not", spec_not}, + {"number", spec_capture_number}, {"opt", spec_opt}, {"position", spec_position}, {"quote", spec_capture}, @@ -1422,6 +1444,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) { case RULE_ACCUMULATE: case RULE_GROUP: case RULE_CAPTURE: + case RULE_CAPTURE_NUM: case RULE_UNREF: /* [rule, tag] */ if (rule[1] >= blen) goto bad; diff --git a/src/core/state.h b/src/core/state.h index fdfbfe14..c844fb31 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -54,14 +54,6 @@ typedef struct { int is_error; } JanetTimeout; -#ifdef JANET_THREADS -typedef struct { - JanetMailbox *original; - JanetMailbox *newbox; - uint64_t flags; -} JanetMailboxPair; -#endif - /* Registry table for C functions - containts metadata that can * be looked up by cfunction pointer. All strings here are pointing to * static memory not managed by Janet. */ @@ -145,13 +137,6 @@ struct JanetVM { JanetTraversalNode *traversal_top; JanetTraversalNode *traversal_base; - /* Threading */ -#ifdef JANET_THREADS - JanetMailbox *mailbox; - JanetThread *thread_current; - JanetTable *thread_decode; -#endif - /* Event loop and scheduler globals */ #ifdef JANET_EV size_t tq_count; @@ -186,12 +171,6 @@ struct JanetVM { extern JANET_THREAD_LOCAL JanetVM janet_vm; -/* Setup / teardown */ -#ifdef JANET_THREADS -void janet_threads_init(void); -void janet_threads_deinit(void); -#endif - #ifdef JANET_NET void janet_net_init(void); void janet_net_deinit(void); diff --git a/src/core/strtod.c b/src/core/strtod.c index 0b85c8d8..2acc1be8 100644 --- a/src/core/strtod.c +++ b/src/core/strtod.c @@ -246,7 +246,7 @@ static double convert( } /* Scan a real (double) from a string. If the string cannot be converted into - * and integer, set *err to 1 and return 0. */ + * and integer, return 0. */ int janet_scan_number( const uint8_t *str, int32_t len, diff --git a/src/core/thread.c b/src/core/thread.c deleted file mode 100644 index d95f9b2b..00000000 --- a/src/core/thread.c +++ /dev/null @@ -1,739 +0,0 @@ -/* -* Copyright (c) 2021 Calvin Rose -* -* Permission is hereby granted, free of charge, to any person obtaining a copy -* of this software and associated documentation files (the "Software"), to -* deal in the Software without restriction, including without limitation the -* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or -* sell copies of the Software, and to permit persons to whom the Software is -* furnished to do so, subject to the following conditions: -* -* The above copyright notice and this permission notice shall be included in -* all copies or substantial portions of the Software. -* -* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -* IN THE SOFTWARE. -*/ - -#ifndef JANET_AMALG -#include "features.h" -#include -#include "gc.h" -#include "util.h" -#include "state.h" -#endif - -#ifdef JANET_THREADS - -#include -#ifdef JANET_WINDOWS -#include -#else -#include -#include -#include -#endif - -/* typedefed in janet.h */ -struct JanetMailbox { - - /* Synchronization */ -#ifdef JANET_WINDOWS - CRITICAL_SECTION lock; - CONDITION_VARIABLE cond; -#else - pthread_mutex_t lock; - pthread_cond_t cond; -#endif - - /* Memory management - reference counting */ - int refCount; - int closed; - - /* Store messages */ - uint16_t messageCapacity; - uint16_t messageCount; - uint16_t messageFirst; - uint16_t messageNext; - - /* Buffers to store messages. These buffers are manually allocated, so - * are not owned by any thread's GC. */ - JanetBuffer messages[]; -}; - -#define JANET_THREAD_HEAVYWEIGHT 0x1 -#define JANET_THREAD_ABSTRACTS 0x2 -#define JANET_THREAD_CFUNCTIONS 0x4 -static const char janet_thread_flags[] = "hac"; - -static JanetTable *janet_thread_get_decode(void) { - if (janet_vm.thread_decode == NULL) { - janet_vm.thread_decode = janet_get_core_table("load-image-dict"); - if (NULL == janet_vm.thread_decode) { - janet_vm.thread_decode = janet_table(0); - } - janet_gcroot(janet_wrap_table(janet_vm.thread_decode)); - } - return janet_vm.thread_decode; -} - -static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) { - JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity); - if (NULL == mailbox) { - JANET_OUT_OF_MEMORY; - } -#ifdef JANET_WINDOWS - InitializeCriticalSection(&mailbox->lock); - InitializeConditionVariable(&mailbox->cond); -#else - pthread_mutex_init(&mailbox->lock, NULL); - pthread_cond_init(&mailbox->cond, NULL); -#endif - mailbox->refCount = refCount; - mailbox->closed = 0; - mailbox->messageCount = 0; - mailbox->messageCapacity = capacity; - mailbox->messageFirst = 0; - mailbox->messageNext = 0; - for (uint16_t i = 0; i < capacity; i++) { - janet_buffer_init(mailbox->messages + i, 0); - } - return mailbox; -} - -static void janet_mailbox_destroy(JanetMailbox *mailbox) { -#ifdef JANET_WINDOWS - DeleteCriticalSection(&mailbox->lock); -#else - pthread_mutex_destroy(&mailbox->lock); - pthread_cond_destroy(&mailbox->cond); -#endif - for (uint16_t i = 0; i < mailbox->messageCapacity; i++) { - janet_buffer_deinit(mailbox->messages + i); - } - janet_free(mailbox); -} - -static void janet_mailbox_lock(JanetMailbox *mailbox) { -#ifdef JANET_WINDOWS - EnterCriticalSection(&mailbox->lock); -#else - pthread_mutex_lock(&mailbox->lock); -#endif -} - -static void janet_mailbox_unlock(JanetMailbox *mailbox) { -#ifdef JANET_WINDOWS - LeaveCriticalSection(&mailbox->lock); -#else - pthread_mutex_unlock(&mailbox->lock); -#endif -} - -/* Assumes you have the mailbox lock already */ -static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) { - mailbox->refCount += delta; - if (mailbox->refCount <= 0) { - janet_mailbox_unlock(mailbox); - janet_mailbox_destroy(mailbox); - } else { - janet_mailbox_unlock(mailbox); - } -} - -static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) { - janet_mailbox_lock(mailbox); - janet_mailbox_ref_with_lock(mailbox, delta); -} - -static void janet_close_thread(JanetThread *thread) { - if (thread->mailbox) { - janet_mailbox_ref(thread->mailbox, -1); - thread->mailbox = NULL; - } -} - -static int thread_gc(void *p, size_t size) { - (void) size; - JanetThread *thread = (JanetThread *)p; - janet_close_thread(thread); - return 0; -} - -static int thread_mark(void *p, size_t size) { - (void) size; - JanetThread *thread = (JanetThread *)p; - if (thread->encode) { - janet_mark(janet_wrap_table(thread->encode)); - } - return 0; -} - -static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) { - JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair)); - if (NULL == pair) { - JANET_OUT_OF_MEMORY; - } - pair->original = original; - janet_mailbox_ref(original, 1); - pair->newbox = janet_mailbox_create(1, 16); - pair->flags = flags; - return pair; -} - -static void destroy_mailbox_pair(JanetMailboxPair *pair) { - janet_mailbox_ref(pair->original, -1); - janet_mailbox_ref(pair->newbox, -1); - janet_free(pair); -} - -/* Abstract waiting for timeout across windows/posix */ -typedef struct { - int timedwait; - int nowait; -#ifdef JANET_WINDOWS - DWORD interval; - DWORD ticksLeft; -#else - struct timespec ts; -#endif -} JanetWaiter; - -static void janet_waiter_init(JanetWaiter *waiter, double sec) { - waiter->timedwait = 0; - waiter->nowait = 0; - - if (sec <= 0.0 || isnan(sec)) { - waiter->nowait = 1; - return; - } - waiter->timedwait = sec > 0.0 && !isinf(sec); - - /* Set maximum wait time to 30 days */ - if (sec > (60.0 * 60.0 * 24.0 * 30.0)) { - sec = 60.0 * 60.0 * 24.0 * 30.0; - } - -#ifdef JANET_WINDOWS - if (waiter->timedwait) { - waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec); - } -#else - if (waiter->timedwait) { - /* N seconds -> timespec of (now + sec) */ - struct timespec now; - janet_gettime(&now); - time_t tvsec = (time_t) floor(sec); - long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec))); - tvsec += now.tv_sec; - tvnsec += now.tv_nsec; - if (tvnsec >= 1000000000L) { - tvnsec -= 1000000000L; - tvsec += 1; - } - waiter->ts.tv_sec = tvsec; - waiter->ts.tv_nsec = tvnsec; - } -#endif -} - -static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) { - if (wait->nowait) return 1; -#ifdef JANET_WINDOWS - if (wait->timedwait) { - if (wait->ticksLeft == 0) return 1; - DWORD startTime = GetTickCount(); - int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft); - DWORD dTick = GetTickCount() - startTime; - /* Be careful about underflow */ - wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick; - return status; - } else { - SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE); - return 0; - } -#else - if (wait->timedwait) { - return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts); - } else { - pthread_cond_wait(&mailbox->cond, &mailbox->lock); - return 0; - } -#endif -} - -static void janet_mailbox_wakeup(JanetMailbox *mailbox) { -#ifdef JANET_WINDOWS - WakeConditionVariable(&mailbox->cond); -#else - pthread_cond_signal(&mailbox->cond); -#endif -} - -static int mailbox_at_capacity(JanetMailbox *mailbox) { - return mailbox->messageCount >= mailbox->messageCapacity; -} - -/* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and - * 0 otherwise. Will not panic. */ -int janet_thread_send(JanetThread *thread, Janet msg, double timeout) { - - /* Ensure mailbox is not closed. */ - JanetMailbox *mailbox = thread->mailbox; - if (NULL == mailbox) return 2; - janet_mailbox_lock(mailbox); - if (mailbox->closed) { - janet_mailbox_ref_with_lock(mailbox, -1); - thread->mailbox = NULL; - return 2; - } - - /* Back pressure */ - if (mailbox_at_capacity(mailbox)) { - JanetWaiter wait; - janet_waiter_init(&wait, timeout); - - if (wait.nowait) { - janet_mailbox_unlock(mailbox); - return 1; - } - - /* Retry loop, as there can be multiple writers */ - while (mailbox_at_capacity(mailbox)) { - if (janet_waiter_wait(&wait, mailbox)) { - janet_mailbox_unlock(mailbox); - janet_mailbox_wakeup(mailbox); - return 1; - } - } - } - - /* Hack to capture all panics from marshalling. This works because - * we know janet_marshal won't mess with other essential global state. */ - jmp_buf buf; - jmp_buf *old_buf = janet_vm.signal_buf; - janet_vm.signal_buf = &buf; - int32_t oldmcount = mailbox->messageCount; - - int ret = 0; - if (setjmp(buf)) { - ret = 1; - mailbox->messageCount = oldmcount; - } else { - JanetBuffer *msgbuf = mailbox->messages + mailbox->messageNext; - msgbuf->count = 0; - - /* Start panic zone */ - janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE); - /* End panic zone */ - - mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity; - mailbox->messageCount++; - } - - /* Cleanup */ - janet_vm.signal_buf = old_buf; - janet_mailbox_unlock(mailbox); - - /* Potentially wake up a blocked thread */ - janet_mailbox_wakeup(mailbox); - - return ret; -} - -/* Returns 0 on successful message. Returns 1 if timedout */ -int janet_thread_receive(Janet *msg_out, double timeout) { - JanetMailbox *mailbox = janet_vm.mailbox; - janet_mailbox_lock(mailbox); - - /* For timeouts */ - JanetWaiter wait; - janet_waiter_init(&wait, timeout); - - for (;;) { - - /* Check for messages waiting for us */ - if (mailbox->messageCount > 0) { - - /* Hack to capture all panics from marshalling. This works because - * we know janet_marshal won't mess with other essential global state. */ - jmp_buf buf; - jmp_buf *old_buf = janet_vm.signal_buf; - janet_vm.signal_buf = &buf; - - /* Handle errors */ - if (setjmp(buf)) { - /* Cleanup jmp_buf, return error. - * Do not ignore bad messages as before. */ - janet_vm.signal_buf = old_buf; - *msg_out = *janet_vm.return_reg; - janet_mailbox_unlock(mailbox); - return 2; - } else { - JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst; - mailbox->messageCount--; - mailbox->messageFirst = (mailbox->messageFirst + 1) % mailbox->messageCapacity; - - /* Read from beginning of channel */ - const uint8_t *nextItem = NULL; - Janet item = janet_unmarshal( - msgbuf->data, msgbuf->count, - JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem); - *msg_out = item; - - /* Cleanup */ - janet_vm.signal_buf = old_buf; - janet_mailbox_unlock(mailbox); - - /* Potentially wake up pending threads */ - janet_mailbox_wakeup(mailbox); - - return 0; - } - } - - if (wait.nowait) { - janet_mailbox_unlock(mailbox); - return 1; - } - - /* Wait for next message */ - if (janet_waiter_wait(&wait, mailbox)) { - janet_mailbox_unlock(mailbox); - return 1; - } - } -} - -static int janet_thread_getter(void *p, Janet key, Janet *out); -static Janet janet_thread_next(void *p, Janet key); - -const JanetAbstractType janet_thread_type = { - "core/thread", - thread_gc, - thread_mark, - janet_thread_getter, - NULL, /* put */ - NULL, /* marshal */ - NULL, /* unmarshal */ - NULL, /* tostring */ - NULL, /* compare */ - NULL, /* hash */ - janet_thread_next, - JANET_ATEND_NEXT -}; - -static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) { - JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread)); - janet_mailbox_ref(mailbox, 1); - thread->mailbox = mailbox; - thread->encode = encode; - return thread; -} - -JanetThread *janet_getthread(const Janet *argv, int32_t n) { - return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type); -} - -/* Runs in new thread */ -static int thread_worker(JanetMailboxPair *pair) { - JanetFiber *fiber = NULL; - Janet out; - - /* Init VM */ - janet_init(); - - /* Use the mailbox we were given */ - janet_vm.mailbox = pair->newbox; - janet_mailbox_ref(pair->newbox, 1); - - /* Get dictionaries for default encode/decode */ - JanetTable *encode; - if (pair->flags & JANET_THREAD_HEAVYWEIGHT) { - encode = janet_get_core_table("make-image-dict"); - } else { - encode = NULL; - janet_vm.thread_decode = janet_table(0); - janet_gcroot(janet_wrap_table(janet_vm.thread_decode)); - } - - /* Create parent thread */ - JanetThread *parent = janet_make_thread(pair->original, encode); - Janet parentv = janet_wrap_abstract(parent); - - /* Unmarshal the abstract registry */ - if (pair->flags & JANET_THREAD_ABSTRACTS) { - Janet reg; - int status = janet_thread_receive(®, INFINITY); - if (status) goto error; - if (!janet_checktype(reg, JANET_TABLE)) goto error; - janet_gcunroot(janet_wrap_table(janet_vm.abstract_registry)); - janet_vm.abstract_registry = janet_unwrap_table(reg); - janet_gcroot(janet_wrap_table(janet_vm.abstract_registry)); - } - - /* Unmarshal the function */ - Janet funcv; - int status = janet_thread_receive(&funcv, INFINITY); - if (status) goto error; - if (!janet_checktype(funcv, JANET_FUNCTION)) goto error; - JanetFunction *func = janet_unwrap_function(funcv); - - /* Arity check */ - if (func->def->min_arity > 1 || func->def->max_arity < 1) { - goto error; - } - - /* Call function */ - Janet argv[1] = { parentv }; - fiber = janet_fiber(func, 64, 1, argv); - if (pair->flags & JANET_THREAD_HEAVYWEIGHT) { - fiber->env = janet_table(0); - fiber->env->proto = janet_core_env(NULL); - } - JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out); - if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) { - janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode))); - janet_stacktrace(fiber, out); - } - -#ifdef JANET_EV - janet_loop(); -#endif - - /* Normal exit */ - destroy_mailbox_pair(pair); - janet_deinit(); - return 0; - - /* Fail to set something up */ -error: - destroy_mailbox_pair(pair); - janet_eprintf("\nthread failed to start\n"); - janet_deinit(); - return 1; -} - -#ifdef JANET_WINDOWS - -static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) { - thread_worker((JanetMailboxPair *)param); - return 0; -} - -static int janet_thread_start_child(JanetMailboxPair *pair) { - HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL); - int ret = NULL == handle; - /* Does not kill thread, simply detatches */ - if (!ret) CloseHandle(handle); - return ret; -} - -#else - -static void *janet_pthread_wrapper(void *param) { - thread_worker((JanetMailboxPair *)param); - return NULL; -} - -static int janet_thread_start_child(JanetMailboxPair *pair) { - pthread_t handle; - int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair); - if (error) { - return 1; - } else { - pthread_detach(handle); - return 0; - } -} - -#endif - -/* - * Setup/Teardown - */ - -void janet_threads_init(void) { - janet_vm.mailbox = janet_mailbox_create(1, 10); - janet_vm.thread_decode = NULL; - janet_vm.thread_current = NULL; -} - -void janet_threads_deinit(void) { - janet_mailbox_lock(janet_vm.mailbox); - janet_vm.mailbox->closed = 1; - janet_mailbox_ref_with_lock(janet_vm.mailbox, -1); - janet_vm.mailbox = NULL; - janet_vm.thread_current = NULL; - janet_vm.thread_decode = NULL; -} - -JanetThread *janet_thread_current(void) { - if (NULL == janet_vm.thread_current) { - janet_vm.thread_current = janet_make_thread(janet_vm.mailbox, janet_get_core_table("make-image-dict")); - janet_gcroot(janet_wrap_abstract(janet_vm.thread_current)); - } - return janet_vm.thread_current; -} - -/* - * Cfuns - */ - -JANET_CORE_FN(cfun_thread_current, - "(thread/current)", - "Get the current running thread.") { - (void) argv; - janet_fixarity(argc, 0); - return janet_wrap_abstract(janet_thread_current()); -} - -JANET_CORE_FN(cfun_thread_new, - "(thread/new func &opt capacity flags)", - "Start a new thread that will start immediately. " - "If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. " - "The capacity must be between 1 and 65535 inclusive, and defaults to 10. " - "Can optionally provide flags to the new thread - supported flags are:\n\n" - "* `:h` - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n" - "* `:a` - Allow sending over registered abstract types to the new thread\n" - "* `:c` - Send over cfunction information to the new thread (no longer supported).\n" - "Returns a handle to the new thread.") { - janet_arity(argc, 1, 3); - /* Just type checking */ - janet_getfunction(argv, 0); - int32_t cap = janet_optinteger(argv, argc, 1, 10); - if (cap < 1 || cap > UINT16_MAX) { - janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap); - } - uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS; - JanetTable *encode; - if (flags & JANET_THREAD_HEAVYWEIGHT) { - encode = janet_get_core_table("make-image-dict"); - } else { - encode = NULL; - } - - JanetMailboxPair *pair = make_mailbox_pair(janet_vm.mailbox, flags); - JanetThread *thread = janet_make_thread(pair->newbox, encode); - if (janet_thread_start_child(pair)) { - destroy_mailbox_pair(pair); - janet_panic("could not start thread"); - } - - if (flags & JANET_THREAD_ABSTRACTS) { - if (janet_thread_send(thread, janet_wrap_table(janet_vm.abstract_registry), INFINITY)) { - janet_panic("could not send abstract registry to thread"); - } - } - - /* If thread started, send the worker function. */ - if (janet_thread_send(thread, argv[0], INFINITY)) { - janet_panicf("could not send worker function %v to thread", argv[0]); - } - - return janet_wrap_abstract(thread); -} - -JANET_CORE_FN(cfun_thread_send, - "(thread/send thread msgi &opt timeout)", - "Send a message to the thread. By default, the timeout is 1 second, but an optional timeout " - "in seconds can be provided. Use math/inf for no timeout. " - "Will throw an error if there is a problem sending the message.") { - janet_arity(argc, 2, 3); - JanetThread *thread = janet_getthread(argv, 0); - int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0)); - switch (status) { - default: - break; - case 1: - janet_panicf("failed to send message %v", argv[1]); - case 2: - janet_panic("thread mailbox is closed"); - } - return argv[0]; -} - -JANET_CORE_FN(cfun_thread_receive, - "(thread/receive &opt timeout)", - "Get a message sent to this thread. If timeout (in seconds) is provided, an error " - "will be thrown after the timeout has elapsed but " - "no messages are received. The default timeout is 1 second, and math/inf cam be passed to " - "turn off the timeout.") { - janet_arity(argc, 0, 1); - double wait = janet_optnumber(argv, argc, 0, 1.0); - Janet out; - int status = janet_thread_receive(&out, wait); - switch (status) { - default: - break; - case 1: - janet_panicf("timeout after %f seconds", wait); - case 2: - janet_panicf("failed to receive message: %v", out); - } - return out; -} - -JANET_CORE_FN(cfun_thread_close, - "(thread/close thread)", - "Close a thread, unblocking it and ending communication with it. Note that closing " - "a thread is idempotent and does not cancel the thread's operation. Returns nil.") { - janet_fixarity(argc, 1); - JanetThread *thread = janet_getthread(argv, 0); - janet_close_thread(thread); - return janet_wrap_nil(); -} - -JANET_CORE_FN(cfun_thread_exit, - "(thread/exit &opt code)", - "Exit from the current thread. If no more threads are running, ends the process, but otherwise does " - "not end the current process.") { - (void) argv; - janet_arity(argc, 0, 1); -#if defined(JANET_WINDOWS) - int32_t flag = janet_optinteger(argv, argc, 0, 0); - ExitThread(flag); -#else - pthread_exit(NULL); -#endif - return janet_wrap_nil(); -} - -static const JanetMethod janet_thread_methods[] = { - {"send", cfun_thread_send}, - {"close", cfun_thread_close}, - {NULL, NULL} -}; - -static int janet_thread_getter(void *p, Janet key, Janet *out) { - (void) p; - if (!janet_checktype(key, JANET_KEYWORD)) return 0; - return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out); -} - -static Janet janet_thread_next(void *p, Janet key) { - (void) p; - return janet_nextmethod(janet_thread_methods, key); -} - -/* Module entry point */ -void janet_lib_thread(JanetTable *env) { - JanetRegExt threadlib_cfuns[] = { - JANET_CORE_REG("thread/current", cfun_thread_current), - JANET_CORE_REG("thread/new", cfun_thread_new), - JANET_CORE_REG("thread/send", cfun_thread_send), - JANET_CORE_REG("thread/receive", cfun_thread_receive), - JANET_CORE_REG("thread/close", cfun_thread_close), - JANET_CORE_REG("thread/exit", cfun_thread_exit), - JANET_REG_END - }; - janet_core_cfuns_ext(env, NULL, threadlib_cfuns); - janet_register_abstract_type(&janet_thread_type); -} - -#endif diff --git a/src/core/util.h b/src/core/util.h index fb54715f..6a4e57f0 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -145,9 +145,6 @@ void janet_lib_typed_array(JanetTable *env); #ifdef JANET_INT_TYPES void janet_lib_inttypes(JanetTable *env); #endif -#ifdef JANET_THREADS -void janet_lib_thread(JanetTable *env); -#endif #ifdef JANET_NET void janet_lib_net(JanetTable *env); extern const JanetAbstractType janet_address_type; diff --git a/src/core/vm.c b/src/core/vm.c index 75683a4e..9316b045 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -1557,9 +1557,6 @@ int janet_init(void) { janet_vm.root_fiber = NULL; janet_vm.stackn = 0; -#ifdef JANET_THREADS - janet_threads_init(); -#endif #ifdef JANET_EV janet_ev_init(); #endif @@ -1586,9 +1583,6 @@ void janet_deinit(void) { janet_vm.root_fiber = NULL; janet_free(janet_vm.registry); janet_vm.registry = NULL; -#ifdef JANET_THREADS - janet_threads_deinit(); -#endif #ifdef JANET_EV janet_ev_deinit(); #endif diff --git a/src/include/janet.h b/src/include/janet.h index 9c741b0f..6d4c9a8b 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -144,11 +144,6 @@ extern "C" { #define JANET_NO_UTC_MKTIME #endif -/* Check thread library */ -#ifndef JANET_NO_THREADS -#define JANET_THREADS -#endif - /* Define how global janet state is declared */ /* Also enable the thread library only if not single-threaded */ #ifdef JANET_SINGLE_THREADED @@ -2040,7 +2035,8 @@ typedef enum { RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */ RULE_LINE, /* [tag] */ RULE_COLUMN, /* [tag] */ - RULE_UNREF /* [rule, tag] */ + RULE_UNREF, /* [rule, tag] */ + RULE_CAPTURE_NUM /* [rule, tag] */ } JanetPegOpcod; typedef struct { diff --git a/test/suite0008.janet b/test/suite0008.janet index 03570a16..3f91ace7 100644 --- a/test/suite0008.janet +++ b/test/suite0008.janet @@ -344,4 +344,8 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5") (assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6") +# number pattern +(assert (deep= @[111] (peg/match '(number :d+) "111")) "simple number capture 1") +(assert (deep= @[255] (peg/match '(number :w+) "0xff")) "simple number capture 2") + (end-suite)