calog/src/janet/janetAdapter.c

915 lines
36 KiB
C

// janetAdapter.c -- Janet engine adapter for the broker.
//
// Each calog context owns a thread-local Janet VM (janet_init/janet_deinit on the context thread;
// the whole Janet state is a JANET_THREAD_LOCAL janet_vm, so N contexts are N independent VMs).
// Values marshal both ways through CalogValueT. Janet has no separate integer engine type at the
// script level worth preserving past 2^53, so calog ints cross as doubles (janet_wrap_number) --
// like Lua/JS/Wren -- and a number egresses through the canonical double classifier. Strings are
// length-prefixed and binary-safe; nil round-trips.
//
// Callables ride on Janet's callable-abstract mechanism (JanetAbstractType.call): a Janet C function
// carries no user data and so cannot bind a native name, so an exposed native (gNativeType) and a
// foreign CalogFnT pushed in (gForeignType) are each a small abstract whose .call handler dispatches
// (calogCall by name, or calogFnInvoke) and whose .gc handler frees the binding. A Janet function
// handed OUT becomes a CalogFnT that janet_gcroots the function so the GC keeps it alive until the
// callable is released (janetScriptRelease, on the owner thread).
//
// Error model: a failed native/marshal calls janet_panic (a longjmp out of the C frame back to the
// nearest fiber). Because janet_panic never returns, every handler frees the heap CalogValueT
// arguments it owns and copies any message into a stack buffer BEFORE panicking. Janet only collects
// at VM instruction boundaries, so C-side marshalling never races the GC; the one value that must
// survive across VM calls (a Janet function out) is explicitly gcrooted.
#define _POSIX_C_SOURCE 200809L
#include "janetAdapter.h"
#include "janet.h"
#include <pthread.h>
#include <stdatomic.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
// Starting size of the buffer that captures what janet_dobytes reports (an error line plus a stack
// trace). It grows as needed, so this only saves a few early reallocations.
#define JANET_ERROR_CAPTURE_CAP 256
struct CalogJanetT {
JanetTable *env;
CalogT *broker;
uint64_t ctxId;
CalogLimitStateT *limits; // sandbox limits (mem cap + deadline), or NULL if unlimited
JanetVM *janetVm; // this context's thread-local VM, for the watchdog's interrupt
pthread_t watchdog; // deadline watchdog thread (only when time-limited)
bool hasWatchdog;
_Atomic bool wdStop; // asks the watchdog to exit
};
// Per-allocation header: block size and the context it is charged to (NULL if allocated while
// unlimited, e.g. the base VM before the cap is armed -- so its later free never drives memUsed
// negative). Mirrors the mruby adapter's header allocator.
typedef struct JanetAllocHdrT {
size_t size;
CalogLimitStateT *owner;
} JanetAllocHdrT;
// The limit state and VM of the Janet context on THIS thread (each owns its thread), plus a
// one-shot guard so an over-cap run interrupts the VM only once. Janet's allocator is reached
// through global macros with no VM argument, so it resolves the running context here.
static _Thread_local CalogLimitStateT *gJanetLimits = NULL;
static _Thread_local JanetVM *gJanetVm = NULL;
static _Thread_local bool gJanetInterrupted = false;
// Backs an exposed broker native: an abstract whose .call dispatches through calogCall by name.
typedef struct JanetNativeT {
CalogJanetT *context;
char *name;
} JanetNativeT;
// Backs a foreign CalogFnT pushed into this VM: an abstract whose .call invokes the retained fn.
typedef struct JanetForeignT {
CalogJanetT *context;
CalogFnT *fn;
} JanetForeignT;
// Backs a CalogFnT exported from this VM: the owning context and the gcrooted Janet function.
typedef struct JanetScriptT {
CalogJanetT *context;
JanetFunction *function;
} JanetScriptT;
static void janetCharge(CalogLimitStateT *owner, int64_t delta);
static Janet janetForeignCall(void *p, int32_t argc, Janet *argv);
static int janetForeignGc(void *data, size_t len);
static void janetFreeArgs(CalogValueT *args, int32_t argCount);
static int32_t janetFromValue(CalogJanetT *context, const CalogValueT *value, Janet *out, int32_t depth);
static int32_t janetMarshalArgs(CalogJanetT *context, int32_t argc, Janet *argv, CalogValueT **out);
static Janet janetNativeCall(void *p, int32_t argc, Janet *argv);
static int janetNativeGc(void *data, size_t len);
static int32_t janetScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void janetScriptRelease(CalogFnT *callable);
static int32_t janetToValue(CalogJanetT *context, Janet value, CalogValueT *out, int32_t depth);
static void janetSealHostAccess(JanetTable *env);
static void *janetWatchdog(void *arg);
static int32_t janetWrapFunction(CalogJanetT *context, JanetFunction *function, CalogFnT **out);
// Charge `delta` bytes against `owner` (non-NULL) and, the first time it crosses the cap this run,
// interrupt the VM so the bytecode loop suspends at its next back-jump or call. Never refuses (Janet
// exit(1)s on a NULL allocation), so the bound is one-allocation granular. memUsed clamps at zero.
static void janetCharge(CalogLimitStateT *owner, int64_t delta) {
owner->memUsed += delta;
if (owner->memUsed < 0) {
owner->memUsed = 0;
}
if (owner->memCap > 0 && owner->memUsed > owner->memCap && !gJanetInterrupted && gJanetVm != NULL) {
gJanetInterrupted = true;
janet_interpreter_interrupt(gJanetVm);
}
}
// Janet's allocator, routed here from the janet.h macros. Prepends a {size, owner} header so free
// and realloc can uncharge exactly; charges the running context (NULL owner when unlimited).
void *calogJanetMalloc(size_t size) {
JanetAllocHdrT *base;
CalogLimitStateT *owner;
size_t total;
total = sizeof(JanetAllocHdrT) + size;
base = (JanetAllocHdrT *)malloc(total);
if (base == NULL) {
return NULL;
}
owner = (gJanetLimits != NULL && gJanetLimits->memCap > 0) ? gJanetLimits : NULL;
base->size = total;
base->owner = owner;
if (owner != NULL) {
janetCharge(owner, (int64_t)total);
}
return (void *)(base + 1);
}
void *calogJanetCalloc(size_t nmemb, size_t size) {
JanetAllocHdrT *base;
CalogLimitStateT *owner;
size_t data;
size_t total;
if (size != 0 && nmemb > (SIZE_MAX - sizeof(JanetAllocHdrT)) / size) {
return NULL; // overflow
}
data = nmemb * size;
total = sizeof(JanetAllocHdrT) + data;
base = (JanetAllocHdrT *)malloc(total);
if (base == NULL) {
return NULL;
}
memset((void *)(base + 1), 0, data);
owner = (gJanetLimits != NULL && gJanetLimits->memCap > 0) ? gJanetLimits : NULL;
base->size = total;
base->owner = owner;
if (owner != NULL) {
janetCharge(owner, (int64_t)total);
}
return (void *)(base + 1);
}
void *calogJanetRealloc(void *ptr, size_t size) {
JanetAllocHdrT *base;
JanetAllocHdrT *grown;
size_t oldTotal;
size_t newTotal;
if (ptr == NULL) {
return calogJanetMalloc(size);
}
base = ((JanetAllocHdrT *)ptr) - 1;
oldTotal = base->size;
newTotal = sizeof(JanetAllocHdrT) + size;
grown = (JanetAllocHdrT *)realloc(base, newTotal);
if (grown == NULL) {
return NULL;
}
grown->size = newTotal; // a resize keeps the block's original owner
if (grown->owner != NULL) {
janetCharge(grown->owner, (int64_t)newTotal - (int64_t)oldTotal);
}
return (void *)(grown + 1);
}
void calogJanetFree(void *ptr) {
JanetAllocHdrT *base;
if (ptr == NULL) {
return;
}
base = ((JanetAllocHdrT *)ptr) - 1;
if (base->owner != NULL) {
base->owner->memUsed -= (int64_t)base->size;
if (base->owner->memUsed < 0) {
base->owner->memUsed = 0;
}
}
free(base);
}
// Shut every door out of the VM that does not go through a calog native.
//
// calog's contract is that a script reaches the host only through registered natives, where the
// allow-list, the memory cap and the wall-clock budget can see it. Janet ships its own filesystem,
// subprocess, socket, environment and FFI bindings, none of which pass through calogCall, so no
// policy calog can express applies to them -- and ffi/ is worse than the rest together, since jitfn
// executes attacker-supplied machine code inside this process.
//
// janet_sandbox is Janet's own mechanism and covers most of it: a guarded cfun asserts against the
// mask and raises an ordinary Janet error, which the adapter reports like any other script failure.
// Two bindings are NOT guarded and have to go by hand -- os/exit calls exit() directly (taking the
// host down mid-run, around calogExit's ordered teardown) and os/cwd leaks the working directory.
// Defining a name to nil is how janet_def removes an existing binding from the env table.
//
// Everything dropped has a gated equivalent: fs* for files, procRun for processes, net*/http* for
// sockets, calogExit for ending the run. Compilation is deliberately left alone -- Janet scripts
// need it and it reaches nothing outside the VM.
static void janetSealHostAccess(JanetTable *env) {
static const char *const removed[] = { "os/cwd", "os/exit" };
size_t index;
janet_sandbox(JANET_SANDBOX_FS | JANET_SANDBOX_ENV | JANET_SANDBOX_FFI |
JANET_SANDBOX_SUBPROCESS | JANET_SANDBOX_NET | JANET_SANDBOX_DYNAMIC_MODULES |
JANET_SANDBOX_SIGNAL);
for (index = 0; index < sizeof(removed) / sizeof(removed[0]); index++) {
janet_def(env, removed[index], janet_wrap_nil(), NULL);
}
}
// The watchdog: Janet has no in-loop hook, so a separate thread interrupts the VM
// (janet_interpreter_interrupt is cross-thread-safe) for either reason a script must stop -- the
// runtime was latched aborting, or a time-limited context ran past its deadline. It polls at a
// coarse interval and exits promptly when asked (at context teardown).
//
// Every context gets one, not just time-limited ones: the abort watch is what lets Ctrl-C reach a
// script that calls no natives at all, which nothing else can interrupt on this engine. It does NOT
// call calogAbortRaise -- that marks the CALLING context and this is a foreign thread -- which is
// why calogJanetRun asks calogAborting rather than calogAbortRaised. Janet can afford that looser
// question because its own JANET_DO_ERROR_RUNTIME flag already separates a parse failure from a
// script that actually ran, so a syntax error still reports mid-teardown.
static void *janetWatchdog(void *arg) {
CalogJanetT *context;
CalogLimitStateT *limits;
struct timespec tick;
context = (CalogJanetT *)arg;
limits = context->limits;
tick.tv_sec = 0;
tick.tv_nsec = 5 * 1000 * 1000; // 5 ms
while (!atomic_load(&context->wdStop)) {
if (calogAborting(context->broker)) {
janet_interpreter_interrupt(context->janetVm);
break;
}
if (limits != NULL && limits->deadlineMs != 0 && calogMonotonicMillis() >= limits->deadlineMs) {
janet_interpreter_interrupt(context->janetVm);
break;
}
nanosleep(&tick, NULL);
}
return NULL;
}
// Callable abstracts. Defined after the prototypes so the designated initializers can name the
// handlers. Not registered with janet_register_abstract_type: calling and GC need no registration
// (only marshalling would), and the pointer identity is enough to recognize a foreign value on the
// way back out.
static const JanetAbstractType gForeignType = {
.name = "calog/foreign",
.gc = janetForeignGc,
.call = janetForeignCall
};
static const JanetAbstractType gNativeType = {
.name = "calog/native",
.gc = janetNativeGc,
.call = janetNativeCall
};
int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
CalogJanetT *context;
*out = NULL;
context = (CalogJanetT *)calloc(1, sizeof(*context));
if (context == NULL) {
return calogErrOomE;
}
janet_init();
// The core env is memoized and gcrooted internally by Janet, so the defs installed by
// calogJanetExpose survive collection for the VM's lifetime.
context->env = janet_core_env(NULL);
janetSealHostAccess(context->env);
context->broker = broker;
context->ctxId = ctxId;
context->limits = limits;
context->janetVm = janet_local_vm(); // this context thread's VM, for the watchdog's interrupt
// Arm the limits AFTER the base VM + core env are built, so the base runtime is neither charged
// nor deadline-checked (the memory cap must exceed the base runtime, as with Lua). gJanetVm is
// always set so the allocator can interrupt on an over-cap allocation.
gJanetVm = context->janetVm;
if (limits != NULL && limits->memCap > 0) {
gJanetLimits = limits;
}
// Started for every context: the watchdog carries the abort watch, which an unlimited context
// needs just as much as a limited one (see janetWatchdog).
atomic_store(&context->wdStop, false);
if (pthread_create(&context->watchdog, NULL, janetWatchdog, context) == 0) {
context->hasWatchdog = true;
}
*out = context;
return calogOkE;
}
void calogJanetDestroy(CalogJanetT *context) {
if (context == NULL) {
return;
}
// Stop and join the deadline watchdog before tearing down the VM it interrupts.
if (context->hasWatchdog) {
atomic_store(&context->wdStop, true);
pthread_join(context->watchdog, NULL);
}
// This thread's allocator pointers alias the context's limit state, freed with the context.
gJanetLimits = NULL;
gJanetVm = NULL;
// Tears down the thread-local VM, firing every remaining abstract's .gc handler: exposed
// natives free their name, live foreign callables release their CalogFnT.
janet_deinit();
free(context);
}
int32_t calogJanetExport(CalogJanetT *context, const char *name, CalogFnT **out) {
Janet resolved;
JanetBindingType binding;
*out = NULL;
resolved = janet_wrap_nil();
binding = janet_resolve(context->env, janet_csymbol(name), &resolved);
if (binding == JANET_BINDING_NONE || janet_type(resolved) != JANET_FUNCTION) {
return calogErrNotFoundE;
}
return janetWrapFunction(context, janet_unwrap_function(resolved), out);
}
int32_t calogJanetExpose(CalogJanetT *context, const char *name) {
JanetNativeT *native;
char *copy;
if (calogLookup(context->broker, name) == NULL) {
return calogErrNotFoundE;
}
// Copy the name first so the abstract is fully formed the instant it exists (its .gc handler
// frees this copy). janet_abstract aborts rather than returns NULL on OOM.
copy = strdup(name);
if (copy == NULL) {
return calogErrOomE;
}
native = (JanetNativeT *)janet_abstract(&gNativeType, sizeof(JanetNativeT));
native->context = context;
native->name = copy;
janet_def(context->env, name, janet_wrap_abstract(native), NULL);
return calogOkE;
}
// Call target for a foreign CalogFnT pushed into this VM (gForeignType.call). p is the abstract's
// JanetForeignT payload; the arguments are argv[0..argc).
static Janet janetForeignCall(void *p, int32_t argc, Janet *argv) {
JanetForeignT *foreign;
CalogJanetT *context;
CalogValueT *args;
CalogValueT result;
Janet out;
int32_t status;
foreign = (JanetForeignT *)p;
context = foreign->context;
args = NULL;
if (janetMarshalArgs(context, argc, argv, &args) != calogOkE) {
janet_panic("failed to marshal a function-value argument");
}
status = calogFnInvoke(foreign->fn, args, argc, &result);
janetFreeArgs(args, argc);
if (status != calogOkE) {
char message[CALOG_ERR_MSG_CAP];
snprintf(message, sizeof(message), "%s", (result.type == calogStringE) ? result.as.s.bytes : "function value failed");
calogValueFree(&result);
janet_panic(message);
}
status = janetFromValue(context, &result, &out, 0);
calogValueFree(&result);
if (status != calogOkE) {
janet_panic("failed to marshal the function-value result");
}
return out;
}
static int janetForeignGc(void *data, size_t len) {
JanetForeignT *foreign;
(void)len;
foreign = (JanetForeignT *)data;
calogFnRelease(foreign->fn);
return 0;
}
static void janetFreeArgs(CalogValueT *args, int32_t argCount) {
int32_t index;
if (args == NULL) {
return;
}
for (index = 0; index < argCount; index++) {
calogValueFree(&args[index]);
}
free(args);
}
static int32_t janetFromValue(CalogJanetT *context, const CalogValueT *value, Janet *out, int32_t depth) {
*out = janet_wrap_nil();
if (depth >= CALOG_MAX_DEPTH) {
return calogErrDepthE;
}
switch (value->type) {
case calogNilE:
return calogOkE;
case calogBoolE:
*out = janet_wrap_boolean(value->as.b ? 1 : 0);
return calogOkE;
case calogIntE:
// Doubles, not wrap_integer: preserve calog's 64-bit ints up to 2^53 (the shared
// ceiling of every double-number engine).
*out = janet_wrap_number((double)value->as.i);
return calogOkE;
case calogRealE:
*out = janet_wrap_number(value->as.r);
return calogOkE;
case calogStringE:
*out = janet_wrap_string(janet_string((const uint8_t *)value->as.s.bytes, (int32_t)value->as.s.length));
return calogOkE;
case calogAggE: {
CalogAggT *aggregate;
int64_t index;
int32_t status;
Janet child;
aggregate = value->as.agg;
// No GC runs while this executes (no bytecode), so the partially built container and
// the child in hand are safe without rooting.
if (calogAggIsKeyed(aggregate)) {
JanetTable *table;
table = janet_table((int32_t)(aggregate->arrayCount + aggregate->pairCount));
for (index = 0; index < aggregate->arrayCount; index++) {
status = janetFromValue(context, &aggregate->array[index], &child, depth + 1);
if (status != calogOkE) {
return status;
}
janet_table_put(table, janet_wrap_number((double)index), child);
}
for (index = 0; index < aggregate->pairCount; index++) {
Janet key;
status = janetFromValue(context, &aggregate->pairs[index].key, &key, depth + 1);
if (status != calogOkE) {
return status;
}
status = janetFromValue(context, &aggregate->pairs[index].value, &child, depth + 1);
if (status != calogOkE) {
return status;
}
janet_table_put(table, key, child);
}
*out = janet_wrap_table(table);
return calogOkE;
}
JanetArray *array;
array = janet_array((int32_t)aggregate->arrayCount);
for (index = 0; index < aggregate->arrayCount; index++) {
status = janetFromValue(context, &aggregate->array[index], &child, depth + 1);
if (status != calogOkE) {
return status;
}
janet_array_push(array, child);
}
*out = janet_wrap_array(array);
return calogOkE;
}
case calogFnE: {
JanetForeignT *foreign;
foreign = (JanetForeignT *)janet_abstract(&gForeignType, sizeof(JanetForeignT));
foreign->context = context;
foreign->fn = value->as.fn;
calogFnRetain(value->as.fn);
*out = janet_wrap_abstract(foreign);
return calogOkE;
}
}
return calogErrTypeE;
}
static int32_t janetMarshalArgs(CalogJanetT *context, int32_t argc, Janet *argv, CalogValueT **out) {
CalogValueT *args;
int32_t index;
int32_t status;
*out = NULL;
if (argc <= 0) {
return calogOkE;
}
args = (CalogValueT *)calloc((size_t)argc, sizeof(CalogValueT));
if (args == NULL) {
return calogErrOomE;
}
for (index = 0; index < argc; index++) {
status = janetToValue(context, argv[index], &args[index], 0);
if (status != calogOkE) {
int32_t cleanup;
for (cleanup = 0; cleanup < index; cleanup++) {
calogValueFree(&args[cleanup]);
}
free(args);
return status;
}
}
*out = args;
return calogOkE;
}
// Call target for an exposed broker native (gNativeType.call). p is the abstract's JanetNativeT
// payload; the arguments are argv[0..argc).
static Janet janetNativeCall(void *p, int32_t argc, Janet *argv) {
JanetNativeT *native;
CalogJanetT *context;
CalogValueT *args;
CalogValueT result;
Janet out;
int32_t status;
native = (JanetNativeT *)p;
context = native->context;
args = NULL;
if (janetMarshalArgs(context, argc, argv, &args) != calogOkE) {
janet_panic("failed to marshal a native argument");
}
status = calogCall(context->broker, native->name, args, argc, &result);
janetFreeArgs(args, argc);
if (status != calogOkE) {
char message[CALOG_ERR_MSG_CAP];
snprintf(message, sizeof(message), "%s", (result.type == calogStringE) ? result.as.s.bytes : "native call failed");
calogValueFree(&result);
janet_panic(message);
}
status = janetFromValue(context, &result, &out, 0);
calogValueFree(&result);
if (status != calogOkE) {
janet_panic("failed to marshal the native result");
}
return out;
}
static int janetNativeGc(void *data, size_t len) {
JanetNativeT *native;
(void)len;
native = (JanetNativeT *)data;
free(native->name);
return 0;
}
static int32_t janetScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
JanetScriptT *holder;
CalogJanetT *context;
Janet *argv;
Janet out;
JanetSignal signal;
int32_t index;
int32_t status;
holder = (JanetScriptT *)userData;
context = holder->context;
calogValueNil(result);
argv = NULL;
if (argCount > 0) {
argv = (Janet *)calloc((size_t)argCount, sizeof(Janet));
if (argv == NULL) {
return calogFail(result, calogErrOomE, "out of memory invoking janet callback");
}
}
// No GC runs while argv is built (no bytecode); janet_pcall copies argv into the fiber stack
// before running, so the values are rooted for the duration of the call.
for (index = 0; index < argCount; index++) {
status = janetFromValue(context, &args[index], &argv[index], 0);
if (status != calogOkE) {
free(argv);
return calogFail(result, status, "failed to marshal a janet callback argument");
}
}
out = janet_wrap_nil();
signal = janet_pcall(holder->function, argCount, argv, &out, NULL);
free(argv);
if (signal != JANET_SIGNAL_OK) {
const char *message;
// A limit trip during the callback (allocator interrupt or the watchdog's deadline) must
// retire the context here too, like the eval path -- else the interrupt errors the callback
// but the context runs on. calogJanetRun's reset of gJanetInterrupted covers this nested call.
CalogLimitStateT *limits;
limits = context->limits;
if (limits != NULL) {
uint64_t now;
now = calogMonotonicMillis();
if (gJanetInterrupted || (limits->deadlineMs != 0 && now >= limits->deadlineMs)) {
calogCurrentRetire();
}
}
message = (janet_type(out) == JANET_STRING) ? (const char *)janet_unwrap_string(out) : "janet callback failed";
return calogFail(result, calogErrArgE, message);
}
return janetToValue(context, out, result, 0);
}
static void janetScriptRelease(CalogFnT *callable) {
JanetScriptT *holder;
holder = (JanetScriptT *)calogFnUserData(callable);
// Runs on the owner thread, so the thread-local gc root list is this VM's.
janet_gcunroot(janet_wrap_function(holder->function));
free(holder);
}
static int32_t janetToValue(CalogJanetT *context, Janet value, CalogValueT *out, int32_t depth) {
calogValueNil(out);
if (depth >= CALOG_MAX_DEPTH) {
return calogErrDepthE;
}
switch (janet_type(value)) {
case JANET_NIL:
return calogOkE;
case JANET_BOOLEAN:
calogValueBool(out, janet_unwrap_boolean(value) != 0);
return calogOkE;
case JANET_NUMBER:
// Canonical double classification: an exact integer becomes an int, else a real.
calogValueFromDouble(out, janet_unwrap_number(value));
return calogOkE;
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD: {
JanetString bytes;
bytes = janet_unwrap_string(value);
return calogValueString(out, (const char *)bytes, (int64_t)janet_string_length(bytes));
}
case JANET_BUFFER: {
JanetBuffer *buffer;
buffer = janet_unwrap_buffer(value);
return calogValueString(out, (const char *)buffer->data, (int64_t)buffer->count);
}
case JANET_ARRAY: {
JanetArray *array;
CalogAggT *aggregate;
int32_t index;
int32_t status;
array = janet_unwrap_array(value);
status = calogAggCreate(&aggregate, calogListE);
if (status != calogOkE) {
return status;
}
for (index = 0; index < array->count; index++) {
CalogValueT element;
status = janetToValue(context, array->data[index], &element, depth + 1);
if (status != calogOkE) {
calogAggFree(aggregate);
return status;
}
status = calogAggPush(aggregate, &element);
if (status != calogOkE) {
calogValueFree(&element);
calogAggFree(aggregate);
return status;
}
}
calogValueAgg(out, aggregate);
return calogOkE;
}
case JANET_TUPLE: {
const Janet *tuple;
CalogAggT *aggregate;
int32_t count;
int32_t index;
int32_t status;
tuple = janet_unwrap_tuple(value);
count = janet_tuple_length(tuple);
status = calogAggCreate(&aggregate, calogListE);
if (status != calogOkE) {
return status;
}
for (index = 0; index < count; index++) {
CalogValueT element;
status = janetToValue(context, tuple[index], &element, depth + 1);
if (status != calogOkE) {
calogAggFree(aggregate);
return status;
}
status = calogAggPush(aggregate, &element);
if (status != calogOkE) {
calogValueFree(&element);
calogAggFree(aggregate);
return status;
}
}
calogValueAgg(out, aggregate);
return calogOkE;
}
case JANET_TABLE: {
JanetTable *table;
CalogAggT *aggregate;
int32_t index;
int32_t status;
table = janet_unwrap_table(value);
status = calogAggCreate(&aggregate, calogMapE);
if (status != calogOkE) {
return status;
}
for (index = 0; index < table->capacity; index++) {
CalogValueT key;
CalogValueT val;
if (janet_checktype(table->data[index].key, JANET_NIL)) {
continue;
}
status = janetToValue(context, table->data[index].key, &key, depth + 1);
if (status != calogOkE) {
calogAggFree(aggregate);
return status;
}
status = janetToValue(context, table->data[index].value, &val, depth + 1);
if (status != calogOkE) {
calogValueFree(&key);
calogAggFree(aggregate);
return status;
}
status = calogAggSet(aggregate, &key, &val);
if (status != calogOkE) {
calogValueFree(&key);
calogValueFree(&val);
calogAggFree(aggregate);
return status;
}
}
calogValueAgg(out, aggregate);
return calogOkE;
}
case JANET_STRUCT: {
const JanetKV *st;
CalogAggT *aggregate;
int32_t capacity;
int32_t index;
int32_t status;
st = janet_unwrap_struct(value);
capacity = janet_struct_capacity(st);
status = calogAggCreate(&aggregate, calogMapE);
if (status != calogOkE) {
return status;
}
for (index = 0; index < capacity; index++) {
CalogValueT key;
CalogValueT val;
if (janet_checktype(st[index].key, JANET_NIL)) {
continue;
}
status = janetToValue(context, st[index].key, &key, depth + 1);
if (status != calogOkE) {
calogAggFree(aggregate);
return status;
}
status = janetToValue(context, st[index].value, &val, depth + 1);
if (status != calogOkE) {
calogValueFree(&key);
calogAggFree(aggregate);
return status;
}
status = calogAggSet(aggregate, &key, &val);
if (status != calogOkE) {
calogValueFree(&key);
calogValueFree(&val);
calogAggFree(aggregate);
return status;
}
}
calogValueAgg(out, aggregate);
return calogOkE;
}
case JANET_FUNCTION: {
CalogFnT *callable;
int32_t status;
status = janetWrapFunction(context, janet_unwrap_function(value), &callable);
if (status != calogOkE) {
return status;
}
calogValueFn(out, callable);
return calogOkE;
}
case JANET_ABSTRACT: {
void *abstract;
abstract = janet_unwrap_abstract(value);
// Our own foreign callable coming back out: return the wrapped fn, retained.
if (janet_abstract_type(abstract) == &gForeignType) {
JanetForeignT *foreign;
foreign = (JanetForeignT *)abstract;
calogFnRetain(foreign->fn);
calogValueFn(out, foreign->fn);
return calogOkE;
}
return calogOkE; // a foreign abstract has no calog analogue; stays nil
}
default:
return calogOkE; // fiber, cfunction, pointer: no analogue; stays nil
}
}
// Wrap a Janet function as a host-visible CalogFnT. The function is pinned as a GC root until the
// callable's last reference drops (janetScriptRelease unroots it).
static int32_t janetWrapFunction(CalogJanetT *context, JanetFunction *function, CalogFnT **out) {
JanetScriptT *holder;
int32_t status;
*out = NULL;
holder = (JanetScriptT *)malloc(sizeof(*holder));
if (holder == NULL) {
return calogErrOomE;
}
holder->context = context;
holder->function = function;
janet_gcroot(janet_wrap_function(function));
status = calogFnCreate(out, context->broker, janetScriptInvoke, holder, janetScriptRelease, context->ctxId);
if (status != calogOkE) {
janet_gcunroot(janet_wrap_function(function));
free(holder);
return status;
}
return calogOkE;
}
int32_t calogJanetRun(CalogJanetT *context, const char *source) {
JanetBuffer *captured;
Janet errKey;
Janet out;
bool aborted;
int32_t status;
int flags;
gJanetInterrupted = false; // one-shot per run: a fresh over-cap interrupt may fire again
// Unlike every other engine, Janet reports a failed script itself, from inside janet_dobytes
// (the error line plus a stack trace, through janet_eprintf). That is the right output for a
// script that failed and exactly the wrong output for one that calogExit unwound on purpose, so
// capture it and decide afterwards. janet_eprintf honors the "err" dynamic binding; the binding
// must go in the TOP dyn table, because janet_dobytes prints once janet_continue has returned
// and no fiber is current. A script's own (eprint) still goes straight to stderr -- inside a
// fiber the lookup finds this env's bindings, not the top table.
captured = janet_buffer(JANET_ERROR_CAPTURE_CAP);
errKey = janet_ckeywordv("err");
// Janet does not mark the top dyn table, so an entry parked there is invisible to the collector:
// root both halves by hand or a collection inside the script frees them under the binding.
janet_gcroot(errKey);
janet_gcroot(janet_wrap_buffer(captured));
janet_setdyn("err", janet_wrap_buffer(captured));
out = janet_wrap_nil();
flags = janet_dobytes(context->env, (const uint8_t *)source, (int32_t)strlen(source), "calog", &out);
janet_setdyn("err", janet_wrap_nil());
// calogExit (calogAbortAll) unwinding this script is not a failure: drop what Janet reported and
// hand back success, so the runner neither prints a trace nor retires the context as broken.
// Only a RUNTIME trip can be an abort -- a parse or compile error still reports, mid-teardown or
// not, since no native ran to ask for one.
aborted = ((flags & JANET_DO_ERROR_RUNTIME) != 0) && calogAborting(context->broker);
status = (flags != 0 && !aborted) ? calogErrArgE : calogOkE;
if (flags != 0) {
// If a sandbox limit tripped -- the allocator interrupted the VM this run (gJanetInterrupted,
// which survives a GC that later drops memUsed back under the cap) or the wall-clock deadline
// passed -- retire the context so it is torn down rather than run again past its budget. Our
// only interrupt sources are limit violations, so any trip is a kill.
CalogLimitStateT *limits;
limits = context->limits;
if (limits != NULL) {
uint64_t now;
now = calogMonotonicMillis();
if (gJanetInterrupted || (limits->deadlineMs != 0 && now >= limits->deadlineMs)) {
calogCurrentRetire();
}
}
if (status != calogOkE) {
// Relayed verbatim, so a failing janet script reads exactly as it did before.
fwrite(captured->data, 1, (size_t)captured->count, stderr);
}
}
janet_gcunroot(janet_wrap_buffer(captured));
janet_gcunroot(errKey);
return status;
}