mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

Put source mapping info in stack traces.

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 local-headers
["src/core/util.h"
"src/core/state.h"
["src/core/state.h"
"src/core/util.h"
"src/core/gc.h"
"src/core/vector.h"
"src/core/fiber.h"

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;
#endif
/* Docstrings should only exist during bootstrap */
#ifdef JANET_BOOTSTRAP
#define JDOC(x) (x)
#else
#define JDOC(x) NULL
#endif
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
* with native code. */
#if defined(JANET_NO_DYNAMIC_MODULES)
@ -1207,9 +1214,7 @@ JanetTable *janet_core_lookup_table(JanetTable *replacements) {
JanetKV kv = replacements->data[i];
if (!janet_checktype(kv.key, JANET_NIL)) {
janet_table_put(dict, kv.key, kv.value);
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
janet_table_put(janet_vm.registry, kv.value, kv.key);
}
/* Add replacement functions to registry? */
}
}
}

39
src/core/debug.c
View File

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

208
src/core/ev.c
View File

@ -722,9 +722,8 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
/* Channel Methods */
JANET_CORE_FN(cfun_channel_push,
"(ev/give channel value)",
"Write a value to a channel, suspending the current fiber if the channel is full."
) {
"(ev/give channel value)",
"Write a value to a channel, suspending the current fiber if the channel is full.") {
janet_fixarity(argc, 2);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
if (janet_channel_push(channel, argv[1], 0)) {
@ -733,10 +732,9 @@ JANET_CORE_FN(cfun_channel_push,
return argv[0];
}
JANET_CORE_FN(cfun_channel_pop,
"(ev/take channel)",
"Read from a channel, suspending the current fiber if no value is available."
) {
JANET_CORE_FN(cfun_channel_pop,
"(ev/take channel)",
"Read from a channel, suspending the current fiber if no value is available.") {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
Janet item;
@ -747,12 +745,11 @@ JANET_CORE_FN(cfun_channel_pop,
}
JANET_CORE_FN(cfun_channel_choice,
"(ev/select & clauses)",
"Block until the first of several channel operations occur. Returns a tuple of the form [:give chan] or [:take chan x], where "
"a :give tuple is the result of a write and :take tuple is the result of a write. Each clause must be either a channel (for "
"a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first "
"clauses will take precedence over later clauses."
) {
"(ev/select & clauses)",
"Block until the first of several channel operations occur. Returns a tuple of the form [:give chan] or [:take chan x], where "
"a :give tuple is the result of a write and :take tuple is the result of a write. Each clause must be either a channel (for "
"a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first "
"clauses will take precedence over later clauses.") {
janet_arity(argc, 1, -1);
int32_t len;
const Janet *data;
@ -795,27 +792,24 @@ JANET_CORE_FN(cfun_channel_choice,
}
JANET_CORE_FN(cfun_channel_full,
"(ev/full channel)",
"Check if a channel is full or not."
) {
"(ev/full channel)",
"Check if a channel is full or not.") {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_boolean(janet_q_count(&channel->items) >= channel->limit);
}
JANET_CORE_FN(cfun_channel_capacity,
"(ev/capacity channel)",
"Get the number of items a channel will store before blocking writers."
) {
"(ev/capacity channel)",
"Get the number of items a channel will store before blocking writers.") {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_integer(channel->limit);
}
JANET_CORE_FN(cfun_channel_count,
"(ev/count channel)",
"Get the number of items currently waiting in a channel."
) {
"(ev/count channel)",
"Get the number of items currently waiting in a channel.") {
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getabstract(argv, 0, &ChannelAT);
return janet_wrap_integer(janet_q_count(&channel->items));
@ -832,18 +826,16 @@ static void fisher_yates_args(int32_t argc, Janet *argv) {
}
JANET_CORE_FN(cfun_channel_rchoice,
"(ev/rselect & clauses)",
"Similar to ev/select, but will try clauses in a random order for fairness."
) {
"(ev/rselect & clauses)",
"Similar to ev/select, but will try clauses in a random order for fairness.") {
fisher_yates_args(argc, argv);
return cfun_channel_choice(argc, argv);
}
JANET_CORE_FN(cfun_channel_new,
"(ev/chan &opt capacity)",
"Create a new channel. capacity is the number of values to queue before "
"blocking writers, defaults to 0 if not provided. Returns a new channel."
) {
JANET_CORE_FN(cfun_channel_new,
"(ev/chan &opt capacity)",
"Create a new channel. capacity is the number of values to queue before "
"blocking writers, defaults to 0 if not provided. Returns a new channel.") {
janet_arity(argc, 0, 1);
int32_t limit = janet_optnat(argv, argc, 0, 0);
JanetChannel *channel = janet_abstract(&ChannelAT, sizeof(JanetChannel));
@ -2145,13 +2137,12 @@ error:
/* C functions */
JANET_CORE_FN(cfun_ev_go,
"(ev/go fiber &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. Optionally pass "
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
"An optional `core/channel` can be provided as well as a supervisor. When various "
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
"If not provided, the new fiber will inherit the current supervisor."
) {
"(ev/go fiber &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. Optionally pass "
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
"An optional `core/channel` can be provided as well as a supervisor. When various "
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
"If not provided, the new fiber will inherit the current supervisor.") {
janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
@ -2167,18 +2158,39 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
JanetBuffer *buffer = (JanetBuffer *) args.argp;
const uint8_t *nextbytes = buffer->data;
const uint8_t *endbytes = nextbytes + buffer->count;
uint32_t flags = args.tag;
args.tag = 0;
janet_init();
JanetTryState tstate;
JanetSignal signal = janet_try(&tstate);
if (!signal) {
Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry");
janet_vm.abstract_registry = janet_unwrap_table(aregv);
Janet regv = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
if (!janet_checktype(regv, JANET_TABLE)) janet_panic("expected table for cfunction registry");
janet_vm.registry = janet_unwrap_table(regv);
/* Set abstract registry */
if (flags & 0x2) {
Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry");
janet_vm.abstract_registry = janet_unwrap_table(aregv);
}
/* Set cfunction registry */
if (flags & 0x4) {
uint32_t count1;
memcpy(&count1, nextbytes, sizeof(count1));
size_t count = (size_t) count1;
if (count > (endbytes - nextbytes) * sizeof(JanetCFunRegistry)) {
janet_panic("thread message invalid");
}
janet_vm.registry_count = count;
janet_vm.registry_cap = count;
janet_vm.registry = janet_malloc(count * sizeof(JanetCFunRegistry));
if (janet_vm.registry == NULL) {
JANET_OUT_OF_MEMORY;
}
janet_vm.registry_dirty = 1;
memcpy(janet_vm.registry, nextbytes, count * sizeof(JanetCFunRegistry));
}
Janet fiberv = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
Janet value = janet_unmarshal(nextbytes, endbytes - nextbytes,
@ -2203,20 +2215,22 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
return args;
}
JANET_CORE_FN(cfun_ev_thread,
"(ev/thread fiber &opt value flags)",
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
"to resume with. "
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. "
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
"Otherwise, returns (a copy of) the final result from the fiber on the new thread."
) {
JANET_CORE_FN(cfun_ev_thread,
"(ev/thread fiber &opt value flags)",
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
"to resume with. "
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. "
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
"Otherwise, returns (a copy of) the final result from the fiber on the new thread. Available flags:\n\n"
"* `:n` - return immediately\n"
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
janet_arity(argc, 1, 3);
janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
uint64_t flags = 0;
if (argc >= 3) {
flags = janet_getflags(argv, 2, "n");
flags = janet_getflags(argv, 2, "nac");
}
/* Marshal arguments for the new thread. */
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
@ -2224,14 +2238,19 @@ JANET_CORE_FN(cfun_ev_thread,
JANET_OUT_OF_MEMORY;
}
janet_buffer_init(buffer, 0);
janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
janet_marshal(buffer, janet_wrap_table(janet_vm.registry), NULL, JANET_MARSHAL_UNSAFE);
if (flags & 0x2) janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
if (flags & 0x4) {
janet_assert(janet_vm.registry_count <= UINT32_MAX, "assert failed size check");
uint32_t temp = (uint32_t) janet_vm.registry_count;
janet_buffer_push_bytes(buffer, (uint8_t *) &temp, sizeof(temp));
janet_buffer_push_bytes(buffer, (uint8_t *) janet_vm.registry, janet_vm.registry_count * sizeof(JanetCFunRegistry));
}
janet_marshal(buffer, argv[0], NULL, JANET_MARSHAL_UNSAFE);
janet_marshal(buffer, value, NULL, JANET_MARSHAL_UNSAFE);
if (flags & 0x1) {
/* Return immediately */
JanetEVGenericMessage arguments;
arguments.tag = 0;
arguments.tag = (uint32_t) flags;;
arguments.argi = argc;
arguments.argp = buffer;
arguments.fiber = NULL;
@ -2242,12 +2261,11 @@ JANET_CORE_FN(cfun_ev_thread,
}
}
JANET_CORE_FN(cfun_ev_give_supervisor,
"(ev/give-supervisor tag & payload)",
"Send a message to the current supervior channel if there is one. The message will be a "
"tuple of all of the arguments combined into a single message, where the first element is tag. "
"By convention, tag should be a keyword indicating the type of message. Returns nil."
) {
JANET_CORE_FN(cfun_ev_give_supervisor,
"(ev/give-supervisor tag & payload)",
"Send a message to the current supervior channel if there is one. The message will be a "
"tuple of all of the arguments combined into a single message, where the first element is tag. "
"By convention, tag should be a keyword indicating the type of message. Returns nil.") {
janet_arity(argc, 1, -1);
JanetChannel *chan = janet_vm.root_fiber->supervisor_channel;
if (NULL != chan) {
@ -2270,21 +2288,19 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
}
JANET_CORE_FN(cfun_ev_sleep,
"(ev/sleep sec)",
"Suspend the current fiber for sec seconds without blocking the event loop."
) {
"(ev/sleep sec)",
"Suspend the current fiber for sec seconds without blocking the event loop.") {
janet_fixarity(argc, 1);
double sec = janet_getnumber(argv, 0);
janet_sleep_await(sec);
}
JANET_CORE_FN(cfun_ev_deadline,
"(ev/deadline sec &opt tocancel tocheck)",
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`."
) {
JANET_CORE_FN(cfun_ev_deadline,
"(ev/deadline sec &opt tocancel tocheck)",
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`.") {
janet_arity(argc, 1, 3);
double sec = janet_getnumber(argv, 0);
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber);
@ -2300,9 +2316,8 @@ JANET_CORE_FN(cfun_ev_deadline,
}
JANET_CORE_FN(cfun_ev_cancel,
"(ev/cancel fiber err)",
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately"
) {
"(ev/cancel fiber err)",
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately") {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet err = argv[1];
@ -2310,10 +2325,9 @@ JANET_CORE_FN(cfun_ev_cancel,
return argv[0];
}
JANET_CORE_FN(janet_cfun_stream_close,
"(ev/close stream)",
"Close a stream. This should be the same as calling (:close stream) for all streams."
) {
JANET_CORE_FN(janet_cfun_stream_close,
"(ev/close stream)",
"Close a stream. This should be the same as calling (:close stream) for all streams.") {
janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_close(stream);
@ -2321,14 +2335,13 @@ JANET_CORE_FN(janet_cfun_stream_close,
}
JANET_CORE_FN(janet_cfun_stream_read,
"(ev/read stream n &opt buffer timeout)",
"Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
"`:all` to read into the buffer until end of stream. "
"Optionally provide a buffer to write into "
"as well as a timeout in seconds after which to cancel the operation and raise an error. "
"Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "
"error if there are problems with the IO operation."
) {
"(ev/read stream n &opt buffer timeout)",
"Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
"`:all` to read into the buffer until end of stream. "
"Optionally provide a buffer to write into "
"as well as a timeout in seconds after which to cancel the operation and raise an error. "
"Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "
"error if there are problems with the IO operation.") {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE);
@ -2345,11 +2358,10 @@ JANET_CORE_FN(janet_cfun_stream_read,
janet_await();
}
JANET_CORE_FN(janet_cfun_stream_chunk,
"(ev/chunk stream n &opt buffer timeout)",
"Same as ev/read, but will not return early if less than n bytes are available. If an end of "
"stream is reached, will also return early with the collected bytes."
) {
JANET_CORE_FN(janet_cfun_stream_chunk,
"(ev/chunk stream n &opt buffer timeout)",
"Same as ev/read, but will not return early if less than n bytes are available. If an end of "
"stream is reached, will also return early with the collected bytes.") {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE);
@ -2361,11 +2373,11 @@ JANET_CORE_FN(janet_cfun_stream_chunk,
janet_await();
}
JANET_CORE_FN(janet_cfun_stream_write,
"(ev/write stream data &opt timeout)",
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.") {
JANET_CORE_FN(janet_cfun_stream_write,
"(ev/write stream data &opt timeout)",
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"Returns nil, or raises an error if the write failed.") {
janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_WRITABLE);

12
src/core/io.c
View File

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

70
src/core/math.c
View File

@ -118,11 +118,11 @@ double janet_rng_double(JanetRNG *rng) {
}
JANET_CORE_FN(cfun_rng_make,
"(math/rng &opt seed)",
"Creates a Psuedo-Random number generator, with an optional seed. "
"The seed should be an unsigned 32 bit integer or a buffer. "
"Do not use this for cryptography. Returns a core/rng abstract type."
) {
"(math/rng &opt seed)",
"Creates a Psuedo-Random number generator, with an optional seed. "
"The seed should be an unsigned 32 bit integer or a buffer. "
"Do not use this for cryptography. Returns a core/rng abstract type."
) {
janet_arity(argc, 0, 1);
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
if (argc == 1) {
@ -140,20 +140,20 @@ JANET_CORE_FN(cfun_rng_make,
}
JANET_CORE_FN(cfun_rng_uniform,
"(math/rng-uniform rng)",
"Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1."
) {
"(math/rng-uniform rng)",
"Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1."
) {
janet_fixarity(argc, 1);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
return janet_wrap_number(janet_rng_double(rng));
}
JANET_CORE_FN(cfun_rng_int,
"(math/rng-int rng &opt max)",
"Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1."
) {
JANET_CORE_FN(cfun_rng_int,
"(math/rng-int rng &opt max)",
"Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1."
) {
janet_arity(argc, 1, 2);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
if (argc == 1) {
@ -181,11 +181,11 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
buf[3] = (word >> 24) & 0xFF;
}
JANET_CORE_FN(cfun_rng_buffer,
"(math/rng-buffer rng n &opt buf)",
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
"provided, otherwise appends to the given buffer. Returns the buffer."
) {
JANET_CORE_FN(cfun_rng_buffer,
"(math/rng-buffer rng n &opt buf)",
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
"provided, otherwise appends to the given buffer. Returns the buffer."
) {
janet_arity(argc, 2, 3);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
int32_t n = janet_getnat(argv, 1);
@ -230,20 +230,20 @@ static Janet janet_rng_next(void *p, Janet key) {
}
/* Get a random number */
JANET_CORE_FN(janet_rand,
"(math/random)",
"Returns a uniformly distributed random number between 0 and 1") {
JANET_CORE_FN(janet_rand,
"(math/random)",
"Returns a uniformly distributed random number between 0 and 1") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number(janet_rng_double(&janet_vm.rng));
}
/* Seed the random number generator */
JANET_CORE_FN(janet_srand,
"(math/seedrandom seed)",
"Set the seed for the random number generator. seed should be "
"an integer or a buffer."
) {
JANET_CORE_FN(janet_srand,
"(math/seedrandom seed)",
"Set the seed for the random number generator. seed should be "
"an integer or a buffer."
) {
janet_fixarity(argc, 1);
if (janet_checkint(argv[0])) {
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
@ -360,21 +360,21 @@ void janet_lib_math(JanetTable *env) {
janet_register_abstract_type(&janet_rng_type);
#ifdef JANET_BOOTSTRAP
JANET_CORE_DEF(env, "math/pi", janet_wrap_number(3.1415926535897931),
"The value pi.");
"The value pi.");
JANET_CORE_DEF(env, "math/e", janet_wrap_number(2.7182818284590451),
"The base of the natural log.");
"The base of the natural log.");
JANET_CORE_DEF(env, "math/inf", janet_wrap_number(INFINITY),
"The number representing positive infinity");
"The number representing positive infinity");
JANET_CORE_DEF(env, "math/-inf", janet_wrap_number(-INFINITY),
"The number representing negative infinity");
"The number representing negative infinity");
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
"The minimum contiguous integer representable by a 32 bit signed integer");
"The minimum contiguous integer representable by a 32 bit signed integer");
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
"The maximum contiguous integer represtenable by a 32 bit signed integer");
"The maximum contiguous integer represtenable by a 32 bit signed integer");
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
"The minimum contiguous integer representable by a double (2^53)");
"The minimum contiguous integer representable by a double (2^53)");
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
"The maximum contiguous integer represtenable by a double (-(2^53))");
"The maximum contiguous integer represtenable by a double (-(2^53))");
#ifdef NAN
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN");
#else

12
src/core/pp.c
View File

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

18
src/core/state.h
View File

@ -62,6 +62,19 @@ typedef struct {
} JanetMailboxPair;
#endif
/* Registry table for C functions - containts metadata that can
* be looked up by cfunction pointer. All strings here are pointing to
* static memory not managed by Janet. */
typedef struct {
JanetCFunction cfun;
const char *name;
const char *name_prefix;
const char *source_file;
int32_t source_line;
/* int32_t min_arity; */
/* int32_t max_arity; */
} JanetCFunRegistry;
struct JanetVM {
/* Top level dynamic bindings */
JanetTable *top_dyns;
@ -88,7 +101,10 @@ struct JanetVM {
/* The global registry for c functions. Used to store meta-data
* along with otherwise bare c function pointers. */
JanetTable *registry;
JanetCFunRegistry *registry;
size_t registry_cap;
size_t registry_count;
int registry_dirty;
/* Registry for abstract abstract types that can be marshalled.
* We need this to look up the constructors when unmarshalling. */

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));
}
/* 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 */
Janet funcv;
int status = janet_thread_receive(&funcv, INFINITY);
@ -610,9 +599,9 @@ JANET_CORE_FN(cfun_thread_new,
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
"Can optionally provide flags to the new thread - supported flags are:\n\n"
"* :h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n\n"
"* :a - Allow sending over registered abstract types to the new thread\n\n"
"* :c - Send over cfunction information to the new thread.\n\n"
"* `:h` - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
"* `:a` - Allow sending over registered abstract types to the new thread\n"
"* `:c` - Send over cfunction information to the new thread (no longer supported).\n"
"Returns a handle to the new thread.") {
janet_arity(argc, 1, 3);
/* Just type checking */
@ -642,12 +631,6 @@ JANET_CORE_FN(cfun_thread_new,
}
}
if (flags & JANET_THREAD_CFUNCTIONS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm.registry), INFINITY)) {
janet_panic("could not send registry to thread");
}
}
/* If thread started, send the worker function. */
if (janet_thread_send(thread, argv[0], INFINITY)) {
janet_panicf("could not send worker function %v to thread", argv[0]);

207
src/core/util.c
View File

@ -362,13 +362,6 @@ const void *janet_strbinsearch(
return NULL;
}
/* Register a value in the global registry */
void janet_register(const char *name, JanetCFunction cfun) {
Janet key = janet_wrap_cfunction(cfun);
Janet value = janet_csymbolv(name);
janet_table_put(janet_vm.registry, key, value);
}
/* Add sourcemapping and documentation to a binding table */
static void janet_add_meta(JanetTable *table, const char *doc, const char *source_file, int32_t source_line) {
if (doc) {
@ -408,109 +401,147 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
janet_var_sm(env, name, val, doc, NULL, 0);
}
/* Load many cfunctions at once */
typedef struct {
uint8_t *longname_buffer;
size_t prefixlen;
size_t bufsize;
} JanetNameBuffer;
/* Registry functions */
static void cfuns_namebuf_init(JanetNameBuffer *nb, const char *regprefix) {
nb->longname_buffer = NULL;
nb->prefixlen = 0;
nb->bufsize = 0;
if (NULL != regprefix) {
nb->prefixlen = strlen(regprefix);
nb->bufsize = nb->prefixlen + 256;
nb->longname_buffer = janet_malloc(nb->bufsize);
if (NULL == nb->longname_buffer) {
/* Put the registry in sorted order. */
static void janet_registry_sort(void) {
for (size_t i = 1; i < janet_vm.registry_count; i++) {
JanetCFunRegistry reg = janet_vm.registry[i];
size_t j;
for (j = i; j > 0; j--) {
if (janet_vm.registry[j - 1].cfun < reg.cfun) break;
janet_vm.registry[j] = janet_vm.registry[j - 1];
}
janet_vm.registry[j] = reg;
}
janet_vm.registry_dirty = 0;
}
void janet_registry_put(
JanetCFunction key,
const char *name,
const char *name_prefix,
const char *source_file,
int32_t source_line) {
if (janet_vm.registry_count == janet_vm.registry_cap) {
size_t newcap = (janet_vm.registry_count + 1) * 2;
/* Size it nicely with core by default */
if (newcap < 512) {
newcap = 512;
}
janet_vm.registry = janet_realloc(janet_vm.registry, newcap * sizeof(JanetCFunRegistry));
if (NULL == janet_vm.registry) {
JANET_OUT_OF_MEMORY;
}
safe_memcpy(nb->longname_buffer, regprefix, nb->prefixlen);
nb->longname_buffer[nb->prefixlen] = '/';
nb->prefixlen++;
janet_vm.registry_cap = newcap;
}
JanetCFunRegistry value = {
key,
name,
name_prefix,
source_file,
source_line
};
janet_vm.registry[janet_vm.registry_count++] = value;
janet_vm.registry_dirty = 1;
}
static Janet cfuns_namebuf_getname(JanetNameBuffer *nb, const char *suffix) {
if (nb->prefixlen) {
int32_t nmlen = 0;
while (suffix[nmlen]) nmlen++;
int32_t totallen = (int32_t) nb->prefixlen + nmlen;
if ((size_t) totallen > nb->bufsize) {
nb->bufsize = (size_t)(totallen) + 128;
nb->longname_buffer = janet_realloc(nb->longname_buffer, nb->bufsize);
if (NULL == nb->longname_buffer) {
JANET_OUT_OF_MEMORY;
}
JanetCFunRegistry *janet_registry_get(JanetCFunction key) {
if (janet_vm.registry_dirty) {
janet_registry_sort();
}
for (size_t i = 0; i < janet_vm.registry_count; i++) {
if (janet_vm.registry[i].cfun == key) {
return janet_vm.registry + i;
}
safe_memcpy(nb->longname_buffer + nb->prefixlen, suffix, nmlen);
return janet_wrap_symbol(janet_symbol(nb->longname_buffer, totallen));
} else {
return janet_csymbolv(suffix);
}
JanetCFunRegistry *lo = janet_vm.registry;
JanetCFunRegistry *hi = lo + janet_vm.registry_count;
while (lo < hi) {
JanetCFunRegistry *mid = lo + (hi - lo) / 2;
if (mid->cfun == key) {
return mid;
}
if (mid->cfun > key) {
hi = mid;
} else {
lo = mid + 1;
}
}
return NULL;
}
static void cfuns_namebuf_deinit(JanetNameBuffer *nb) {
janet_free(nb->longname_buffer);
typedef struct {
char *buf;
size_t plen;
} NameBuf;
static void namebuf_init(NameBuf *namebuf, const char *prefix) {
size_t plen = strlen(prefix);
namebuf->plen = plen;
namebuf->buf = janet_malloc(namebuf->plen + 256);
if (NULL == namebuf->buf) {
JANET_OUT_OF_MEMORY;
}
memcpy(namebuf->buf, prefix, plen);
namebuf->buf[plen] = '/';
}
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
JanetNameBuffer nb;
cfuns_namebuf_init(&nb, regprefix);
while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_table_put(janet_vm.registry, fun, name);
cfuns++;
static void namebuf_deinit(NameBuf *namebuf) {
janet_free(namebuf->buf);
}
static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
size_t slen = strlen(suffix);
namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
if (NULL == namebuf->buf) {
JANET_OUT_OF_MEMORY;
}
cfuns_namebuf_deinit(&nb);
memcpy(namebuf->buf + namebuf->plen + 1, suffix, slen);
namebuf->buf[namebuf->plen + 1 + slen] = '\0';
return (char *)(namebuf->buf);
}
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
JanetNameBuffer nb;
cfuns_namebuf_init(&nb, regprefix);
while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
JanetTable *subt = janet_table(2);
janet_table_put(subt, janet_ckeywordv("value"), fun);
janet_add_meta(subt, cfuns->documentation, NULL, 0);
janet_table_put(env, name, janet_wrap_table(subt));
janet_table_put(janet_vm.registry, fun, name);
if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
cfuns++;
}
cfuns_namebuf_deinit(&nb);
}
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
JanetNameBuffer nb;
cfuns_namebuf_init(&nb, regprefix);
while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_table_put(janet_vm.registry, fun, name);
if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
cfuns++;
}
cfuns_namebuf_deinit(&nb);
}
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
NameBuf nb;
if (env) namebuf_init(&nb, regprefix);
while (cfuns->name) {
Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
cfuns++;
}
if (env) namebuf_deinit(&nb);
}
void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
JanetNameBuffer nb;
cfuns_namebuf_init(&nb, regprefix);
NameBuf nb;
if (env) namebuf_init(&nb, regprefix);
while (cfuns->name) {
Janet name = cfuns_namebuf_getname(&nb, cfuns->name);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
JanetTable *subt = janet_table(2);
janet_table_put(subt, janet_ckeywordv("value"), fun);
janet_add_meta(subt, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_table_put(env, name, janet_wrap_table(subt));
janet_table_put(janet_vm.registry, fun, name);
if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
cfuns++;
}
cfuns_namebuf_deinit(&nb);
if (env) namebuf_deinit(&nb);
}
/* Abstract type introspection */
@ -534,35 +565,23 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) {
}
#ifndef JANET_BOOTSTRAP
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) {
(void) sf;
(void) sl;
(void) p;
Janet key = janet_csymbolv(name);
janet_table_put(env, key, x);
if (janet_checktype(x, JANET_CFUNCTION)) {
janet_table_put(janet_vm.registry, x, key);
janet_registry_put(janet_unwrap_cfunction(x), name, NULL, NULL, 0);
}
}
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
(void) regprefix;
while (cfuns->name) {
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
cfuns++;
}
}
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) {
(void) sf;
(void) sl;
janet_core_def(env, name, x, p);
}
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
(void) regprefix;
while (cfuns->name) {
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
janet_table_put(env, janet_csymbolv(cfuns->name), fun);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
cfuns++;
}
}

28
src/core/util.h
View File

@ -26,6 +26,7 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
#include <stdio.h>
@ -52,14 +53,6 @@
if (!(c)) JANET_EXIT((m)); \
} while (0)
/* Omit docstrings in some builds */
#ifndef JANET_BOOTSTRAP
#define JDOC(x) NULL
#define JANET_NO_BOOTSTRAP
#else
#define JDOC(x) x
#endif
/* Utils */
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
extern const char janet_base64[65];
@ -87,22 +80,27 @@ void janet_buffer_format(
Janet *argv);
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
/* Registry functions */
void janet_registry_put(
JanetCFunction key,
const char *name,
const char *name_prefix,
const char *source_file,
int32_t source_line);
JanetCFunRegistry *janet_registry_get(JanetCFunction key);
/* Inside the janet core, defining globals is different
* at bootstrap time and normal runtime */
#ifdef JANET_BOOTSTRAP
#define JANET_CORE_REG JANET_REG
#define JANET_CORE_FN JANET_FN
#define JANET_CORE_DEF JANET_DEF
#define janet_core_def janet_def
#define janet_core_cfuns janet_cfuns
#define janet_core_def_sm janet_def_sm
#define janet_core_cfuns_ext janet_cfuns_ext
#else
#define JANET_CORE_REG JANET_REG_
#define JANET_CORE_FN JANET_FN_
#define JANET_CORE_DEF JANET_DEF_
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
#define JANET_CORE_REG JANET_REG_S
#define JANET_CORE_FN JANET_FN_S
#define JANET_CORE_DEF(ENV, NAME, X, DOC) janet_core_def_sm(ENV, NAME, X, DOC, NULL, 0)
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl);
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
#endif

9
src/core/vm.c
View File

@ -1525,9 +1525,13 @@ int janet_init(void) {
janet_vm.scratch_cap = 0;
/* Initialize registry */
janet_vm.registry = janet_table(0);
janet_vm.registry = NULL;
janet_vm.registry_cap = 0;
janet_vm.registry_count = 0;
janet_vm.registry_dirty = 0;
/* Intialize abstract registry */
janet_vm.abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm.registry));
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
/* Traversal */
@ -1579,6 +1583,7 @@ void janet_deinit(void) {
janet_free(janet_vm.traversal_base);
janet_vm.fiber = NULL;
janet_vm.root_fiber = NULL;
janet_free(janet_vm.registry);
#ifdef JANET_THREADS
janet_threads_deinit();
#endif

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