mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-01 04:19:55 +00:00
Code Issues 1 Releases Wiki Activity

Put source mapping info in stack traces.

Browse Source
This commit is contained in:
Calvin Rose 2021-07-29 21:29:08 -05:00
parent 2f634184f0
commit 7e5f226480
13 changed files with 353 additions and 289 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/boot/boot.janet
View File

@ -3653,8 +3653,8 @@
(def feature-header "src/core/features.h") (def feature-header "src/core/features.h")
(def local-headers (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/gc.h"
"src/core/vector.h" "src/core/vector.h"
"src/core/fiber.h" "src/core/fiber.h"

11
src/core/corelib.c
View File

@ -35,6 +35,13 @@ extern const unsigned char *janet_core_image;
extern size_t janet_core_image_size; extern size_t janet_core_image_size;
#endif #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 /* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
* with native code. */ * with native code. */
#if defined(JANET_NO_DYNAMIC_MODULES) #if defined(JANET_NO_DYNAMIC_MODULES)
@ -1207,9 +1214,7 @@ JanetTable *janet_core_lookup_table(JanetTable *replacements) {
JanetKV kv = replacements->data[i]; JanetKV kv = replacements->data[i];
if (!janet_checktype(kv.key, JANET_NIL)) { if (!janet_checktype(kv.key, JANET_NIL)) {
janet_table_put(dict, kv.key, kv.value); janet_table_put(dict, kv.key, kv.value);
if (janet_checktype(kv.value, JANET_CFUNCTION)) { /* Add replacement functions to registry? */
janet_table_put(janet_vm.registry, kv.value, kv.key);
}
} }
} }
} }

39
src/core/debug.c
View File

@ -118,6 +118,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
fiber = fibers[fi]; fiber = fibers[fi];
int32_t i = fiber->frame; int32_t i = fiber->frame;
while (i > 0) { while (i > 0) {
JanetCFunRegistry *reg = NULL;
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE); JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
JanetFuncDef *def = NULL; JanetFuncDef *def = NULL;
i = frame->prevframe; i = frame->prevframe;
@ -144,11 +145,19 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
} else { } else {
JanetCFunction cfun = (JanetCFunction)(frame->pc); JanetCFunction cfun = (JanetCFunction)(frame->pc);
if (cfun) { if (cfun) {
Janet name = janet_table_get(janet_vm.registry, janet_wrap_cfunction(cfun)); reg = janet_registry_get(cfun);
if (!janet_checktype(name, JANET_NIL)) if (NULL != reg && NULL != reg->name) {
janet_eprintf(" %s", (const char *)janet_to_string(name)); if (reg->name_prefix) {
else 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(" <cfunction>"); janet_eprintf(" <cfunction>");
}
} }
} }
if (frame->flags & JANET_STACKFRAME_TAILCALL) if (frame->flags & JANET_STACKFRAME_TAILCALL)
@ -161,6 +170,11 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
} else { } else {
janet_eprintf(" pc=%d", off); 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"); janet_eprintf("\n");
} }
@ -273,9 +287,20 @@ static Janet doframe(JanetStackFrame *frame) {
} else { } else {
JanetCFunction cfun = (JanetCFunction)(frame->pc); JanetCFunction cfun = (JanetCFunction)(frame->pc);
if (cfun) { if (cfun) {
Janet name = janet_table_get(janet_vm.registry, janet_wrap_cfunction(cfun)); JanetCFunRegistry *reg = janet_registry_get(cfun);
if (!janet_checktype(name, JANET_NIL)) { if (NULL != reg->name) {
janet_table_put(t, janet_ckeywordv("name"), 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()); janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());

192
src/core/ev.c
View File

@ -722,9 +722,8 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
/* Channel Methods */ /* Channel Methods */
JANET_CORE_FN(cfun_channel_push, JANET_CORE_FN(cfun_channel_push,
"(ev/give channel value)", "(ev/give channel value)",
"Write a value to a channel, suspending the current fiber if the channel is full." "Write a value to a channel, suspending the current fiber if the channel is full.") {
) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
if (janet_channel_push(channel, argv[1], 0)) { if (janet_channel_push(channel, argv[1], 0)) {
@ -734,9 +733,8 @@ JANET_CORE_FN(cfun_channel_push,
} }
JANET_CORE_FN(cfun_channel_pop, JANET_CORE_FN(cfun_channel_pop,
"(ev/take channel)", "(ev/take channel)",
"Read from a channel, suspending the current fiber if no value is available." "Read from a channel, suspending the current fiber if no value is available.") {
) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
Janet item; Janet item;
@ -747,12 +745,11 @@ JANET_CORE_FN(cfun_channel_pop,
} }
JANET_CORE_FN(cfun_channel_choice, JANET_CORE_FN(cfun_channel_choice,
"(ev/select & 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 " "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 :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 " "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." "clauses will take precedence over later clauses.") {
) {
janet_arity(argc, 1, -1); janet_arity(argc, 1, -1);
int32_t len; int32_t len;
const Janet *data; const Janet *data;
@ -795,27 +792,24 @@ JANET_CORE_FN(cfun_channel_choice,
} }
JANET_CORE_FN(cfun_channel_full, JANET_CORE_FN(cfun_channel_full,
"(ev/full channel)", "(ev/full channel)",
"Check if a channel is full or not." "Check if a channel is full or not.") {
) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_boolean(janet_q_count(&channel->items) >= channel->limit); return janet_wrap_boolean(janet_q_count(&channel->items) >= channel->limit);
} }
JANET_CORE_FN(cfun_channel_capacity, JANET_CORE_FN(cfun_channel_capacity,
"(ev/capacity channel)", "(ev/capacity channel)",
"Get the number of items a channel will store before blocking writers." "Get the number of items a channel will store before blocking writers.") {
) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_integer(channel->limit); return janet_wrap_integer(channel->limit);
} }
JANET_CORE_FN(cfun_channel_count, JANET_CORE_FN(cfun_channel_count,
"(ev/count channel)", "(ev/count channel)",
"Get the number of items currently waiting in a channel." "Get the number of items currently waiting in a channel.") {
) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT); JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_integer(janet_q_count(&channel->items)); 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, JANET_CORE_FN(cfun_channel_rchoice,
"(ev/rselect & clauses)", "(ev/rselect & clauses)",
"Similar to ev/select, but will try clauses in a random order for fairness." "Similar to ev/select, but will try clauses in a random order for fairness.") {
) {
fisher_yates_args(argc, argv); fisher_yates_args(argc, argv);
return cfun_channel_choice(argc, argv); return cfun_channel_choice(argc, argv);
} }
JANET_CORE_FN(cfun_channel_new, JANET_CORE_FN(cfun_channel_new,
"(ev/chan &opt capacity)", "(ev/chan &opt capacity)",
"Create a new channel. capacity is the number of values to queue before " "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." "blocking writers, defaults to 0 if not provided. Returns a new channel.") {
) {
janet_arity(argc, 0, 1); janet_arity(argc, 0, 1);
int32_t limit = janet_optnat(argv, argc, 0, 0); int32_t limit = janet_optnat(argv, argc, 0, 0);
JanetChannel *channel = janet_abstract(&ChannelAT, sizeof(JanetChannel)); JanetChannel *channel = janet_abstract(&ChannelAT, sizeof(JanetChannel));
@ -2145,13 +2137,12 @@ error:
/* C functions */ /* C functions */
JANET_CORE_FN(cfun_ev_go, JANET_CORE_FN(cfun_ev_go,
"(ev/go fiber &opt value supervisor)", "(ev/go fiber &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. Optionally pass " "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. " "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 " "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. " "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." "If not provided, the new fiber will inherit the current supervisor.") {
) {
janet_arity(argc, 1, 3); janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0); JanetFiber *fiber = janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil(); 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; JanetBuffer *buffer = (JanetBuffer *) args.argp;
const uint8_t *nextbytes = buffer->data; const uint8_t *nextbytes = buffer->data;
const uint8_t *endbytes = nextbytes + buffer->count; const uint8_t *endbytes = nextbytes + buffer->count;
uint32_t flags = args.tag;
args.tag = 0;
janet_init(); janet_init();
JanetTryState tstate; JanetTryState tstate;
JanetSignal signal = janet_try(&tstate); JanetSignal signal = janet_try(&tstate);
if (!signal) { if (!signal) {
Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes); /* Set abstract registry */
if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry"); if (flags & 0x2) {
janet_vm.abstract_registry = janet_unwrap_table(aregv); Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes,
Janet regv = janet_unmarshal(nextbytes, endbytes - nextbytes, JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
JANET_MARSHAL_UNSAFE, NULL, &nextbytes); if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry");
if (!janet_checktype(regv, JANET_TABLE)) janet_panic("expected table for cfunction registry"); janet_vm.abstract_registry = janet_unwrap_table(aregv);
janet_vm.registry = janet_unwrap_table(regv); }
/* 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 fiberv = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes); JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
Janet value = janet_unmarshal(nextbytes, endbytes - nextbytes, Janet value = janet_unmarshal(nextbytes, endbytes - nextbytes,
@ -2204,19 +2216,21 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
} }
JANET_CORE_FN(cfun_ev_thread, JANET_CORE_FN(cfun_ev_thread,
"(ev/thread fiber &opt value flags)", "(ev/thread fiber &opt value flags)",
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` " "Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
"to resume with. " "to resume with. "
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. " "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. " "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." "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_arity(argc, 1, 3);
janet_getfiber(argv, 0); janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil(); Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
uint64_t flags = 0; uint64_t flags = 0;
if (argc >= 3) { if (argc >= 3) {
flags = janet_getflags(argv, 2, "n"); flags = janet_getflags(argv, 2, "nac");
} }
/* Marshal arguments for the new thread. */ /* Marshal arguments for the new thread. */
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer)); JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
@ -2224,14 +2238,19 @@ JANET_CORE_FN(cfun_ev_thread,
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
} }
janet_buffer_init(buffer, 0); janet_buffer_init(buffer, 0);
janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE); if (flags & 0x2) 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 & 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, argv[0], NULL, JANET_MARSHAL_UNSAFE);
janet_marshal(buffer, value, NULL, JANET_MARSHAL_UNSAFE); janet_marshal(buffer, value, NULL, JANET_MARSHAL_UNSAFE);
if (flags & 0x1) { if (flags & 0x1) {
/* Return immediately */ /* Return immediately */
JanetEVGenericMessage arguments; JanetEVGenericMessage arguments;
arguments.tag = 0; arguments.tag = (uint32_t) flags;;
arguments.argi = argc; arguments.argi = argc;
arguments.argp = buffer; arguments.argp = buffer;
arguments.fiber = NULL; arguments.fiber = NULL;
@ -2243,11 +2262,10 @@ JANET_CORE_FN(cfun_ev_thread,
} }
JANET_CORE_FN(cfun_ev_give_supervisor, JANET_CORE_FN(cfun_ev_give_supervisor,
"(ev/give-supervisor tag & payload)", "(ev/give-supervisor tag & payload)",
"Send a message to the current supervior channel if there is one. The message will be a " "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. " "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." "By convention, tag should be a keyword indicating the type of message. Returns nil.") {
) {
janet_arity(argc, 1, -1); janet_arity(argc, 1, -1);
JanetChannel *chan = janet_vm.root_fiber->supervisor_channel; JanetChannel *chan = janet_vm.root_fiber->supervisor_channel;
if (NULL != chan) { if (NULL != chan) {
@ -2270,21 +2288,19 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
} }
JANET_CORE_FN(cfun_ev_sleep, JANET_CORE_FN(cfun_ev_sleep,
"(ev/sleep sec)", "(ev/sleep sec)",
"Suspend the current fiber for sec seconds without blocking the event loop." "Suspend the current fiber for sec seconds without blocking the event loop.") {
) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
double sec = janet_getnumber(argv, 0); double sec = janet_getnumber(argv, 0);
janet_sleep_await(sec); janet_sleep_await(sec);
} }
JANET_CORE_FN(cfun_ev_deadline, JANET_CORE_FN(cfun_ev_deadline,
"(ev/deadline sec &opt tocancel tocheck)", "(ev/deadline sec &opt tocancel tocheck)",
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, " "Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. " "`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and " "If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`." "`(fiber/current)` respectively. Returns `tocancel`.") {
) {
janet_arity(argc, 1, 3); janet_arity(argc, 1, 3);
double sec = janet_getnumber(argv, 0); double sec = janet_getnumber(argv, 0);
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber); 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, JANET_CORE_FN(cfun_ev_cancel,
"(ev/cancel fiber err)", "(ev/cancel fiber err)",
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately" "Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately") {
) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0); JanetFiber *fiber = janet_getfiber(argv, 0);
Janet err = argv[1]; Janet err = argv[1];
@ -2311,9 +2326,8 @@ JANET_CORE_FN(cfun_ev_cancel,
} }
JANET_CORE_FN(janet_cfun_stream_close, JANET_CORE_FN(janet_cfun_stream_close,
"(ev/close stream)", "(ev/close stream)",
"Close a stream. This should be the same as calling (:close stream) for all streams." "Close a stream. This should be the same as calling (:close stream) for all streams.") {
) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_close(stream); janet_stream_close(stream);
@ -2321,14 +2335,13 @@ JANET_CORE_FN(janet_cfun_stream_close,
} }
JANET_CORE_FN(janet_cfun_stream_read, JANET_CORE_FN(janet_cfun_stream_read,
"(ev/read stream n &opt buffer timeout)", "(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 " "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. " "`:all` to read into the buffer until end of stream. "
"Optionally provide a buffer to write into " "Optionally provide a buffer to write into "
"as well as a timeout in seconds after which to cancel the operation and raise an error. " "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 " "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." "error if there are problems with the IO operation.") {
) {
janet_arity(argc, 2, 4); janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE); janet_stream_flags(stream, JANET_STREAM_READABLE);
@ -2346,10 +2359,9 @@ JANET_CORE_FN(janet_cfun_stream_read,
} }
JANET_CORE_FN(janet_cfun_stream_chunk, JANET_CORE_FN(janet_cfun_stream_chunk,
"(ev/chunk stream n &opt buffer timeout)", "(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 " "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." "stream is reached, will also return early with the collected bytes.") {
) {
janet_arity(argc, 2, 4); janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE); janet_stream_flags(stream, JANET_STREAM_READABLE);
@ -2362,10 +2374,10 @@ JANET_CORE_FN(janet_cfun_stream_chunk,
} }
JANET_CORE_FN(janet_cfun_stream_write, JANET_CORE_FN(janet_cfun_stream_write,
"(ev/write stream data &opt timeout)", "(ev/write stream data &opt timeout)",
"Write data to a stream, suspending the current fiber until the write " "Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. " "completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.") { "Returns nil, or raises an error if the write failed.") {
janet_arity(argc, 2, 3); janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_WRITABLE); janet_stream_flags(stream, JANET_STREAM_WRITABLE);

12
src/core/io.c
View File

@ -798,16 +798,16 @@ void janet_lib_io(JanetTable *env) {
janet_register_abstract_type(&janet_file_type); janet_register_abstract_type(&janet_file_type);
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE; int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
/* stdout */ /* stdout */
janet_core_def(env, "stdout", JANET_CORE_DEF(env, "stdout",
janet_makefile(stdout, JANET_FILE_APPEND | default_flags), janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
JDOC("The standard output file.")); "The standard output file.");
/* stderr */ /* stderr */
janet_core_def(env, "stderr", JANET_CORE_DEF(env, "stderr",
janet_makefile(stderr, JANET_FILE_APPEND | default_flags), janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
JDOC("The standard error file.")); "The standard error file.");
/* stdin */ /* stdin */
janet_core_def(env, "stdin", JANET_CORE_DEF(env, "stdin",
janet_makefile(stdin, JANET_FILE_READ | default_flags), janet_makefile(stdin, JANET_FILE_READ | default_flags),
JDOC("The standard input file.")); "The standard input file.");
} }

62
src/core/math.c
View File

@ -118,11 +118,11 @@ double janet_rng_double(JanetRNG *rng) {
} }
JANET_CORE_FN(cfun_rng_make, JANET_CORE_FN(cfun_rng_make,
"(math/rng &opt seed)", "(math/rng &opt seed)",
"Creates a Psuedo-Random number generator, with an optional seed. " "Creates a Psuedo-Random number generator, with an optional seed. "
"The seed should be an unsigned 32 bit integer or a buffer. " "The seed should be an unsigned 32 bit integer or a buffer. "
"Do not use this for cryptography. Returns a core/rng abstract type." "Do not use this for cryptography. Returns a core/rng abstract type."
) { ) {
janet_arity(argc, 0, 1); janet_arity(argc, 0, 1);
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG)); JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
if (argc == 1) { if (argc == 1) {
@ -140,20 +140,20 @@ JANET_CORE_FN(cfun_rng_make,
} }
JANET_CORE_FN(cfun_rng_uniform, JANET_CORE_FN(cfun_rng_uniform,
"(math/rng-uniform rng)", "(math/rng-uniform rng)",
"Extract a random random integer in the range [0, max] from the RNG. If " "Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1." "no max is given, the default is 2^31 - 1."
) { ) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
return janet_wrap_number(janet_rng_double(rng)); return janet_wrap_number(janet_rng_double(rng));
} }
JANET_CORE_FN(cfun_rng_int, JANET_CORE_FN(cfun_rng_int,
"(math/rng-int rng &opt max)", "(math/rng-int rng &opt max)",
"Extract a random random integer in the range [0, max] from the RNG. If " "Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1." "no max is given, the default is 2^31 - 1."
) { ) {
janet_arity(argc, 1, 2); janet_arity(argc, 1, 2);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
if (argc == 1) { if (argc == 1) {
@ -182,10 +182,10 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
} }
JANET_CORE_FN(cfun_rng_buffer, JANET_CORE_FN(cfun_rng_buffer,
"(math/rng-buffer rng n &opt buf)", "(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 " "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." "provided, otherwise appends to the given buffer. Returns the buffer."
) { ) {
janet_arity(argc, 2, 3); janet_arity(argc, 2, 3);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type); JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
int32_t n = janet_getnat(argv, 1); int32_t n = janet_getnat(argv, 1);
@ -231,8 +231,8 @@ static Janet janet_rng_next(void *p, Janet key) {
/* Get a random number */ /* Get a random number */
JANET_CORE_FN(janet_rand, JANET_CORE_FN(janet_rand,
"(math/random)", "(math/random)",
"Returns a uniformly distributed random number between 0 and 1") { "Returns a uniformly distributed random number between 0 and 1") {
(void) argv; (void) argv;
janet_fixarity(argc, 0); janet_fixarity(argc, 0);
return janet_wrap_number(janet_rng_double(&janet_vm.rng)); return janet_wrap_number(janet_rng_double(&janet_vm.rng));
@ -240,10 +240,10 @@ JANET_CORE_FN(janet_rand,
/* Seed the random number generator */ /* Seed the random number generator */
JANET_CORE_FN(janet_srand, JANET_CORE_FN(janet_srand,
"(math/seedrandom seed)", "(math/seedrandom seed)",
"Set the seed for the random number generator. seed should be " "Set the seed for the random number generator. seed should be "
"an integer or a buffer." "an integer or a buffer."
) { ) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
if (janet_checkint(argv[0])) { if (janet_checkint(argv[0])) {
uint32_t seed = (uint32_t)(janet_getinteger(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); janet_register_abstract_type(&janet_rng_type);
#ifdef JANET_BOOTSTRAP #ifdef JANET_BOOTSTRAP
JANET_CORE_DEF(env, "math/pi", janet_wrap_number(3.1415926535897931), 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), 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), 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), 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), 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), 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), 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), 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 #ifdef NAN
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN"); JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN");
#else #else

12
src/core/pp.c
View File

@ -227,12 +227,14 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
} }
return; return;
case JANET_CFUNCTION: { case JANET_CFUNCTION: {
Janet check = janet_table_get(janet_vm.registry, x); JanetCFunRegistry *reg = janet_registry_get(janet_unwrap_cfunction(x));
if (janet_checktype(check, JANET_SYMBOL)) { if (NULL != reg) {
janet_buffer_push_cstring(buffer, "<cfunction "); janet_buffer_push_cstring(buffer, "<cfunction ");
janet_buffer_push_bytes(buffer, if (NULL != reg->name_prefix) {
janet_unwrap_symbol(check), janet_buffer_push_cstring(buffer, reg->name_prefix);
janet_string_length(janet_unwrap_symbol(check))); janet_buffer_push_u8(buffer, '/');
}
janet_buffer_push_cstring(buffer, reg->name);
janet_buffer_push_u8(buffer, '>'); janet_buffer_push_u8(buffer, '>');
break; break;
} }

18
src/core/state.h
View File

@ -62,6 +62,19 @@ typedef struct {
} JanetMailboxPair; } JanetMailboxPair;
#endif #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 { struct JanetVM {
/* Top level dynamic bindings */ /* Top level dynamic bindings */
JanetTable *top_dyns; JanetTable *top_dyns;
@ -88,7 +101,10 @@ struct JanetVM {
/* The global registry for c functions. Used to store meta-data /* The global registry for c functions. Used to store meta-data
* along with otherwise bare c function pointers. */ * 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. /* Registry for abstract abstract types that can be marshalled.
* We need this to look up the constructors when unmarshalling. */ * We need this to look up the constructors when unmarshalling. */

23
src/core/thread.c
View File

@ -477,17 +477,6 @@ static int thread_worker(JanetMailboxPair *pair) {
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry)); 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(&reg, 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 */ /* Unmarshal the function */
Janet funcv; Janet funcv;
int status = janet_thread_receive(&funcv, INFINITY); 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. " "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. " "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" "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" "* `: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\n" "* `:a` - Allow sending over registered abstract types to the new thread\n"
"* :c - Send over cfunction information to the new thread.\n\n" "* `:c` - Send over cfunction information to the new thread (no longer supported).\n"
"Returns a handle to the new thread.") { "Returns a handle to the new thread.") {
janet_arity(argc, 1, 3); janet_arity(argc, 1, 3);
/* Just type checking */ /* 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 thread started, send the worker function. */
if (janet_thread_send(thread, argv[0], INFINITY)) { if (janet_thread_send(thread, argv[0], INFINITY)) {
janet_panicf("could not send worker function %v to thread", argv[0]); janet_panicf("could not send worker function %v to thread", argv[0]);

207
src/core/util.c
View File

@ -362,13 +362,6 @@ const void *janet_strbinsearch(
return NULL; 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 */ /* 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) { static void janet_add_meta(JanetTable *table, const char *doc, const char *source_file, int32_t source_line) {
if (doc) { 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); janet_var_sm(env, name, val, doc, NULL, 0);
} }
/* Load many cfunctions at once */ /* Registry functions */
typedef struct {
uint8_t *longname_buffer;
size_t prefixlen;
size_t bufsize;
} JanetNameBuffer;
static void cfuns_namebuf_init(JanetNameBuffer *nb, const char *regprefix) { /* Put the registry in sorted order. */
nb->longname_buffer = NULL; static void janet_registry_sort(void) {
nb->prefixlen = 0; for (size_t i = 1; i < janet_vm.registry_count; i++) {
nb->bufsize = 0; JanetCFunRegistry reg = janet_vm.registry[i];
if (NULL != regprefix) { size_t j;
nb->prefixlen = strlen(regprefix); for (j = i; j > 0; j--) {
nb->bufsize = nb->prefixlen + 256; if (janet_vm.registry[j - 1].cfun < reg.cfun) break;
nb->longname_buffer = janet_malloc(nb->bufsize); janet_vm.registry[j] = janet_vm.registry[j - 1];
if (NULL == nb->longname_buffer) { }
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; JANET_OUT_OF_MEMORY;
} }
safe_memcpy(nb->longname_buffer, regprefix, nb->prefixlen); janet_vm.registry_cap = newcap;
nb->longname_buffer[nb->prefixlen] = '/';
nb->prefixlen++;
} }
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) { JanetCFunRegistry *janet_registry_get(JanetCFunction key) {
if (nb->prefixlen) { if (janet_vm.registry_dirty) {
int32_t nmlen = 0; janet_registry_sort();
while (suffix[nmlen]) nmlen++; }
int32_t totallen = (int32_t) nb->prefixlen + nmlen; for (size_t i = 0; i < janet_vm.registry_count; i++) {
if ((size_t) totallen > nb->bufsize) { if (janet_vm.registry[i].cfun == key) {
nb->bufsize = (size_t)(totallen) + 128; return janet_vm.registry + i;
nb->longname_buffer = janet_realloc(nb->longname_buffer, nb->bufsize);
if (NULL == nb->longname_buffer) {
JANET_OUT_OF_MEMORY;
}
} }
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) { typedef struct {
janet_free(nb->longname_buffer); 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) { static void namebuf_deinit(NameBuf *namebuf) {
JanetNameBuffer nb; janet_free(namebuf->buf);
cfuns_namebuf_init(&nb, regprefix); }
while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name); static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
Janet fun = janet_wrap_cfunction(cfuns->cfun); size_t slen = strlen(suffix);
janet_def(env, cfuns->name, fun, cfuns->documentation); namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
janet_table_put(janet_vm.registry, fun, name); if (NULL == namebuf->buf) {
cfuns++; 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) { void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
JanetNameBuffer nb;
cfuns_namebuf_init(&nb, regprefix);
while (cfuns->name) { while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name);
Janet fun = janet_wrap_cfunction(cfuns->cfun); Janet fun = janet_wrap_cfunction(cfuns->cfun);
JanetTable *subt = janet_table(2); if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_table_put(subt, janet_ckeywordv("value"), fun); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
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++;
} }
cfuns_namebuf_deinit(&nb);
} }
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) { void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
JanetNameBuffer nb;
cfuns_namebuf_init(&nb, regprefix);
while (cfuns->name) { while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name);
Janet fun = janet_wrap_cfunction(cfuns->cfun); Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line); if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_table_put(janet_vm.registry, fun, name); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
cfuns++; 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) { void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
JanetNameBuffer nb; NameBuf nb;
cfuns_namebuf_init(&nb, regprefix); if (env) namebuf_init(&nb, regprefix);
while (cfuns->name) { while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name);
Janet fun = janet_wrap_cfunction(cfuns->cfun); Janet fun = janet_wrap_cfunction(cfuns->cfun);
JanetTable *subt = janet_table(2); if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_table_put(subt, janet_ckeywordv("value"), fun); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
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++;
} }
cfuns_namebuf_deinit(&nb); if (env) namebuf_deinit(&nb);
} }
/* Abstract type introspection */ /* Abstract type introspection */
@ -534,35 +565,23 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) {
} }
#ifndef JANET_BOOTSTRAP #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; (void) p;
Janet key = janet_csymbolv(name); Janet key = janet_csymbolv(name);
janet_table_put(env, key, x); janet_table_put(env, key, x);
if (janet_checktype(x, JANET_CFUNCTION)) { 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 janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
(void) regprefix; (void) regprefix;
while (cfuns->name) { while (cfuns->name) {
Janet fun = janet_wrap_cfunction(cfuns->cfun); 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++; cfuns++;
} }
} }

28
src/core/util.h
View File

@ -26,6 +26,7 @@
#ifndef JANET_AMALG #ifndef JANET_AMALG
#include "features.h" #include "features.h"
#include <janet.h> #include <janet.h>
#include "state.h"
#endif #endif
#include <stdio.h> #include <stdio.h>
@ -52,14 +53,6 @@
if (!(c)) JANET_EXIT((m)); \ if (!(c)) JANET_EXIT((m)); \
} while (0) } 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 */ /* Utils */
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1)) #define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
extern const char janet_base64[65]; extern const char janet_base64[65];
@ -87,22 +80,27 @@ void janet_buffer_format(
Janet *argv); Janet *argv);
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter); 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 /* Inside the janet core, defining globals is different
* at bootstrap time and normal runtime */ * at bootstrap time and normal runtime */
#ifdef JANET_BOOTSTRAP #ifdef JANET_BOOTSTRAP
#define JANET_CORE_REG JANET_REG #define JANET_CORE_REG JANET_REG
#define JANET_CORE_FN JANET_FN #define JANET_CORE_FN JANET_FN
#define JANET_CORE_DEF JANET_DEF #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_def_sm janet_def_sm
#define janet_core_cfuns_ext janet_cfuns_ext #define janet_core_cfuns_ext janet_cfuns_ext
#else #else
#define JANET_CORE_REG JANET_REG_ #define JANET_CORE_REG JANET_REG_S
#define JANET_CORE_FN JANET_FN_ #define JANET_CORE_FN JANET_FN_S
#define JANET_CORE_DEF JANET_DEF_ #define JANET_CORE_DEF(ENV, NAME, X, DOC) janet_core_def_sm(ENV, NAME, X, DOC, NULL, 0)
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_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); void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
#endif #endif

9
src/core/vm.c
View File

@ -1525,9 +1525,13 @@ int janet_init(void) {
janet_vm.scratch_cap = 0; janet_vm.scratch_cap = 0;
/* Initialize registry */ /* 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_vm.abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm.registry));
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry)); janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
/* Traversal */ /* Traversal */
@ -1579,6 +1583,7 @@ void janet_deinit(void) {
janet_free(janet_vm.traversal_base); janet_free(janet_vm.traversal_base);
janet_vm.fiber = NULL; janet_vm.fiber = NULL;
janet_vm.root_fiber = NULL; janet_vm.root_fiber = NULL;
janet_free(janet_vm.registry);
#ifdef JANET_THREADS #ifdef JANET_THREADS
janet_threads_deinit(); janet_threads_deinit();
#endif #endif

1
src/include/janet.h
View File

@ -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 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 JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym); 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. */ /* Get values from the core environment. */
JANET_API Janet janet_resolve_core(const char *name); JANET_API Janet janet_resolve_core(const char *name);