From 7e5f2264806c41a02d1117b4ddff009f74af560a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 29 Jul 2021 21:29:08 -0500 Subject: [PATCH] Put source mapping info in stack traces. --- src/boot/boot.janet | 4 +- src/core/corelib.c | 11 ++- src/core/debug.c | 39 +++++++-- src/core/ev.c | 208 +++++++++++++++++++++++--------------------- src/core/io.c | 12 +-- src/core/math.c | 70 +++++++-------- src/core/pp.c | 12 +-- src/core/state.h | 18 +++- src/core/thread.c | 23 +---- src/core/util.c | 207 +++++++++++++++++++++++-------------------- src/core/util.h | 28 +++--- src/core/vm.c | 9 +- src/include/janet.h | 1 - 13 files changed, 353 insertions(+), 289 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 93a62f6f..1e902c42 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3653,8 +3653,8 @@ (def feature-header "src/core/features.h") (def local-headers - ["src/core/util.h" - "src/core/state.h" + ["src/core/state.h" + "src/core/util.h" "src/core/gc.h" "src/core/vector.h" "src/core/fiber.h" diff --git a/src/core/corelib.c b/src/core/corelib.c index e05ace40..1344d216 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -35,6 +35,13 @@ extern const unsigned char *janet_core_image; extern size_t janet_core_image_size; #endif +/* Docstrings should only exist during bootstrap */ +#ifdef JANET_BOOTSTRAP +#define JDOC(x) (x) +#else +#define JDOC(x) NULL +#endif + /* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries * with native code. */ #if defined(JANET_NO_DYNAMIC_MODULES) @@ -1207,9 +1214,7 @@ JanetTable *janet_core_lookup_table(JanetTable *replacements) { JanetKV kv = replacements->data[i]; if (!janet_checktype(kv.key, JANET_NIL)) { janet_table_put(dict, kv.key, kv.value); - if (janet_checktype(kv.value, JANET_CFUNCTION)) { - janet_table_put(janet_vm.registry, kv.value, kv.key); - } + /* Add replacement functions to registry? */ } } } diff --git a/src/core/debug.c b/src/core/debug.c index e1047035..dc51f626 100644 --- a/src/core/debug.c +++ b/src/core/debug.c @@ -118,6 +118,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) { fiber = fibers[fi]; int32_t i = fiber->frame; while (i > 0) { + JanetCFunRegistry *reg = NULL; JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE); JanetFuncDef *def = NULL; i = frame->prevframe; @@ -144,11 +145,19 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) { } else { JanetCFunction cfun = (JanetCFunction)(frame->pc); if (cfun) { - Janet name = janet_table_get(janet_vm.registry, janet_wrap_cfunction(cfun)); - if (!janet_checktype(name, JANET_NIL)) - janet_eprintf(" %s", (const char *)janet_to_string(name)); - else + reg = janet_registry_get(cfun); + if (NULL != reg && NULL != reg->name) { + if (reg->name_prefix) { + janet_eprintf(" %s/%s", reg->name_prefix, reg->name); + } else { + janet_eprintf(" %s", reg->name); + } + if (NULL != reg->source_file) { + janet_eprintf(" [%s]", reg->source_file); + } + } else { janet_eprintf(" "); + } } } if (frame->flags & JANET_STACKFRAME_TAILCALL) @@ -161,6 +170,11 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) { } else { janet_eprintf(" pc=%d", off); } + } else if (NULL != reg) { + /* C Function */ + if (reg->source_line > 0) { + janet_eprintf(" on line %d", (long) reg->source_line); + } } janet_eprintf("\n"); } @@ -273,9 +287,20 @@ static Janet doframe(JanetStackFrame *frame) { } else { JanetCFunction cfun = (JanetCFunction)(frame->pc); if (cfun) { - Janet name = janet_table_get(janet_vm.registry, janet_wrap_cfunction(cfun)); - if (!janet_checktype(name, JANET_NIL)) { - janet_table_put(t, janet_ckeywordv("name"), name); + JanetCFunRegistry *reg = janet_registry_get(cfun); + if (NULL != reg->name) { + if (NULL != reg->name_prefix) { + janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(janet_formatc("%s/%s", reg->name_prefix, reg->name))); + } else { + janet_table_put(t, janet_ckeywordv("name"), janet_cstringv(reg->name)); + } + if (NULL != reg->source_file) { + janet_table_put(t, janet_ckeywordv("source"), janet_cstringv(reg->source_file)); + } + if (reg->source_line > 0) { + janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(reg->source_line)); + janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(1)); + } } } janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true()); diff --git a/src/core/ev.c b/src/core/ev.c index 6dee347f..0c4d8212 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -722,9 +722,8 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) /* Channel Methods */ JANET_CORE_FN(cfun_channel_push, - "(ev/give channel value)", - "Write a value to a channel, suspending the current fiber if the channel is full." - ) { + "(ev/give channel value)", + "Write a value to a channel, suspending the current fiber if the channel is full.") { janet_fixarity(argc, 2); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); if (janet_channel_push(channel, argv[1], 0)) { @@ -733,10 +732,9 @@ JANET_CORE_FN(cfun_channel_push, return argv[0]; } -JANET_CORE_FN(cfun_channel_pop, - "(ev/take channel)", - "Read from a channel, suspending the current fiber if no value is available." - ) { +JANET_CORE_FN(cfun_channel_pop, + "(ev/take channel)", + "Read from a channel, suspending the current fiber if no value is available.") { janet_fixarity(argc, 1); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); Janet item; @@ -747,12 +745,11 @@ JANET_CORE_FN(cfun_channel_pop, } JANET_CORE_FN(cfun_channel_choice, - "(ev/select & clauses)", - "Block until the first of several channel operations occur. Returns a tuple of the form [:give chan] or [:take chan x], where " - "a :give tuple is the result of a write and :take tuple is the result of a write. Each clause must be either a channel (for " - "a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first " - "clauses will take precedence over later clauses." - ) { + "(ev/select & clauses)", + "Block until the first of several channel operations occur. Returns a tuple of the form [:give chan] or [:take chan x], where " + "a :give tuple is the result of a write and :take tuple is the result of a write. Each clause must be either a channel (for " + "a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first " + "clauses will take precedence over later clauses.") { janet_arity(argc, 1, -1); int32_t len; const Janet *data; @@ -795,27 +792,24 @@ JANET_CORE_FN(cfun_channel_choice, } JANET_CORE_FN(cfun_channel_full, - "(ev/full channel)", - "Check if a channel is full or not." - ) { + "(ev/full channel)", + "Check if a channel is full or not.") { janet_fixarity(argc, 1); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); return janet_wrap_boolean(janet_q_count(&channel->items) >= channel->limit); } JANET_CORE_FN(cfun_channel_capacity, - "(ev/capacity channel)", - "Get the number of items a channel will store before blocking writers." - ) { + "(ev/capacity channel)", + "Get the number of items a channel will store before blocking writers.") { janet_fixarity(argc, 1); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); return janet_wrap_integer(channel->limit); } JANET_CORE_FN(cfun_channel_count, - "(ev/count channel)", - "Get the number of items currently waiting in a channel." - ) { + "(ev/count channel)", + "Get the number of items currently waiting in a channel.") { janet_fixarity(argc, 1); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); return janet_wrap_integer(janet_q_count(&channel->items)); @@ -832,18 +826,16 @@ static void fisher_yates_args(int32_t argc, Janet *argv) { } JANET_CORE_FN(cfun_channel_rchoice, - "(ev/rselect & clauses)", - "Similar to ev/select, but will try clauses in a random order for fairness." - ) { + "(ev/rselect & clauses)", + "Similar to ev/select, but will try clauses in a random order for fairness.") { fisher_yates_args(argc, argv); return cfun_channel_choice(argc, argv); } -JANET_CORE_FN(cfun_channel_new, - "(ev/chan &opt capacity)", - "Create a new channel. capacity is the number of values to queue before " - "blocking writers, defaults to 0 if not provided. Returns a new channel." - ) { +JANET_CORE_FN(cfun_channel_new, + "(ev/chan &opt capacity)", + "Create a new channel. capacity is the number of values to queue before " + "blocking writers, defaults to 0 if not provided. Returns a new channel.") { janet_arity(argc, 0, 1); int32_t limit = janet_optnat(argv, argc, 0, 0); JanetChannel *channel = janet_abstract(&ChannelAT, sizeof(JanetChannel)); @@ -2145,13 +2137,12 @@ error: /* C functions */ JANET_CORE_FN(cfun_ev_go, - "(ev/go fiber &opt value supervisor)", - "Put a fiber on the event loop to be resumed later. Optionally pass " - "a value to resume with, otherwise resumes with nil. Returns the fiber. " - "An optional `core/channel` can be provided as well as a supervisor. When various " - "events occur in the newly scheduled fiber, an event will be pushed to the supervisor. " - "If not provided, the new fiber will inherit the current supervisor." - ) { + "(ev/go fiber &opt value supervisor)", + "Put a fiber on the event loop to be resumed later. Optionally pass " + "a value to resume with, otherwise resumes with nil. Returns the fiber. " + "An optional `core/channel` can be provided as well as a supervisor. When various " + "events occur in the newly scheduled fiber, an event will be pushed to the supervisor. " + "If not provided, the new fiber will inherit the current supervisor.") { janet_arity(argc, 1, 3); JanetFiber *fiber = janet_getfiber(argv, 0); Janet value = argc >= 2 ? argv[1] : janet_wrap_nil(); @@ -2167,18 +2158,39 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) { JanetBuffer *buffer = (JanetBuffer *) args.argp; const uint8_t *nextbytes = buffer->data; const uint8_t *endbytes = nextbytes + buffer->count; + uint32_t flags = args.tag; + args.tag = 0; janet_init(); JanetTryState tstate; JanetSignal signal = janet_try(&tstate); if (!signal) { - Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes, - JANET_MARSHAL_UNSAFE, NULL, &nextbytes); - if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry"); - janet_vm.abstract_registry = janet_unwrap_table(aregv); - Janet regv = janet_unmarshal(nextbytes, endbytes - nextbytes, - JANET_MARSHAL_UNSAFE, NULL, &nextbytes); - if (!janet_checktype(regv, JANET_TABLE)) janet_panic("expected table for cfunction registry"); - janet_vm.registry = janet_unwrap_table(regv); + + /* Set abstract registry */ + if (flags & 0x2) { + Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes, + JANET_MARSHAL_UNSAFE, NULL, &nextbytes); + if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry"); + janet_vm.abstract_registry = janet_unwrap_table(aregv); + } + + /* Set cfunction registry */ + if (flags & 0x4) { + uint32_t count1; + memcpy(&count1, nextbytes, sizeof(count1)); + size_t count = (size_t) count1; + if (count > (endbytes - nextbytes) * sizeof(JanetCFunRegistry)) { + janet_panic("thread message invalid"); + } + janet_vm.registry_count = count; + janet_vm.registry_cap = count; + janet_vm.registry = janet_malloc(count * sizeof(JanetCFunRegistry)); + if (janet_vm.registry == NULL) { + JANET_OUT_OF_MEMORY; + } + janet_vm.registry_dirty = 1; + memcpy(janet_vm.registry, nextbytes, count * sizeof(JanetCFunRegistry)); + } + Janet fiberv = janet_unmarshal(nextbytes, endbytes - nextbytes, JANET_MARSHAL_UNSAFE, NULL, &nextbytes); Janet value = janet_unmarshal(nextbytes, endbytes - nextbytes, @@ -2203,20 +2215,22 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) { return args; } -JANET_CORE_FN(cfun_ev_thread, - "(ev/thread fiber &opt value flags)", - "Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` " - "to resume with. " - "Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. " - "If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. " - "Otherwise, returns (a copy of) the final result from the fiber on the new thread." - ) { +JANET_CORE_FN(cfun_ev_thread, + "(ev/thread fiber &opt value flags)", + "Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` " + "to resume with. " + "Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. " + "If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. " + "Otherwise, returns (a copy of) the final result from the fiber on the new thread. Available flags:\n\n" + "* `:n` - return immediately\n" + "* `:a` - don't copy abstract registry to new thread (performance optimization)\n" + "* `:c` - don't copy cfunction registry to new thread (performance optimization)") { janet_arity(argc, 1, 3); janet_getfiber(argv, 0); Janet value = argc >= 2 ? argv[1] : janet_wrap_nil(); uint64_t flags = 0; if (argc >= 3) { - flags = janet_getflags(argv, 2, "n"); + flags = janet_getflags(argv, 2, "nac"); } /* Marshal arguments for the new thread. */ JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer)); @@ -2224,14 +2238,19 @@ JANET_CORE_FN(cfun_ev_thread, JANET_OUT_OF_MEMORY; } janet_buffer_init(buffer, 0); - janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE); - janet_marshal(buffer, janet_wrap_table(janet_vm.registry), NULL, JANET_MARSHAL_UNSAFE); + if (flags & 0x2) janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE); + if (flags & 0x4) { + janet_assert(janet_vm.registry_count <= UINT32_MAX, "assert failed size check"); + uint32_t temp = (uint32_t) janet_vm.registry_count; + janet_buffer_push_bytes(buffer, (uint8_t *) &temp, sizeof(temp)); + janet_buffer_push_bytes(buffer, (uint8_t *) janet_vm.registry, janet_vm.registry_count * sizeof(JanetCFunRegistry)); + } janet_marshal(buffer, argv[0], NULL, JANET_MARSHAL_UNSAFE); janet_marshal(buffer, value, NULL, JANET_MARSHAL_UNSAFE); if (flags & 0x1) { /* Return immediately */ JanetEVGenericMessage arguments; - arguments.tag = 0; + arguments.tag = (uint32_t) flags;; arguments.argi = argc; arguments.argp = buffer; arguments.fiber = NULL; @@ -2242,12 +2261,11 @@ JANET_CORE_FN(cfun_ev_thread, } } -JANET_CORE_FN(cfun_ev_give_supervisor, - "(ev/give-supervisor tag & payload)", - "Send a message to the current supervior channel if there is one. The message will be a " - "tuple of all of the arguments combined into a single message, where the first element is tag. " - "By convention, tag should be a keyword indicating the type of message. Returns nil." - ) { +JANET_CORE_FN(cfun_ev_give_supervisor, + "(ev/give-supervisor tag & payload)", + "Send a message to the current supervior channel if there is one. The message will be a " + "tuple of all of the arguments combined into a single message, where the first element is tag. " + "By convention, tag should be a keyword indicating the type of message. Returns nil.") { janet_arity(argc, 1, -1); JanetChannel *chan = janet_vm.root_fiber->supervisor_channel; if (NULL != chan) { @@ -2270,21 +2288,19 @@ JANET_NO_RETURN void janet_sleep_await(double sec) { } JANET_CORE_FN(cfun_ev_sleep, - "(ev/sleep sec)", - "Suspend the current fiber for sec seconds without blocking the event loop." - ) { + "(ev/sleep sec)", + "Suspend the current fiber for sec seconds without blocking the event loop.") { janet_fixarity(argc, 1); double sec = janet_getnumber(argv, 0); janet_sleep_await(sec); } -JANET_CORE_FN(cfun_ev_deadline, - "(ev/deadline sec &opt tocancel tocheck)", - "Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, " - "`tocancel` will be canceled as with `ev/cancel`. " - "If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and " - "`(fiber/current)` respectively. Returns `tocancel`." - ) { +JANET_CORE_FN(cfun_ev_deadline, + "(ev/deadline sec &opt tocancel tocheck)", + "Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, " + "`tocancel` will be canceled as with `ev/cancel`. " + "If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and " + "`(fiber/current)` respectively. Returns `tocancel`.") { janet_arity(argc, 1, 3); double sec = janet_getnumber(argv, 0); JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber); @@ -2300,9 +2316,8 @@ JANET_CORE_FN(cfun_ev_deadline, } JANET_CORE_FN(cfun_ev_cancel, - "(ev/cancel fiber err)", - "Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately" - ) { + "(ev/cancel fiber err)", + "Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately") { janet_fixarity(argc, 2); JanetFiber *fiber = janet_getfiber(argv, 0); Janet err = argv[1]; @@ -2310,10 +2325,9 @@ JANET_CORE_FN(cfun_ev_cancel, return argv[0]; } -JANET_CORE_FN(janet_cfun_stream_close, - "(ev/close stream)", - "Close a stream. This should be the same as calling (:close stream) for all streams." - ) { +JANET_CORE_FN(janet_cfun_stream_close, + "(ev/close stream)", + "Close a stream. This should be the same as calling (:close stream) for all streams.") { janet_fixarity(argc, 1); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); janet_stream_close(stream); @@ -2321,14 +2335,13 @@ JANET_CORE_FN(janet_cfun_stream_close, } JANET_CORE_FN(janet_cfun_stream_read, - "(ev/read stream n &opt buffer timeout)", - "Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword " - "`:all` to read into the buffer until end of stream. " - "Optionally provide a buffer to write into " - "as well as a timeout in seconds after which to cancel the operation and raise an error. " - "Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an " - "error if there are problems with the IO operation." - ) { + "(ev/read stream n &opt buffer timeout)", + "Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword " + "`:all` to read into the buffer until end of stream. " + "Optionally provide a buffer to write into " + "as well as a timeout in seconds after which to cancel the operation and raise an error. " + "Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an " + "error if there are problems with the IO operation.") { janet_arity(argc, 2, 4); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); janet_stream_flags(stream, JANET_STREAM_READABLE); @@ -2345,11 +2358,10 @@ JANET_CORE_FN(janet_cfun_stream_read, janet_await(); } -JANET_CORE_FN(janet_cfun_stream_chunk, - "(ev/chunk stream n &opt buffer timeout)", - "Same as ev/read, but will not return early if less than n bytes are available. If an end of " - "stream is reached, will also return early with the collected bytes." - ) { +JANET_CORE_FN(janet_cfun_stream_chunk, + "(ev/chunk stream n &opt buffer timeout)", + "Same as ev/read, but will not return early if less than n bytes are available. If an end of " + "stream is reached, will also return early with the collected bytes.") { janet_arity(argc, 2, 4); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); janet_stream_flags(stream, JANET_STREAM_READABLE); @@ -2361,11 +2373,11 @@ JANET_CORE_FN(janet_cfun_stream_chunk, janet_await(); } -JANET_CORE_FN(janet_cfun_stream_write, - "(ev/write stream data &opt timeout)", - "Write data to a stream, suspending the current fiber until the write " - "completes. Takes an optional timeout in seconds, after which will return nil. " - "Returns nil, or raises an error if the write failed.") { +JANET_CORE_FN(janet_cfun_stream_write, + "(ev/write stream data &opt timeout)", + "Write data to a stream, suspending the current fiber until the write " + "completes. Takes an optional timeout in seconds, after which will return nil. " + "Returns nil, or raises an error if the write failed.") { janet_arity(argc, 2, 3); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); janet_stream_flags(stream, JANET_STREAM_WRITABLE); diff --git a/src/core/io.c b/src/core/io.c index 95535fc2..0295b115 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -798,16 +798,16 @@ void janet_lib_io(JanetTable *env) { janet_register_abstract_type(&janet_file_type); int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE; /* stdout */ - janet_core_def(env, "stdout", + JANET_CORE_DEF(env, "stdout", janet_makefile(stdout, JANET_FILE_APPEND | default_flags), - JDOC("The standard output file.")); + "The standard output file."); /* stderr */ - janet_core_def(env, "stderr", + JANET_CORE_DEF(env, "stderr", janet_makefile(stderr, JANET_FILE_APPEND | default_flags), - JDOC("The standard error file.")); + "The standard error file."); /* stdin */ - janet_core_def(env, "stdin", + JANET_CORE_DEF(env, "stdin", janet_makefile(stdin, JANET_FILE_READ | default_flags), - JDOC("The standard input file.")); + "The standard input file."); } diff --git a/src/core/math.c b/src/core/math.c index 10a9fbfc..b945a4d8 100644 --- a/src/core/math.c +++ b/src/core/math.c @@ -118,11 +118,11 @@ double janet_rng_double(JanetRNG *rng) { } JANET_CORE_FN(cfun_rng_make, - "(math/rng &opt seed)", - "Creates a Psuedo-Random number generator, with an optional seed. " - "The seed should be an unsigned 32 bit integer or a buffer. " - "Do not use this for cryptography. Returns a core/rng abstract type." - ) { + "(math/rng &opt seed)", + "Creates a Psuedo-Random number generator, with an optional seed. " + "The seed should be an unsigned 32 bit integer or a buffer. " + "Do not use this for cryptography. Returns a core/rng abstract type." + ) { janet_arity(argc, 0, 1); JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG)); if (argc == 1) { @@ -140,20 +140,20 @@ JANET_CORE_FN(cfun_rng_make, } JANET_CORE_FN(cfun_rng_uniform, - "(math/rng-uniform rng)", - "Extract a random random integer in the range [0, max] from the RNG. If " - "no max is given, the default is 2^31 - 1." - ) { + "(math/rng-uniform rng)", + "Extract a random random integer in the range [0, max] from the RNG. If " + "no max is given, the default is 2^31 - 1." + ) { janet_fixarity(argc, 1); JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); return janet_wrap_number(janet_rng_double(rng)); } -JANET_CORE_FN(cfun_rng_int, - "(math/rng-int rng &opt max)", - "Extract a random random integer in the range [0, max] from the RNG. If " - "no max is given, the default is 2^31 - 1." - ) { +JANET_CORE_FN(cfun_rng_int, + "(math/rng-int rng &opt max)", + "Extract a random random integer in the range [0, max] from the RNG. If " + "no max is given, the default is 2^31 - 1." + ) { janet_arity(argc, 1, 2); JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); if (argc == 1) { @@ -181,11 +181,11 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) { buf[3] = (word >> 24) & 0xFF; } -JANET_CORE_FN(cfun_rng_buffer, - "(math/rng-buffer rng n &opt buf)", - "Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is " - "provided, otherwise appends to the given buffer. Returns the buffer." - ) { +JANET_CORE_FN(cfun_rng_buffer, + "(math/rng-buffer rng n &opt buf)", + "Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is " + "provided, otherwise appends to the given buffer. Returns the buffer." + ) { janet_arity(argc, 2, 3); JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); int32_t n = janet_getnat(argv, 1); @@ -230,20 +230,20 @@ static Janet janet_rng_next(void *p, Janet key) { } /* Get a random number */ -JANET_CORE_FN(janet_rand, - "(math/random)", - "Returns a uniformly distributed random number between 0 and 1") { +JANET_CORE_FN(janet_rand, + "(math/random)", + "Returns a uniformly distributed random number between 0 and 1") { (void) argv; janet_fixarity(argc, 0); return janet_wrap_number(janet_rng_double(&janet_vm.rng)); } /* Seed the random number generator */ -JANET_CORE_FN(janet_srand, - "(math/seedrandom seed)", - "Set the seed for the random number generator. seed should be " - "an integer or a buffer." - ) { +JANET_CORE_FN(janet_srand, + "(math/seedrandom seed)", + "Set the seed for the random number generator. seed should be " + "an integer or a buffer." + ) { janet_fixarity(argc, 1); if (janet_checkint(argv[0])) { uint32_t seed = (uint32_t)(janet_getinteger(argv, 0)); @@ -360,21 +360,21 @@ void janet_lib_math(JanetTable *env) { janet_register_abstract_type(&janet_rng_type); #ifdef JANET_BOOTSTRAP JANET_CORE_DEF(env, "math/pi", janet_wrap_number(3.1415926535897931), - "The value pi."); + "The value pi."); JANET_CORE_DEF(env, "math/e", janet_wrap_number(2.7182818284590451), - "The base of the natural log."); + "The base of the natural log."); JANET_CORE_DEF(env, "math/inf", janet_wrap_number(INFINITY), - "The number representing positive infinity"); + "The number representing positive infinity"); JANET_CORE_DEF(env, "math/-inf", janet_wrap_number(-INFINITY), - "The number representing negative infinity"); + "The number representing negative infinity"); JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN), - "The minimum contiguous integer representable by a 32 bit signed integer"); + "The minimum contiguous integer representable by a 32 bit signed integer"); JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX), - "The maximum contiguous integer represtenable by a 32 bit signed integer"); + "The maximum contiguous integer represtenable by a 32 bit signed integer"); JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE), - "The minimum contiguous integer representable by a double (2^53)"); + "The minimum contiguous integer representable by a double (2^53)"); JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE), - "The maximum contiguous integer represtenable by a double (-(2^53))"); + "The maximum contiguous integer represtenable by a double (-(2^53))"); #ifdef NAN JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN"); #else diff --git a/src/core/pp.c b/src/core/pp.c index 6c10008a..bd3fd8c2 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -227,12 +227,14 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) { } return; case JANET_CFUNCTION: { - Janet check = janet_table_get(janet_vm.registry, x); - if (janet_checktype(check, JANET_SYMBOL)) { + JanetCFunRegistry *reg = janet_registry_get(janet_unwrap_cfunction(x)); + if (NULL != reg) { janet_buffer_push_cstring(buffer, "name_prefix) { + janet_buffer_push_cstring(buffer, reg->name_prefix); + janet_buffer_push_u8(buffer, '/'); + } + janet_buffer_push_cstring(buffer, reg->name); janet_buffer_push_u8(buffer, '>'); break; } diff --git a/src/core/state.h b/src/core/state.h index 9f0ab5f8..b38f4505 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -62,6 +62,19 @@ typedef struct { } 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. */ +typedef struct { + JanetCFunction cfun; + const char *name; + const char *name_prefix; + const char *source_file; + int32_t source_line; + /* int32_t min_arity; */ + /* int32_t max_arity; */ +} JanetCFunRegistry; + struct JanetVM { /* Top level dynamic bindings */ JanetTable *top_dyns; @@ -88,7 +101,10 @@ struct JanetVM { /* The global registry for c functions. Used to store meta-data * along with otherwise bare c function pointers. */ - JanetTable *registry; + JanetCFunRegistry *registry; + size_t registry_cap; + size_t registry_count; + int registry_dirty; /* Registry for abstract abstract types that can be marshalled. * We need this to look up the constructors when unmarshalling. */ diff --git a/src/core/thread.c b/src/core/thread.c index 085660f7..d95f9b2b 100644 --- a/src/core/thread.c +++ b/src/core/thread.c @@ -477,17 +477,6 @@ static int thread_worker(JanetMailboxPair *pair) { janet_gcroot(janet_wrap_table(janet_vm.abstract_registry)); } - /* Unmarshal the normal registry */ - if (pair->flags & JANET_THREAD_CFUNCTIONS) { - 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.registry)); - janet_vm.registry = janet_unwrap_table(reg); - janet_gcroot(janet_wrap_table(janet_vm.registry)); - } - /* Unmarshal the function */ Janet funcv; int status = janet_thread_receive(&funcv, INFINITY); @@ -610,9 +599,9 @@ JANET_CORE_FN(cfun_thread_new, "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\n" - "* :a - Allow sending over registered abstract types to the new thread\n\n" - "* :c - Send over cfunction information to the new thread.\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 */ @@ -642,12 +631,6 @@ JANET_CORE_FN(cfun_thread_new, } } - if (flags & JANET_THREAD_CFUNCTIONS) { - if (janet_thread_send(thread, janet_wrap_table(janet_vm.registry), INFINITY)) { - janet_panic("could not send 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]); diff --git a/src/core/util.c b/src/core/util.c index 32a9b6ea..9ab40309 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -362,13 +362,6 @@ const void *janet_strbinsearch( return NULL; } -/* Register a value in the global registry */ -void janet_register(const char *name, JanetCFunction cfun) { - Janet key = janet_wrap_cfunction(cfun); - Janet value = janet_csymbolv(name); - 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) { @@ -408,109 +401,147 @@ 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 */ -typedef struct { - uint8_t *longname_buffer; - size_t prefixlen; - size_t bufsize; -} JanetNameBuffer; +/* Registry functions */ -static void cfuns_namebuf_init(JanetNameBuffer *nb, const char *regprefix) { - nb->longname_buffer = NULL; - nb->prefixlen = 0; - nb->bufsize = 0; - if (NULL != regprefix) { - nb->prefixlen = strlen(regprefix); - nb->bufsize = nb->prefixlen + 256; - nb->longname_buffer = janet_malloc(nb->bufsize); - if (NULL == nb->longname_buffer) { +/* Put the registry in sorted order. */ +static void janet_registry_sort(void) { + for (size_t i = 1; i < janet_vm.registry_count; i++) { + JanetCFunRegistry reg = janet_vm.registry[i]; + size_t j; + for (j = i; j > 0; j--) { + if (janet_vm.registry[j - 1].cfun < reg.cfun) break; + janet_vm.registry[j] = janet_vm.registry[j - 1]; + } + janet_vm.registry[j] = reg; + } + janet_vm.registry_dirty = 0; +} + +void janet_registry_put( + JanetCFunction key, + const char *name, + const char *name_prefix, + const char *source_file, + int32_t source_line) { + if (janet_vm.registry_count == janet_vm.registry_cap) { + size_t newcap = (janet_vm.registry_count + 1) * 2; + /* Size it nicely with core by default */ + if (newcap < 512) { + newcap = 512; + } + janet_vm.registry = janet_realloc(janet_vm.registry, newcap * sizeof(JanetCFunRegistry)); + if (NULL == janet_vm.registry) { JANET_OUT_OF_MEMORY; } - safe_memcpy(nb->longname_buffer, regprefix, nb->prefixlen); - nb->longname_buffer[nb->prefixlen] = '/'; - nb->prefixlen++; + janet_vm.registry_cap = newcap; } + JanetCFunRegistry value = { + key, + name, + name_prefix, + source_file, + source_line + }; + janet_vm.registry[janet_vm.registry_count++] = value; + janet_vm.registry_dirty = 1; } -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; - } +JanetCFunRegistry *janet_registry_get(JanetCFunction key) { + if (janet_vm.registry_dirty) { + janet_registry_sort(); + } + for (size_t i = 0; i < janet_vm.registry_count; i++) { + if (janet_vm.registry[i].cfun == key) { + return janet_vm.registry + i; } - safe_memcpy(nb->longname_buffer + nb->prefixlen, suffix, nmlen); - return janet_wrap_symbol(janet_symbol(nb->longname_buffer, totallen)); - } else { - return janet_csymbolv(suffix); } + JanetCFunRegistry *lo = janet_vm.registry; + JanetCFunRegistry *hi = lo + janet_vm.registry_count; + while (lo < hi) { + JanetCFunRegistry *mid = lo + (hi - lo) / 2; + if (mid->cfun == key) { + return mid; + } + if (mid->cfun > key) { + hi = mid; + } else { + lo = mid + 1; + } + } + return NULL; } -static void cfuns_namebuf_deinit(JanetNameBuffer *nb) { - janet_free(nb->longname_buffer); +typedef struct { + char *buf; + size_t plen; +} NameBuf; + +static void namebuf_init(NameBuf *namebuf, const char *prefix) { + size_t plen = strlen(prefix); + namebuf->plen = plen; + namebuf->buf = janet_malloc(namebuf->plen + 256); + if (NULL == namebuf->buf) { + JANET_OUT_OF_MEMORY; + } + memcpy(namebuf->buf, prefix, plen); + namebuf->buf[plen] = '/'; } -void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *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(env, cfuns->name, fun, cfuns->documentation); - janet_table_put(janet_vm.registry, fun, name); - cfuns++; +static void namebuf_deinit(NameBuf *namebuf) { + janet_free(namebuf->buf); +} + +static char *namebuf_name(NameBuf *namebuf, const char *suffix) { + size_t slen = strlen(suffix); + namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen); + if (NULL == namebuf->buf) { + JANET_OUT_OF_MEMORY; } - cfuns_namebuf_deinit(&nb); + memcpy(namebuf->buf + namebuf->plen + 1, suffix, slen); + namebuf->buf[namebuf->plen + 1 + slen] = '\0'; + return (char *)(namebuf->buf); } void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *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, NULL, 0); - janet_table_put(env, name, janet_wrap_table(subt)); - janet_table_put(janet_vm.registry, fun, name); + if (env) janet_def(env, cfuns->name, fun, cfuns->documentation); + janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0); 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); + if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line); + janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line); cfuns++; } - cfuns_namebuf_deinit(&nb); +} + +void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { + NameBuf nb; + if (env) namebuf_init(&nb, regprefix); + while (cfuns->name) { + Janet fun = janet_wrap_cfunction(cfuns->cfun); + if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation); + janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0); + cfuns++; + } + if (env) namebuf_deinit(&nb); } void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) { - JanetNameBuffer nb; - cfuns_namebuf_init(&nb, regprefix); + NameBuf nb; + if (env) 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); + if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line); + janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line); cfuns++; } - cfuns_namebuf_deinit(&nb); + if (env) namebuf_deinit(&nb); } /* Abstract type introspection */ @@ -534,35 +565,23 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) { } #ifndef JANET_BOOTSTRAP -void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) { +void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) { + (void) sf; + (void) sl; (void) p; Janet key = janet_csymbolv(name); janet_table_put(env, key, x); if (janet_checktype(x, JANET_CFUNCTION)) { - janet_table_put(janet_vm.registry, x, key); + janet_registry_put(janet_unwrap_cfunction(x), name, NULL, NULL, 0); } } -void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) { - (void) regprefix; - while (cfuns->name) { - Janet fun = janet_wrap_cfunction(cfuns->cfun); - janet_core_def(env, cfuns->name, fun, cfuns->documentation); - cfuns++; - } -} - -void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) { - (void) sf; - (void) 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); + janet_table_put(env, janet_csymbolv(cfuns->name), fun); + janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line); cfuns++; } } diff --git a/src/core/util.h b/src/core/util.h index 7e1abea2..2c7e2a0e 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -26,6 +26,7 @@ #ifndef JANET_AMALG #include "features.h" #include +#include "state.h" #endif #include @@ -52,14 +53,6 @@ if (!(c)) JANET_EXIT((m)); \ } while (0) -/* Omit docstrings in some builds */ -#ifndef JANET_BOOTSTRAP -#define JDOC(x) NULL -#define JANET_NO_BOOTSTRAP -#else -#define JDOC(x) x -#endif - /* Utils */ #define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1)) extern const char janet_base64[65]; @@ -87,22 +80,27 @@ void janet_buffer_format( Janet *argv); Janet janet_next_impl(Janet ds, Janet key, int is_interpreter); +/* Registry functions */ +void janet_registry_put( + JanetCFunction key, + const char *name, + const char *name_prefix, + const char *source_file, + int32_t source_line); +JanetCFunRegistry *janet_registry_get(JanetCFunction key); + /* 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_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_ -#define JANET_CORE_DEF JANET_DEF_ -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); +#define JANET_CORE_REG JANET_REG_S +#define JANET_CORE_FN JANET_FN_S +#define JANET_CORE_DEF(ENV, NAME, X, DOC) janet_core_def_sm(ENV, NAME, X, DOC, NULL, 0) 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 diff --git a/src/core/vm.c b/src/core/vm.c index 175aa0ae..c2c6cb35 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -1525,9 +1525,13 @@ int janet_init(void) { janet_vm.scratch_cap = 0; /* Initialize registry */ - janet_vm.registry = janet_table(0); + janet_vm.registry = NULL; + janet_vm.registry_cap = 0; + janet_vm.registry_count = 0; + janet_vm.registry_dirty = 0; + + /* Intialize abstract registry */ janet_vm.abstract_registry = janet_table(0); - janet_gcroot(janet_wrap_table(janet_vm.registry)); janet_gcroot(janet_wrap_table(janet_vm.abstract_registry)); /* Traversal */ @@ -1579,6 +1583,7 @@ void janet_deinit(void) { janet_free(janet_vm.traversal_base); janet_vm.fiber = NULL; janet_vm.root_fiber = NULL; + janet_free(janet_vm.registry); #ifdef JANET_THREADS janet_threads_deinit(); #endif diff --git a/src/include/janet.h b/src/include/janet.h index 5d8f6913..66322b2b 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1749,7 +1749,6 @@ JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetRe JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns); JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out); JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym); -JANET_API void janet_register(const char *name, JanetCFunction cfun); /* Get values from the core environment. */ JANET_API Janet janet_resolve_core(const char *name);