mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 19:19:53 +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,13 +145,21 @@ 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)
janet_eprintf(" (tailcall)"); janet_eprintf(" (tailcall)");
if (frame->func && frame->pc) { if (frame->func && frame->pc) {
@ -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());

96
src/core/ev.c
View File

@ -723,8 +723,7 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
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)) {
@ -735,8 +734,7 @@ 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;
@ -751,8 +749,7 @@ JANET_CORE_FN(cfun_channel_choice,
"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;
@ -796,8 +793,7 @@ 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);
@ -805,8 +801,7 @@ JANET_CORE_FN(cfun_channel_full,
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);
@ -814,8 +809,7 @@ JANET_CORE_FN(cfun_channel_capacity,
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));
@ -833,8 +827,7 @@ 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);
} }
@ -842,8 +835,7 @@ JANET_CORE_FN(cfun_channel_rchoice,
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));
@ -2150,8 +2142,7 @@ JANET_CORE_FN(cfun_ev_go,
"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) {
/* Set abstract registry */
if (flags & 0x2) {
Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes, Janet aregv = 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(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry");
janet_vm.abstract_registry = janet_unwrap_table(aregv); 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"); /* Set cfunction registry */
janet_vm.registry = janet_unwrap_table(regv); 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,
@ -2209,14 +2221,16 @@ JANET_CORE_FN(cfun_ev_thread,
"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;
@ -2246,8 +2265,7 @@ 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) {
@ -2271,8 +2289,7 @@ 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);
@ -2283,8 +2300,7 @@ JANET_CORE_FN(cfun_ev_deadline,
"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);
@ -2301,8 +2317,7 @@ 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];
@ -2312,8 +2327,7 @@ 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);
@ -2327,8 +2341,7 @@ JANET_CORE_FN(janet_cfun_stream_read,
"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);
@ -2348,8 +2361,7 @@ 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);

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.");
} }

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]);

203
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_OUT_OF_MEMORY;
} }
safe_memcpy(nb->longname_buffer, regprefix, nb->prefixlen); janet_vm.registry[j] = reg;
nb->longname_buffer[nb->prefixlen] = '/';
nb->prefixlen++;
} }
janet_vm.registry_dirty = 0;
} }
static Janet cfuns_namebuf_getname(JanetNameBuffer *nb, const char *suffix) { void janet_registry_put(
if (nb->prefixlen) { JanetCFunction key,
int32_t nmlen = 0; const char *name,
while (suffix[nmlen]) nmlen++; const char *name_prefix,
int32_t totallen = (int32_t) nb->prefixlen + nmlen; const char *source_file,
if ((size_t) totallen > nb->bufsize) { int32_t source_line) {
nb->bufsize = (size_t)(totallen) + 128; if (janet_vm.registry_count == janet_vm.registry_cap) {
nb->longname_buffer = janet_realloc(nb->longname_buffer, nb->bufsize); size_t newcap = (janet_vm.registry_count + 1) * 2;
if (NULL == nb->longname_buffer) { /* 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;
} }
janet_vm.registry_cap = newcap;
} }
safe_memcpy(nb->longname_buffer + nb->prefixlen, suffix, nmlen); JanetCFunRegistry value = {
return janet_wrap_symbol(janet_symbol(nb->longname_buffer, totallen)); key,
name,
name_prefix,
source_file,
source_line
};
janet_vm.registry[janet_vm.registry_count++] = value;
janet_vm.registry_dirty = 1;
}
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;
}
}
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 { } else {
return janet_csymbolv(suffix); 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);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_table_put(janet_vm.registry, fun, name);
cfuns++;
} }
cfuns_namebuf_deinit(&nb);
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;
}
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);