AI_Slop/calog
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Lots of work to achieve feature parity between languages and platforms.

Browse source
This commit is contained in:
Scott Duensing 2026-07-08 01:05:30 -05:00
parent 90634e4244
commit 05cf86cc9a
34 changed files with 1124 additions and 80 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
API.md
View file

@ -41,8 +41,13 @@ etc. -- see the README and `src/calog.h`.)
and `byteToStr(b) -> string`. `+` concatenates byte buffers (and `string + bytes`), and `=`/`<>` compare and `byteToStr(b) -> string`. `+` concatenates byte buffers (and `string + bytes`), and `=`/`<>` compare
them by content. A byte buffer egresses back to a native as a full-length binary string. Every other them by content. A byte buffer egresses back to a native as a full-length binary string. Every other
engine's strings are already binary-safe, so this applies to my-basic only. engine's strings are already binary-safe, so this applies to my-basic only.
- **Sandboxing (my-basic).** A my-basic context honors the same per-context limits as Lua/JS -- the native - **Sandboxing.** A limited context (`calogContextOpenLimited`) honors three per-context limits: the
allow-list, a wall-clock time budget, and a memory cap (an over-budget or runaway script is retired). native allow-list (every engine), a wall-clock time budget, and a memory cap (an over-budget or
runaway script is retired). The time budget and memory cap hold for all engines except s7 -- Lua,
JavaScript, my-basic, Berry, Tcl, mruby, Squirrel, Wren, and Janet -- each enforced by the cleanest
mechanism its VM allows (see design.md sec 24); s7 is allow-list-only, a documented limit. Bound
granularity varies: exact for Lua/JS/Berry/mruby, otherwise allocation-, loop-, or statement-granular
(a single operation may transiently overshoot the memory cap before the next check). For my-basic,
`INPUT` never reads host stdin: it yields an empty line, so a script takes input through natives like `INPUT` never reads host stdin: it yields an empty line, so a script takes input through natives like
every other engine. every other engine.
- **Availability.** Every library in this reference is compiled into `bin/calog`: crypto, - **Availability.** Every library in this reference is compiled into `bin/calog`: crypto,
@ -52,6 +57,51 @@ etc. -- see the README and `src/calog.h`.)
--- ---
## Engine feature matrix
All ten engines share one value and callback model, so the same natives work from every language.
These dimensions are **identical across all ten**: `nil`/`bool`/`int`/`real` scalars, binary-safe
strings, `list` and `map` marshalling in both directions, function values in both directions (a script
function handed to a native, and a native or host function called from the script), cross-engine calls,
and the native allow-list. The table records only where engines differ -- and each difference follows
from the language, not from calog.
| Engine | File ext | Max integer | Bare-name exports* | Memory cap + time budget |
|---|---|---|---|---|
| Lua | `.lua` | 64-bit | yes | yes |
| JavaScript (QuickJS) | `.js` | 2^53** | yes | yes |
| my-basic | `.bas` | 64-bit | yes | yes |
| Squirrel | `.nut` | 64-bit | yes | yes |
| Berry | `.be` | 64-bit | no -- use `calogCall` | yes |
| Scheme (s7) | `.scm` | 64-bit | yes | **no -- allow-list only** |
| Wren | `.wren` | 2^53** | no -- use `Calog.call` | yes |
| mruby | `.rb` | 64-bit | yes | yes |
| Tcl | `.tcl` | 64-bit | yes | yes |
| Janet | `.janet` | 2^53** | no -- use `calogCall` | yes |
`*` Registered natives are callable by bare name in **every** engine (`report(42)`). This column is
only about resolving a bare name to a value **exported by another context** (via `calogExport`): seven
engines resolve such a name lazily; Berry, Wren, and Janet require an explicit `calogCall` /
`Calog.call` to reach an export.
`**` JavaScript, Wren, and Janet model numbers as IEEE doubles, so integer magnitudes above 2^53 lose
precision; the other seven carry full 64-bit integers. (JavaScript can still recover a full int64 on
*ingress* by passing a `BigInt`.)
The memory cap and time budget are enforced by the cleanest mechanism each VM allows (allocator
refusal, a counting allocator, an instruction or heartbeat hook, the bytecode loop, a built-in limit,
or -- for Janet -- a watchdog thread); design.md sec 24 has the per-engine details and the two accepted
limitations (a script that deliberately catches the sandbox error and loops can pin its thread; a
single allocation of script-controlled size can transiently overshoot the cap). **s7 is allow-list
only** -- its unchecked allocator and optimizer-collapsed loops leave no safe hook point.
Value-model edges that follow from each language (not calog limits): Tcl and s7 have no true `nil` (it
marshals out as `""` / `#<unspecified>`) and collapse `bool` to `0`/`1`; a hybrid list+map aggregate
round-trips losslessly only on Lua (the others flatten it to a map); non-scalar map keys are dropped on
egress (JavaScript, Berry, s7, mruby); Janet loses `symbol`/`keyword` subtype (it arrives as a string).
---
## Runner (`calog` binary) ## Runner (`calog` binary)
| Function | Description | | Function | Description |

8
Makefile
View file

@ -433,7 +433,7 @@ $(WRENADP): obj/%.o: %.c | obj
# headers (mruby/presym.h) under build/calog/include that the adapter includes. # headers (mruby/presym.h) under build/calog/include that the adapter includes.
MRUBYADP = obj/mrubyAdapter.o MRUBYADP = obj/mrubyAdapter.o
$(MRUBYADP): obj/%.o: %.c | obj $(MRUBYLIB) $(MRUBYADP): obj/%.o: %.c | obj $(MRUBYLIB)
$(CC) $(ADPFLAGS) $(INC) $(MRUBYINC) -c -o $@ $< $(CC) $(ADPFLAGS) $(INC) $(MRUBYINC) -DMRB_USE_DEBUG_HOOK -c -o $@ $<
# relaxed C + Tcl headers (tcl.h needs no generated header, so no $(TCLLIB) order dependency). # relaxed C + Tcl headers (tcl.h needs no generated header, so no $(TCLLIB) order dependency).
TCLADP = obj/tclAdapter.o TCLADP = obj/tclAdapter.o
@ -738,8 +738,8 @@ bin/testArchive: obj/testArchive.o obj/calogArchive.o obj/calogHandle.o lib/libc
bin/testUtil: obj/testUtil.o obj/calogCsv.o obj/calogProc.o obj/calogRegex.o lib/libcalog.a lib/liblua.a $(PCRE2LIB) | bin bin/testUtil: obj/testUtil.o obj/calogCsv.o obj/calogProc.o obj/calogRegex.o lib/libcalog.a lib/liblua.a $(PCRE2LIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) $(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS)
bin/testSandbox: obj/testSandbox.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libmybasic.a | bin bin/testSandbox: obj/testSandbox.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a lib/libjanet.a $(MRUBYLIB) $(TCLLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) $(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) $(CXXLIB) -lm $(MRUBYLIBS) $(TCLLIBS)
bin/testTrace: obj/testTrace.o obj/calogExport.o lib/libcalog.a lib/liblua.a lib/libquickjs.a | bin bin/testTrace: obj/testTrace.o obj/calogExport.o lib/libcalog.a lib/liblua.a lib/libquickjs.a | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) $(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS)
@ -856,7 +856,7 @@ tsanwren: | bin obj
# instruments the calog adapter/engine/actor code, which is where the cross-context risk lives; # instruments the calog adapter/engine/actor code, which is where the cross-context risk lives;
# each mrb_state is independent (one per thread), the concurrency gate mruby was chosen on. # each mrb_state is independent (one per thread), the concurrency gate mruby was chosen on.
tsanmruby: $(MRUBYLIB) | bin obj tsanmruby: $(MRUBYLIB) | bin obj
$(CC) $(TSANFLAGS) $(INC) $(MRUBYINC) -o bin/testEngineMrubyTsan \ $(CC) $(TSANFLAGS) $(INC) $(MRUBYINC) -DMRB_USE_DEBUG_HOOK -o bin/testEngineMrubyTsan \
tests/testEngineMruby.c src/mruby/mrubyEngine.c src/mruby/mrubyAdapter.c $(TSANCORE) \ tests/testEngineMruby.c src/mruby/mrubyEngine.c src/mruby/mrubyAdapter.c $(TSANCORE) \
$(MRUBYLIB) $(MRUBYLIBS) $(MRUBYLIB) $(MRUBYLIBS)
setarch -R ./bin/testEngineMrubyTsan setarch -R ./bin/testEngineMrubyTsan

23
PORTING.md
View file

@ -47,6 +47,29 @@ The Makefile auto-detects the platform (`PLATFORM` = `linux`/`darwin`/`windows`/
the link line: `DLLIB` is `-ldl` on Linux (empty on macOS, where `dlopen` is in libSystem) and the link line: `DLLIB` is `-ldl` on Linux (empty on macOS, where `dlopen` is in libSystem) and
`SOCKETLIBS` is `-lws2_32` on Windows. `SOCKETLIBS` is `-lws2_32` on Windows.
### Feature and verification parity
The **full `calog` CLI -- all ten engines and every capability library** (net/tls/http-https/db
[SQLite+PostgreSQL+MariaDB]/archive/regex/ssh/xml + the core libs) -- builds for all three operating
systems. What differs across ports is not features but how thoroughly each is verified, and the scope
of the fully-static route.
| Port | Build path | Full CLI (10 engines + all libs) | Verified |
|---|---|---|---|
| Linux glibc (dev / release) | `make` / `make release` | yes | **runtime** (the test suite runs) |
| Windows x86_64 (PE) | `tools/crossWinFull.sh` (zig cross) | yes | build + link only |
| macOS x86_64 | `tools/crossMacFull.sh mac-x64` (zig cross) | yes | build + link only |
| macOS arm64 | `tools/crossMacFull.sh mac-arm64` (zig cross) | yes | build + link only |
| Linux static musl (Alpine) | `make static` on Alpine | no -- Lua-only demo (`examples/staticDemo.c`) | runtime (per component) |
| Linux static glibc | `make static` on glibc | no -- Lua-only demo | build only |
So engine and library parity across Linux, macOS, and Windows is **complete**. The one open gap is
**run-verification on Windows and macOS**: both are cross-built and linked with a single zig toolchain
but have not yet been executed on the target OS (a real Windows/wine or Mac run is the remaining step).
The fully-static route is a deliberately narrower, minimal-dependency demo (Lua only, not the full
CLI), and static **glibc loses DNS** (its NSS resolver needs `dlopen`, which a static binary cannot do)
-- so Alpine/musl is the path to a zero-dependency binary that still resolves names.
## Linux ## Linux
- **`make`** -- the sanitized development build (ASan + UBSan + strict warnings). - **`make`** -- the sanitized development build (ASan + UBSan + strict warnings).

98
design.md
View file

@ -1286,3 +1286,101 @@ calog's natives like every other engine.
denies a forbidden native, a runaway `WHILE 1` loop is retired on its wall-clock budget, and a string denies a forbidden native, a runaway `WHILE 1` loop is retired on its wall-clock budget, and a string
doubling past a 2 MiB cap is retired -- ASan+UBSan-clean, `tsanmb` clean, and driven end-to-end through doubling past a 2 MiB cap is retired -- ASan+UBSan-clean, `tsanmb` clean, and driven end-to-end through
`bin/calog` (INPUT yields empty without reading stdin; a 160 KB string builds without crashing). `bin/calog` (INPUT yields empty without reading stdin; a 160 KB string builds without crashing).
## 24. Sandbox parity across the remaining engines -- memory cap + wall-clock budget
Section 23 brought my-basic to sandbox parity with Lua and QuickJS. This section closes the rest of
the gap: the memory cap and the wall-clock budget (the allow-list was always engine-agnostic) now
hold for **nine of the ten engines** -- Lua, JavaScript, my-basic, Berry, Tcl, mruby, Squirrel, Wren,
and Janet. Only **s7** remains allow-list-only, by deliberate omission (below).
A per-VM feasibility audit (grounded in each vendored VM's source, then adversarially re-checked)
found that none of the seven allow-list-only engines was *impossible*, but the cost and mechanism
differ per VM. Each engine's `calogXCreate` gained a `CalogLimitStateT *limits` parameter (threaded
from `calogContextLimitState`), and each enforces both limits by the cleanest mechanism its VM
allows. An unlimited context installs nothing and pays ~zero overhead.
| Engine | Memory cap | Wall-clock budget | Bound granularity |
|----------|-------------------------------------------------------------------|---------------------------------------------------------------|-------------------|
| Berry | `be_realloc` refuses a grow past the cap (GC-retry then `be_throw`) | instruction heartbeat hook (`be_set_obs_hook`) -> `be_raise` | exact (refuses) |
| mruby | override the global `mrb_basic_alloc_func` (refuse -> clean `NoMemoryError`) | per-instruction `code_fetch_hook` (`MRB_USE_DEBUG_HOOK`) | exact (refuses) |
| Tcl | count in the zippy allocator; a Tcl async unwinds when over cap | built-in `Tcl_LimitSetTime` + a monotonic-authoritative handler | async-granular |
| Squirrel | counting `sq_vm_*`; the Execute loop unwinds on a tripped flag | Execute-loop deadline poll -> `Raise_Error`+`SQ_THROW` | per-instruction |
| Wren | the bytecode loop checks the VM's own `bytesAllocated` vs the cap | same loop back-jump checks the deadline -> `RUNTIME_ERROR` | per-loop-iteration|
| Janet | header allocator interrupts the VM on an over-cap allocation | out-of-band watchdog thread -> `janet_interpreter_interrupt` | per-allocation |
Cross-cutting design points:
- **Resolving the running context.** Several VMs allocate through a process-global allocator (my-basic,
Squirrel, mruby, Janet) or a global one with no calog pointer in the loop (Tcl). The running context
is resolved through a `_Thread_local` limit-state pointer set on the context's dedicated thread
(each context = one OS thread), the pattern established by my-basic's `gMbLimits`. Where the VM
passes exact sizes to free/realloc (Tcl, Squirrel) no per-block header is needed; where it does not
(mruby, Janet) a `{size, owner}` header is prepended, and storing the **owner in the header** means
a block allocated before the cap was armed (the base runtime) is never mis-uncharged -- `memUsed`
cannot drift negative from base-runtime frees.
- **Refuse vs count-and-interrupt.** An allocator may refuse (return NULL) only where the VM turns NULL
into a clean, catchable error: Berry (`be_throw` after a GC retry) and mruby (`mrb_raise_nomemory`).
Squirrel and Tcl deref/assert on a NULL allocation, and Janet `exit(1)`s, so those never refuse --
they count and let the enforcement point (the Execute loop, a Tcl async, or a VM interrupt) unwind.
Count-and-interrupt is therefore allocation-or-loop granular: a single operation can transiently
overshoot before the next check, exactly as my-basic's statement-granular cap (sec 23).
- **The exponential-doubling trap.** A `s = s + s` loop grows memory exponentially, so a coarse
instruction-count poll OOMs the host between polls. The check must sit at the allocation itself
(Janet, or via the trip flag Squirrel's allocator sets and its loop reads every instruction) or at
each loop back-jump (Wren), bounding the overshoot to one iteration.
- **Re-entrancy.** The unwind path itself allocates (building the error object) while still over cap,
which can re-trigger the limit. Tcl hit this concretely: `Tcl_SetObjResult` in the async handler
re-marked the async, and `Tcl_AsyncInvoke`'s retry loop re-invoked the handler forever. The fix is a
re-entrancy guard (`gTclInMemAsync`) so charging does not re-arm while the handler runs; Squirrel's
loop re-verifies the cap so a transient freed within one opcode does not retire the context.
- **Janet's watchdog.** Janet alone has no in-VM periodic hook that fires inside a tight loop, so the
wall-clock budget is enforced by a per-context watchdog thread that sleeps to the deadline then calls
`janet_interpreter_interrupt` (cross-thread-safe: it only touches an atomic). The watchdog reads
`deadlineMs`/`janetVm`, both set before `pthread_create` (happens-before), and is stopped and joined
before the VM is torn down. Memory still needs the allocator (a 5 ms watchdog poll cannot bound an
exponential loop), so the counting allocator interrupts on an over-cap allocation.
**s7 -- the documented remaining limit.** s7's `Malloc/Calloc/Realloc` are unchecked macros with no
allocator hook (a single large allocation deref-crashes), its only heap control is a *cell-count*
`(*s7* 'max-heap-size)` (not byte-accurate, and it does not stop a single big allocation), and its
`begin_hook` does not fire inside s7's optimizer-collapsed loops -- the sandbox-critical case. Both
limits would require large, invasive surgery to the s7 interpreter. Per the project's
prefer-omission-over-partial rule, s7 stays allow-list-only and is documented as such
(`calog.h` `CalogLimitsT`) rather than shipped with a footgunny partial cap.
**Verified**: `testSandbox` grew from the Lua/JS/my-basic cases to cover all nine enforcing engines
(three checks each -- allow-list denial, a runaway loop retired on the wall-clock budget, and a memory
bomb retired), 43 checks / 0 failed under ASan+UBSan; each engine's ThreadSanitizer target
(`tsanberry`/`tsantcl`/`tsanmruby`/`tsansq`/`tsanwren`/`tsanjanet`) clean, plus a dedicated
ThreadSanitizer harness for Janet's watchdog (four concurrent limited contexts, race-free); vendored
patches are marked in place (`// --- calog patch ... ---`) with no separate backup, matching the
existing wren.c convention. `make test` = 846 checks / 0 failed across 38 binaries.
**Adversarial review + accepted limitations.** A per-engine review of the six patches (each finding
independently re-verified against the code) drove several hardening fixes: Janet's `os/realpath` frees
a libc-`malloc`'d buffer, which the allocator macros mis-routed to the header `free` (an out-of-bounds
read, proven under ASan) -- now a raw `free`; Berry's cap check could `be_throw` while `vm->errjmp`
is NULL (the adapter marshalling a callback's args or reading an error string between `be_pcall`s),
turning a cap trip into an abort -- now gated on `errjmp != NULL`, enforcing only while a script is
executing; Wren's loop-only check missed unbounded recursion (which executes no `LOOP`), so the check
also runs after each completed call; Janet's callback path now retires on an interrupt like the eval
path; and the Tcl cap now charges the bulk `Tcl_Obj` pool chunk (individual objects come from a pool
that bypassed the per-block charge). Two limitations are accepted and documented rather than fixed:
- **A script that deliberately catches the sandbox error and loops** defeats the wall-clock budget and
pins its context thread -- the retire is cooperative (serviced after the eval returns), and a
caught error never returns. This is a property of the cooperative model, not a given engine: the
Lua reference behaves identically (`while true do pcall(function() while true do end end) end` is
not retired). A real fix is preemptive thread termination, a model-level change out of scope here.
A merely runaway script (no catch) IS retired on every engine.
- **A single bytecode op that allocates O(script-integer)** -- e.g. Squirrel `array(n)`, Wren
`List.filled(n)` -- overshoots the cap by that one allocation before the next check fires, and a
request larger than host RAM crashes the VM (Squirrel/Wren/Janet do not NULL-check allocations, and
Janet's `JANET_OUT_OF_MEMORY` is `exit(1)`). This is the allocation-granular bound already noted,
the same class as my-basic's statement-granular cap; the host-OOM crash is inherent to embedding
these VMs and predates the cap.

82
src/berry/berryAdapter.c
View file

@ -29,18 +29,26 @@
#define BERRY_FOREIGN_INITIAL 8 #define BERRY_FOREIGN_INITIAL 8
struct CalogBerryT { struct CalogBerryT {
bvm *vm; bvm *vm;
CalogT *broker; CalogT *broker;
uint64_t ctxId; uint64_t ctxId;
int32_t nextRef; CalogLimitStateT *limits; // sandbox limits (mem cap + deadline), or NULL if unlimited
CalogFnT **foreignFns; // foreign function values pushed into this VM int32_t nextRef;
int32_t foreignCount; CalogFnT **foreignFns; // foreign function values pushed into this VM
int32_t foreignCap; int32_t foreignCount;
int32_t *freeRefs; // reclaimed _calog_fn_N slot numbers, reused before minting new ones int32_t foreignCap;
int32_t freeCount; int32_t *freeRefs; // reclaimed _calog_fn_N slot numbers, reused before minting new ones
int32_t freeCap; int32_t freeCount;
int32_t freeCap;
}; };
// The limit state of the Berry context running on THIS thread, or NULL if it is unlimited.
// Berry's memory choke point (be_realloc) and its heartbeat hook have no per-call userdata,
// and each context owns its dedicated thread (create/run/destroy all run on it), so a
// thread-local pointer -- set once at create -- resolves the running context exactly, the
// same pattern my-basic uses for its process-global allocator (see mybasicAdapter.c).
static _Thread_local CalogLimitStateT *gBerryLimits = NULL;
// Backs a CalogFnT exported from this VM: the owning context, the reclaimable slot // Backs a CalogFnT exported from this VM: the owning context, the reclaimable slot
// number, and the name of the hidden global that keeps the Berry function GC-reachable. // number, and the name of the hidden global that keeps the Berry function GC-reachable.
typedef struct BerryExportT { typedef struct BerryExportT {
@ -54,12 +62,13 @@ static void berryCallableRelease(CalogFnT *callable);
static int32_t berryExportValue(CalogBerryT *context, int index, CalogFnT **out); static int32_t berryExportValue(CalogBerryT *context, int index, CalogFnT **out);
static int berryForeignCall(bvm *vm); static int berryForeignCall(bvm *vm);
static int32_t berryFromValue(CalogBerryT *context, const CalogValueT *value, int32_t depth); static int32_t berryFromValue(CalogBerryT *context, const CalogValueT *value, int32_t depth);
static void berryObsHook(bvm *vm, int event, ...);
static int32_t berryTrackForeign(CalogBerryT *context, CalogFnT *callable); static int32_t berryTrackForeign(CalogBerryT *context, CalogFnT *callable);
static int32_t berryToValue(CalogBerryT *context, int index, CalogValueT *out, int32_t depth); static int32_t berryToValue(CalogBerryT *context, int index, CalogValueT *out, int32_t depth);
static int berryTrampoline(bvm *vm); static int berryTrampoline(bvm *vm);
int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId) { int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
CalogBerryT *context; CalogBerryT *context;
*out = NULL; *out = NULL;
@ -67,6 +76,9 @@ int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId) {
if (context == NULL) { if (context == NULL) {
return calogErrOomE; return calogErrOomE;
} }
// The base VM is built before the cap is armed, so the runtime itself is never refused
// (the cap must exceed the base runtime, as with Lua); Berry still counts these bytes in
// vm->gc.usage, so a subsequent grow is measured against the true live total.
context->vm = be_vm_new(); context->vm = be_vm_new();
if (context->vm == NULL) { if (context->vm == NULL) {
free(context); free(context);
@ -74,11 +86,56 @@ int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId) {
} }
context->broker = broker; context->broker = broker;
context->ctxId = ctxId; context->ctxId = ctxId;
context->limits = limits;
// Arm this thread's limit pointer (read by the be_realloc cap check and the heartbeat
// hook). A time-limited context also gets the heartbeat hook, which Berry fires from its
// instruction loop every 2^19 instructions (BE_USE_PERF_COUNTERS is enabled in the
// vendored berry_conf.h) -- often enough to notice a wall-clock deadline inside a tight
// loop. An unlimited context leaves the pointer NULL and installs no hook (zero overhead).
gBerryLimits = limits;
if (limits != NULL && limits->deadlineMs > 0) {
be_set_obs_hook(context->vm, berryObsHook);
}
*out = context; *out = context;
return calogOkE; return calogOkE;
} }
// Charge check for the vendored be_realloc cap patch: non-zero when growing the running
// context's live heap by `growth` bytes would exceed its cap. Also mirrors the current live
// usage into memUsed for reporting. NULL/uncapped context -> never refuses.
int calogBerryMemOverCap(size_t usage, size_t growth) {
CalogLimitStateT *limits;
limits = gBerryLimits;
if (limits == NULL || limits->memCap <= 0) {
return 0;
}
limits->memUsed = (int64_t)usage;
return (int64_t)usage + (int64_t)growth > limits->memCap;
}
// Berry's instruction-loop heartbeat: if the wall-clock deadline has passed, retire this context and
// raise a Berry error to unwind the running script (be_raise longjmps to the protected frame). A
// runaway (non-catching) script unwinds to the be_pcall in calogBerryRun, which lets the deferred
// retire fire; a script that deliberately catches this in try/except and loops can defeat the budget
// and pin its thread -- an accepted cooperative-model limitation shared by every engine including the
// Lua reference (see design.md sec 24). Other observability events are ignored.
static void berryObsHook(bvm *vm, int event, ...) {
CalogLimitStateT *limits;
if (event != BE_OBS_VM_HEARTBEAT) {
return;
}
limits = gBerryLimits;
if (limits != NULL && limits->deadlineMs != 0 && calogMonotonicMillis() >= limits->deadlineMs) {
calogCurrentRetire();
be_raise(vm, "calog_timeout", "context exceeded its time budget");
}
}
static int32_t berryCallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) { static int32_t berryCallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
BerryExportT *export; BerryExportT *export;
CalogBerryT *context; CalogBerryT *context;
@ -154,6 +211,9 @@ void calogBerryDestroy(CalogBerryT *context) {
if (context == NULL) { if (context == NULL) {
return; return;
} }
// This thread's limit pointer aliases the context's limit state, which is freed with the
// context; clear it so nothing on this (soon-joined) thread can read it afterward.
gBerryLimits = NULL;
// Release the foreign function values pushed into this VM (see berryTrackForeign). // Release the foreign function values pushed into this VM (see berryTrackForeign).
for (index = 0; index < context->foreignCount; index++) { for (index = 0; index < context->foreignCount; index++) {
calogFnRelease(context->foreignFns[index]); calogFnRelease(context->foreignFns[index]);

2
src/berry/berryAdapter.h
View file

@ -18,7 +18,7 @@
typedef struct CalogBerryT CalogBerryT; typedef struct CalogBerryT CalogBerryT;
int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId); int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
void calogBerryDestroy(CalogBerryT *context); void calogBerryDestroy(CalogBerryT *context);
int32_t calogBerryExport(CalogBerryT *context, const char *globalName, CalogFnT **out); int32_t calogBerryExport(CalogBerryT *context, const char *globalName, CalogFnT **out);
int32_t calogBerryExpose(CalogBerryT *context, const char *name); int32_t calogBerryExpose(CalogBerryT *context, const char *name);

2
src/berry/berryEngine.c
View file

@ -29,7 +29,7 @@ static int32_t berryEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status; int32_t status;
*interpOut = NULL; *interpOut = NULL;
status = calogBerryCreate(&be, calogContextBroker(context), calogContextId(context)); status = calogBerryCreate(&be, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
if (status != calogOkE) { if (status != calogOkE) {
return status; return status;
} }

23
src/calog.h
View file

@ -219,15 +219,22 @@ CalogContextT *calogContextOpen(CalogT *calog, const CalogEngineT *engine); //
// allow-list gates which registered natives the script may call. // allow-list gates which registered natives the script may call.
// //
// COVERAGE (honest, per engine): // COVERAGE (honest, per engine):
// allowList -- enforced for EVERY engine (checked in the broker's one dispatch choke point). // allowList -- enforced for EVERY engine (checked in the broker's one dispatch choke point).
// wallClockMillis -- enforced for Lua and JavaScript (their periodic hooks check the deadline). A // wallClockMillis -- enforced for ALL engines EXCEPT s7: Lua/JS/my-basic/mruby via a periodic VM
// script blocked in a long-running C native is not preempted (inherent). Other // hook, Berry via its instruction heartbeat, Squirrel/Wren from the bytecode loop,
// engines ignore it. // Tcl via its built-in time limit, Janet via an out-of-band watchdog thread. A
// memoryBytes -- enforced for Lua and JavaScript only (per-VM allocators). The other engines use // script blocked in a long-running C native is not preempted (inherent). s7 ignores
// a process-global allocator and ignore it. // it -- its begin-hook does not fire inside its optimized loops (design.md sec 24).
// memoryBytes -- enforced for the same nine engines: a per-VM allocator (Lua/JS), or a counting
// allocator / VM-loop check charged to the running context (the rest). s7 ignores
// it. Bound granularity varies (exact for Lua/JS/Berry/mruby, else allocation- or
// loop- or statement-granular: a single operation may transiently overshoot).
// Cooperative model: retirement is serviced after the eval returns, so a script that DELIBERATELY
// catches the sandbox error and loops can pin its context thread (every engine, incl. Lua/JS -- see
// design.md sec 24). A merely runaway script (no catch) is always retired.
typedef struct CalogLimitsT { typedef struct CalogLimitsT {
int64_t memoryBytes; // 0 = unlimited (Lua + JS only) int64_t memoryBytes; // 0 = unlimited (all engines but s7)
int64_t wallClockMillis; // 0 = unlimited (Lua + JS only) int64_t wallClockMillis; // 0 = unlimited (all engines but s7)
const char *const *allowList; // NULL = all natives permitted; else a NULL-terminated list of allowed names const char *const *allowList; // NULL = all natives permitted; else a NULL-terminated list of allowed names
} CalogLimitsT; } CalogLimitsT;

11
src/calogInternal.h
View file

@ -158,10 +158,13 @@ void *calogContextInterp(CalogContextT *context);
bool calogContextRegistered(CalogT *runtime, uint64_t ctxId); bool calogContextRegistered(CalogT *runtime, uint64_t ctxId);
// ---- per-context resource limits (sandboxing) ---- // ---- per-context resource limits (sandboxing) ----
// The mutable state a limited context enforces on its OWN thread: memUsed is charged by the engine's // The mutable state a limited context enforces on its OWN thread. memUsed is charged by the engine's
// allocator (Lua and QuickJS natively; my-basic via a global counting allocator + a thread-local owner, // allocator (Lua/QuickJS natively; the rest via a per-VM or process-global counting allocator plus a
// since its allocator is process-global -- see mybasicAdapter.c), and deadlineMs is a monotonic-clock // thread-local owner -- see mybasicAdapter.c and design.md sec 24) and is touched only on the context
// deadline the engine's periodic hook checks. Touched only on the context thread, so no atomics needed. // thread, so it needs no atomics. deadlineMs is a monotonic-clock deadline the engine's periodic hook
// (or Tcl's built-in limit / Janet's watchdog thread) checks; it is set once at open, before any
// watchdog starts, so a cross-thread read of it (Janet) is safe without atomics. All nine enforcing
// engines share this state; s7 is allow-list only (its loops bypass its begin-hook).
typedef struct CalogLimitStateT { typedef struct CalogLimitStateT {
int64_t memUsed; // bytes currently charged against the cap int64_t memUsed; // bytes currently charged against the cap
int64_t memCap; // 0 = unlimited int64_t memCap; // 0 = unlimited

214
src/janet/janetAdapter.c
View file

@ -26,17 +26,40 @@
#include "janet.h" #include "janet.h"
#include <pthread.h>
#include <stdatomic.h>
#include <stdint.h> #include <stdint.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include <time.h>
struct CalogJanetT { struct CalogJanetT {
JanetTable *env; JanetTable *env;
CalogT *broker; CalogT *broker;
uint64_t ctxId; 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. // Backs an exposed broker native: an abstract whose .call dispatches through calogCall by name.
typedef struct JanetNativeT { typedef struct JanetNativeT {
CalogJanetT *context; CalogJanetT *context;
@ -55,6 +78,7 @@ typedef struct JanetScriptT {
JanetFunction *function; JanetFunction *function;
} JanetScriptT; } JanetScriptT;
static void janetCharge(CalogLimitStateT *owner, int64_t delta);
static Janet janetForeignCall(void *p, int32_t argc, Janet *argv); static Janet janetForeignCall(void *p, int32_t argc, Janet *argv);
static int janetForeignGc(void *data, size_t len); static int janetForeignGc(void *data, size_t len);
static void janetFreeArgs(CalogValueT *args, int32_t argCount); static void janetFreeArgs(CalogValueT *args, int32_t argCount);
@ -65,8 +89,135 @@ static int janetNativeGc(void *data, size_t len);
static int32_t janetScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData); static int32_t janetScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void janetScriptRelease(CalogFnT *callable); static void janetScriptRelease(CalogFnT *callable);
static int32_t janetToValue(CalogJanetT *context, Janet value, CalogValueT *out, int32_t depth); static int32_t janetToValue(CalogJanetT *context, Janet value, CalogValueT *out, int32_t depth);
static void *janetWatchdog(void *arg);
static int32_t janetWrapFunction(CalogJanetT *context, JanetFunction *function, CalogFnT **out); 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);
}
// The deadline watchdog: Janet has no in-loop time hook, so a separate thread interrupts the VM once
// the wall-clock deadline passes (janet_interpreter_interrupt is cross-thread-safe). It polls at a
// coarse interval and also exits promptly when asked (at context teardown).
static void *janetWatchdog(void *arg) {
CalogJanetT *context;
struct timespec tick;
context = (CalogJanetT *)arg;
tick.tv_sec = 0;
tick.tv_nsec = 5 * 1000 * 1000; // 5 ms
while (!atomic_load(&context->wdStop)) {
if (calogMonotonicMillis() >= context->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 // 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 // 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 // (only marshalling would), and the pointer identity is enough to recognize a foreign value on the
@ -84,7 +235,7 @@ static const JanetAbstractType gNativeType = {
}; };
int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId) { int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
CalogJanetT *context; CalogJanetT *context;
*out = NULL; *out = NULL;
@ -95,9 +246,24 @@ int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId) {
janet_init(); janet_init();
// The core env is memoized and gcrooted internally by Janet, so the defs installed by // The core env is memoized and gcrooted internally by Janet, so the defs installed by
// calogJanetExpose survive collection for the VM's lifetime. // calogJanetExpose survive collection for the VM's lifetime.
context->env = janet_core_env(NULL); context->env = janet_core_env(NULL);
context->broker = broker; context->broker = broker;
context->ctxId = ctxId; 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;
}
if (limits != NULL && limits->deadlineMs > 0) {
atomic_store(&context->wdStop, false);
if (pthread_create(&context->watchdog, NULL, janetWatchdog, context) == 0) {
context->hasWatchdog = true;
}
}
*out = context; *out = context;
return calogOkE; return calogOkE;
} }
@ -107,6 +273,14 @@ void calogJanetDestroy(CalogJanetT *context) {
if (context == NULL) { if (context == NULL) {
return; 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 // Tears down the thread-local VM, firing every remaining abstract's .gc handler: exposed
// natives free their name, live foreign callables release their CalogFnT. // natives free their name, live foreign callables release their CalogFnT.
janet_deinit(); janet_deinit();
@ -391,6 +565,18 @@ static int32_t janetScriptInvoke(CalogValueT *args, int32_t argCount, CalogValue
free(argv); free(argv);
if (signal != JANET_SIGNAL_OK) { if (signal != JANET_SIGNAL_OK) {
const char *message; 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"; message = (janet_type(out) == JANET_STRING) ? (const char *)janet_unwrap_string(out) : "janet callback failed";
return calogFail(result, calogErrArgE, message); return calogFail(result, calogErrArgE, message);
} }
@ -626,9 +812,23 @@ int32_t calogJanetRun(CalogJanetT *context, const char *source) {
Janet out; Janet out;
int flags; int flags;
gJanetInterrupted = false; // one-shot per run: a fresh over-cap interrupt may fire again
out = janet_wrap_nil(); out = janet_wrap_nil();
flags = janet_dobytes(context->env, (const uint8_t *)source, (int32_t)strlen(source), "calog", &out); flags = janet_dobytes(context->env, (const uint8_t *)source, (int32_t)strlen(source), "calog", &out);
if (flags != 0) { 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();
}
}
// janet_dobytes already printed the error + a stack trace to stderr (janet_eprintf), so // janet_dobytes already printed the error + a stack trace to stderr (janet_eprintf), so
// do not print it again here; just report failure through the single error channel. // do not print it again here; just report failure through the single error channel.
return calogErrArgE; return calogErrArgE;

2
src/janet/janetAdapter.h
View file

@ -24,7 +24,7 @@
typedef struct CalogJanetT CalogJanetT; typedef struct CalogJanetT CalogJanetT;
// Create a Janet VM for this context (call on the context's own thread). *out owns the VM. // Create a Janet VM for this context (call on the context's own thread). *out owns the VM.
int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId); int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
// Tear down the VM (call on the context's own thread). // Tear down the VM (call on the context's own thread).
void calogJanetDestroy(CalogJanetT *context); void calogJanetDestroy(CalogJanetT *context);

2
src/janet/janetEngine.c
View file

@ -29,7 +29,7 @@ static int32_t janetEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status; int32_t status;
*interpOut = NULL; *interpOut = NULL;
status = calogJanetCreate(&janet, calogContextBroker(context), calogContextId(context)); status = calogJanetCreate(&janet, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
if (status != calogOkE) { if (status != calogOkE) {
return status; return status;
} }

4
src/mruby/build_config.rb
View file

@ -17,6 +17,10 @@ MRuby::Build.new('calog') do |conf|
conf.toolchain :gcc conf.toolchain :gcc
conf.cc.flags << '-O2' conf.cc.flags << '-O2'
conf.cc.defines << 'MRB_INT64' conf.cc.defines << 'MRB_INT64'
# Per-instruction VM hook (mrb_state.code_fetch_hook), used by the adapter to enforce a
# per-context wall-clock budget. Off by default in mruby; calog's adapter compile defines the
# same macro (Makefile MRUBYADP) so the mrb_state layout matches this library build.
conf.cc.defines << 'MRB_USE_DEBUG_HOOK'
conf.gembox 'stdlib' conf.gembox 'stdlib'
conf.gembox 'stdlib-ext' conf.gembox 'stdlib-ext'

141
src/mruby/mrubyAdapter.c
View file

@ -36,14 +36,34 @@
#define MRUBY_FOREIGN_INITIAL 8 #define MRUBY_FOREIGN_INITIAL 8
struct CalogMrubyT { struct CalogMrubyT {
mrb_state *mrb; mrb_state *mrb;
CalogT *broker; CalogT *broker;
uint64_t ctxId; uint64_t ctxId;
CalogFnT **foreignFns; // foreign function values pushed into this VM CalogLimitStateT *limits; // sandbox limits (mem cap + deadline), or NULL if unlimited
int32_t foreignCount; uint32_t stepCounter; // amortizes the code-fetch hook's wall-clock reads
int32_t foreignCap; CalogFnT **foreignFns; // foreign function values pushed into this VM
int32_t foreignCount;
int32_t foreignCap;
}; };
// Per-allocation header prepended by mrb_basic_alloc_func: the block's total size and the context
// it is charged to (NULL if allocated while unlimited). Storing the owner in the header -- not
// reading a thread-local at free time -- means a block allocated before a cap was armed (the base
// interpreter) is never uncharged, so memUsed cannot drift negative from base-runtime frees.
typedef struct MrubyAllocHdrT {
size_t size;
CalogLimitStateT *owner;
} MrubyAllocHdrT;
// The limit state of the mruby context running on THIS thread, or NULL if unlimited. mruby's
// allocator (mrb_basic_alloc_func) is a global symbol with no mrb_state argument, so a new
// allocation resolves the running context through this thread-local (each context owns its thread);
// the my-basic adapter uses the same pattern for its process-global allocator.
static _Thread_local CalogLimitStateT *gMrubyLimits = NULL;
// The code-fetch hook reads the monotonic clock only once per this many instructions.
#define MRUBY_STEP_MASK 0x3FFu
// Backs a CalogFnT exported from this VM: the owning context and the pinned Ruby callable // Backs a CalogFnT exported from this VM: the owning context and the pinned Ruby callable
// (a Proc/Method), kept GC-reachable by mrb_gc_register until the CalogFnT is released. // (a Proc/Method), kept GC-reachable by mrb_gc_register until the CalogFnT is released.
typedef struct MrubyExportT { typedef struct MrubyExportT {
@ -53,6 +73,7 @@ typedef struct MrubyExportT {
static int32_t mrubyCallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData); static int32_t mrubyCallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void mrubyCallableRelease(CalogFnT *callable); static void mrubyCallableRelease(CalogFnT *callable);
static void mrubyCodeFetchHook(mrb_state *mrb, const struct mrb_irep *irep, const mrb_code *pc, mrb_value *regs);
static int32_t mrubyExportValue(CalogMrubyT *context, mrb_value callable, CalogFnT **out); static int32_t mrubyExportValue(CalogMrubyT *context, mrb_value callable, CalogFnT **out);
static mrb_value mrubyForeignCall(mrb_state *mrb, mrb_value self); static mrb_value mrubyForeignCall(mrb_state *mrb, mrb_value self);
static int32_t mrubyFromValue(CalogMrubyT *context, const CalogValueT *value, mrb_value *out, int32_t depth); static int32_t mrubyFromValue(CalogMrubyT *context, const CalogValueT *value, mrb_value *out, int32_t depth);
@ -66,7 +87,96 @@ static int32_t mrubyTrackForeign(CalogMrubyT *context, CalogFnT *callable);
static mrb_value mrubyTrampoline(mrb_state *mrb, mrb_value self); static mrb_value mrubyTrampoline(mrb_state *mrb, mrb_value self);
int32_t calogMrubyCreate(CalogMrubyT **out, CalogT *broker, uint64_t ctxId) { // calog's replacement for mruby's default allocator (mruby calls mrb_basic_alloc_func directly, and
// documents redefining it in the host; the vendored default in allocf.c is never pulled). Realloc-
// style: size 0 frees, p NULL allocates, else resizes. It prepends a header (size + charged owner)
// and, for a memory-capped context, REFUSES a growth past the cap by returning NULL -- which mruby
// turns into a forced GC and one retry, then a clean, catchable NoMemoryError (mrb_realloc). So the
// cap is exact and GC-aware, never a host crash. An unlimited context is headered but never charged.
void *mrb_basic_alloc_func(void *p, size_t size) {
MrubyAllocHdrT *base;
MrubyAllocHdrT *grown;
CalogLimitStateT *owner;
size_t newTotal;
int64_t delta;
if (size == 0) {
if (p != NULL) {
base = ((MrubyAllocHdrT *)p) - 1;
if (base->owner != NULL) {
base->owner->memUsed -= (int64_t)base->size;
if (base->owner->memUsed < 0) {
base->owner->memUsed = 0;
}
}
free(base);
}
return NULL;
}
newTotal = sizeof(MrubyAllocHdrT) + size;
if (p == NULL) {
owner = (gMrubyLimits != NULL && gMrubyLimits->memCap > 0) ? gMrubyLimits : NULL;
if (owner != NULL && owner->memUsed + (int64_t)newTotal > owner->memCap) {
return NULL;
}
base = (MrubyAllocHdrT *)malloc(newTotal);
if (base == NULL) {
return NULL;
}
base->size = newTotal;
base->owner = owner;
if (owner != NULL) {
owner->memUsed += (int64_t)newTotal;
}
return (void *)(base + 1);
}
base = ((MrubyAllocHdrT *)p) - 1;
owner = base->owner; // a resize keeps the block's original owner
delta = (int64_t)newTotal - (int64_t)base->size;
if (owner != NULL && delta > 0 && owner->memUsed + delta > owner->memCap) {
return NULL; // p is untouched -> mruby GC-retries or raises
}
grown = (MrubyAllocHdrT *)realloc(base, newTotal);
if (grown == NULL) {
return NULL;
}
grown->size = newTotal;
if (owner != NULL) {
owner->memUsed += delta;
if (owner->memUsed < 0) {
owner->memUsed = 0;
}
}
return (void *)(grown + 1);
}
// mruby's per-instruction hook (compiled in via MRB_USE_DEBUG_HOOK): if the wall-clock deadline has
// passed, retire this context and raise a Ruby error to unwind the run (mrb_raise longjmps to the
// VM's protected frame). The clock read is amortized over MRUBY_STEP_MASK+1 instructions to keep the
// common per-instruction cost to a counter bump.
static void mrubyCodeFetchHook(mrb_state *mrb, const struct mrb_irep *irep, const mrb_code *pc, mrb_value *regs) {
CalogMrubyT *context;
(void)irep;
(void)pc;
(void)regs;
context = (CalogMrubyT *)mrb->ud;
if (context == NULL || context->limits == NULL || context->limits->deadlineMs == 0) {
return;
}
context->stepCounter++;
if ((context->stepCounter & MRUBY_STEP_MASK) != 0) {
return;
}
if (calogMonotonicMillis() >= context->limits->deadlineMs) {
calogCurrentRetire();
mrb_raise(mrb, E_RUNTIME_ERROR, "context exceeded its time budget");
}
}
int32_t calogMrubyCreate(CalogMrubyT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
CalogMrubyT *context; CalogMrubyT *context;
mrb_state *mrb; mrb_state *mrb;
@ -75,6 +185,8 @@ int32_t calogMrubyCreate(CalogMrubyT **out, CalogT *broker, uint64_t ctxId) {
if (context == NULL) { if (context == NULL) {
return calogErrOomE; return calogErrOomE;
} }
// The base VM is built before the cap is armed, so its allocations carry a NULL owner and are
// never charged or refused (the cap must exceed the base runtime, as with Lua).
mrb = mrb_open(); mrb = mrb_open();
if (mrb == NULL) { if (mrb == NULL) {
free(context); free(context);
@ -83,7 +195,16 @@ int32_t calogMrubyCreate(CalogMrubyT **out, CalogT *broker, uint64_t ctxId) {
context->mrb = mrb; context->mrb = mrb;
context->broker = broker; context->broker = broker;
context->ctxId = ctxId; context->ctxId = ctxId;
mrb->ud = context; // the trampoline recovers the context from here context->limits = limits;
mrb->ud = context; // the trampoline and the code-fetch hook recover the context here
// Arm this thread's allocator owner (memory cap) and the per-instruction hook (wall-clock
// budget). An unlimited context leaves both off.
if (limits != NULL && limits->memCap > 0) {
gMrubyLimits = limits;
}
if (limits != NULL && limits->deadlineMs > 0) {
mrb->code_fetch_hook = mrubyCodeFetchHook;
}
// Ruby ergonomics without pulling mruby-io: puts/print/p route to stdout. Defined on Kernel // Ruby ergonomics without pulling mruby-io: puts/print/p route to stdout. Defined on Kernel
// so a bare `puts "x"` works at top level (calog scripts still use fs*/net* for real IO). // so a bare `puts "x"` works at top level (calog scripts still use fs*/net* for real IO).
mrb_define_method(mrb, mrb->kernel_module, "puts", mrubyPuts, MRB_ARGS_ANY()); mrb_define_method(mrb, mrb->kernel_module, "puts", mrubyPuts, MRB_ARGS_ANY());
@ -169,8 +290,10 @@ void calogMrubyDestroy(CalogMrubyT *context) {
} }
free(context->foreignFns); free(context->foreignFns);
if (context->mrb != NULL) { if (context->mrb != NULL) {
mrb_close(context->mrb); mrb_close(context->mrb); // frees this context's charged blocks (uncharged via their headers)
} }
// This thread's allocator owner aliases the context's limit state, freed with the context.
gMrubyLimits = NULL;
free(context); free(context);
} }

2
src/mruby/mrubyAdapter.h
View file

@ -19,7 +19,7 @@
typedef struct CalogMrubyT CalogMrubyT; typedef struct CalogMrubyT CalogMrubyT;
int32_t calogMrubyCreate(CalogMrubyT **out, CalogT *broker, uint64_t ctxId); int32_t calogMrubyCreate(CalogMrubyT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
void calogMrubyDestroy(CalogMrubyT *context); void calogMrubyDestroy(CalogMrubyT *context);
int32_t calogMrubyExport(CalogMrubyT *context, const char *name, CalogFnT **out); int32_t calogMrubyExport(CalogMrubyT *context, const char *name, CalogFnT **out);
int32_t calogMrubyExpose(CalogMrubyT *context, const char *name); int32_t calogMrubyExpose(CalogMrubyT *context, const char *name);

2
src/mruby/mrubyEngine.c
View file

@ -29,7 +29,7 @@ static int32_t mrubyEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status; int32_t status;
*interpOut = NULL; *interpOut = NULL;
status = calogMrubyCreate(&rb, calogContextBroker(context), calogContextId(context)); status = calogMrubyCreate(&rb, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
if (status != calogOkE) { if (status != calogOkE) {
return status; return status;
} }

69
src/squirrel/squirrelAdapter.c
View file

@ -31,14 +31,22 @@ typedef struct SquirrelExportT {
} SquirrelExportT; } SquirrelExportT;
struct CalogSquirrelT { struct CalogSquirrelT {
HSQUIRRELVM v; HSQUIRRELVM v;
CalogT *broker; CalogT *broker;
uint64_t ctxId; uint64_t ctxId;
BindingT **bindings; CalogLimitStateT *limits; // sandbox limits (mem cap + deadline), or NULL if unlimited
int32_t bindingCount; BindingT **bindings;
int32_t bindingCap; int32_t bindingCount;
int32_t bindingCap;
}; };
// The limit state of the Squirrel context running on THIS thread, or NULL if unlimited. Squirrel's
// allocator (sq_vm_malloc, patched in sqmem.cpp) is process-global with no VM argument, and the
// Execute-loop limit check has no VM-side calog pointer, so both resolve the running context through
// this thread-local (each context owns its thread) -- the pattern my-basic uses for its global
// allocator. The three helpers below are the C-linkage functions the vendored patches call.
static _Thread_local CalogLimitStateT *gSquirrelLimits = NULL;
// Shared shape for the two things a marshalled call can dispatch to: a CalogFnT // Shared shape for the two things a marshalled call can dispatch to: a CalogFnT
// (calogFnInvoke) or a broker binding (calogCall). squirrelCallDispatch runs the // (calogFnInvoke) or a broker binding (calogCall). squirrelCallDispatch runs the
// marshal/dispatch/cleanup pipeline once and calls back through this. // marshal/dispatch/cleanup pipeline once and calls back through this.
@ -174,7 +182,43 @@ static void squirrelCompileError(HSQUIRRELVM v, const SQChar *desc, const SQChar
} }
int32_t calogSquirrelCreate(CalogSquirrelT **out, CalogT *broker, uint64_t ctxId) { // Called from the patched allocator (sqmem.cpp) on every alloc/free: tally the running context's
// live bytes and report whether it is now over its cap. C linkage (the C++ VM declares it extern "C").
int calogSquirrelMemCharge(long long delta) {
CalogLimitStateT *limits;
limits = gSquirrelLimits;
if (limits == NULL) {
return 0;
}
limits->memUsed += delta;
if (limits->memUsed < 0) {
limits->memUsed = 0;
}
return (limits->memCap > 0 && limits->memUsed > limits->memCap) ? 1 : 0;
}
// Called from the Execute loop to re-verify a memory trip: true only if still over the cap (so a
// transient spike that was freed within the same opcode does not retire the context).
int calogSquirrelMemExceeded(void) {
CalogLimitStateT *limits;
limits = gSquirrelLimits;
return (limits != NULL && limits->memCap > 0 && limits->memUsed > limits->memCap) ? 1 : 0;
}
// Called from the Execute loop's periodic poll: true once the wall-clock deadline has passed.
int calogSquirrelTimeExpired(void) {
CalogLimitStateT *limits;
limits = gSquirrelLimits;
return (limits != NULL && limits->deadlineMs != 0 && calogMonotonicMillis() >= limits->deadlineMs) ? 1 : 0;
}
int32_t calogSquirrelCreate(CalogSquirrelT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
CalogSquirrelT *context; CalogSquirrelT *context;
HSQUIRRELVM v; HSQUIRRELVM v;
@ -191,6 +235,13 @@ int32_t calogSquirrelCreate(CalogSquirrelT **out, CalogT *broker, uint64_t ctxId
context->v = v; context->v = v;
context->broker = broker; context->broker = broker;
context->ctxId = ctxId; context->ctxId = ctxId;
context->limits = limits;
// Arm this thread's limit pointer (read by the patched allocator and the Execute-loop check).
// The base VM was built by sq_open above, so it is not itself charged (the cap must exceed the
// base runtime, as with Lua); an unlimited context leaves the pointer NULL and pays nothing.
if (limits != NULL && (limits->memCap > 0 || limits->deadlineMs > 0)) {
gSquirrelLimits = limits;
}
sq_setforeignptr(v, context); sq_setforeignptr(v, context);
sq_setprintfunc(v, squirrelPrint, squirrelErrorPrint); sq_setprintfunc(v, squirrelPrint, squirrelErrorPrint);
sq_setcompilererrorhandler(v, squirrelCompileError); sq_setcompilererrorhandler(v, squirrelCompileError);
@ -213,6 +264,10 @@ void calogSquirrelDestroy(CalogSquirrelT *context) {
if (context == NULL) { if (context == NULL) {
return; return;
} }
// Disarm BEFORE sq_close so teardown frees are not charged: the base VM (built by sq_open before
// the limit was armed) is uncharged, so charging its frees here would drive memUsed negative.
// The limit pointer aliases the context's limit state, which is freed with the context anyway.
gSquirrelLimits = NULL;
if (context->v != NULL) { if (context->v != NULL) {
sq_close(context->v); sq_close(context->v);
} }

2
src/squirrel/squirrelAdapter.h
View file

@ -20,7 +20,7 @@
typedef struct CalogSquirrelT CalogSquirrelT; typedef struct CalogSquirrelT CalogSquirrelT;
int32_t calogSquirrelCreate(CalogSquirrelT **out, CalogT *broker, uint64_t ctxId); int32_t calogSquirrelCreate(CalogSquirrelT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
void calogSquirrelDestroy(CalogSquirrelT *context); void calogSquirrelDestroy(CalogSquirrelT *context);
int32_t calogSquirrelExport(CalogSquirrelT *context, const char *globalName, CalogFnT **out); int32_t calogSquirrelExport(CalogSquirrelT *context, const char *globalName, CalogFnT **out);
int32_t calogSquirrelExpose(CalogSquirrelT *context, const char *name); int32_t calogSquirrelExpose(CalogSquirrelT *context, const char *name);

2
src/squirrel/squirrelEngine.c
View file

@ -29,7 +29,7 @@ static int32_t squirrelEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status; int32_t status;
*interpOut = NULL; *interpOut = NULL;
status = calogSquirrelCreate(&sc, calogContextBroker(context), calogContextId(context)); status = calogSquirrelCreate(&sc, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
if (status != calogOkE) { if (status != calogOkE) {
return status; return status;
} }

144
src/tcl/tclAdapter.c
View file

@ -35,12 +35,26 @@
#include <string.h> #include <string.h>
struct CalogTclT { struct CalogTclT {
Tcl_Interp *interp; Tcl_Interp *interp;
CalogT *broker; CalogT *broker;
uint64_t ctxId; uint64_t ctxId;
int32_t nextFn; // mints unique "calogFn<N>" command names for function values CalogLimitStateT *limits; // sandbox limits (mem cap + deadline), or NULL if unlimited
Tcl_AsyncHandler memAsync; // fired when the allocator notices the memory cap is exceeded
int32_t nextFn; // mints unique "calogFn<N>" command names for function values
}; };
// The limit state of the Tcl context running on THIS thread (each context owns its thread), and
// its memory async token. Tcl's zippy allocator is process-global with no per-interp userdata, so
// the allocator-charge callback resolves the running context through these thread-locals -- the
// same pattern my-basic uses for its process-global allocator (see mybasicAdapter.c). Both are
// NULL for an unlimited context (nothing is charged, no async is armed).
static _Thread_local CalogLimitStateT *gTclLimits = NULL;
static _Thread_local Tcl_AsyncHandler gTclMemAsync = NULL;
// Set while the memory async handler runs: the handler sets the interp error result, which
// allocates while still over budget -- without this guard that re-marks the async, and
// Tcl_AsyncInvoke's retry loop would re-invoke the handler forever instead of unwinding.
static _Thread_local bool gTclInMemAsync = false;
// Backs a CalogFnT that invokes a Tcl command prefix (a script callback captured as a value). // Backs a CalogFnT that invokes a Tcl command prefix (a script callback captured as a value).
typedef struct TclScriptT { typedef struct TclScriptT {
CalogTclT *context; CalogTclT *context;
@ -63,19 +77,21 @@ static int32_t tclFromValue(CalogTclT *context, const CalogValueT *value, Tcl_O
static void tclInitOnce(void); static void tclInitOnce(void);
static int32_t tclMakeFnCommand(CalogTclT *context, CalogFnT *fn, Tcl_Obj **out); static int32_t tclMakeFnCommand(CalogTclT *context, CalogFnT *fn, Tcl_Obj **out);
static int32_t tclMarshalArgs(CalogTclT *context, int objc, Tcl_Obj *const objv[], int from, CalogValueT **out, int32_t *outCount); static int32_t tclMarshalArgs(CalogTclT *context, int objc, Tcl_Obj *const objv[], int from, CalogValueT **out, int32_t *outCount);
static int tclMemAsync(void *cd, Tcl_Interp *ip, int code);
static CalogTclT *tclOf(Tcl_Interp *ip); static CalogTclT *tclOf(Tcl_Interp *ip);
static int tclPrintCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]); static int tclPrintCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclPutsCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]); static int tclPutsCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int32_t tclScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData); static int32_t tclScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void tclScriptRelease(CalogFnT *callable); static void tclScriptRelease(CalogFnT *callable);
static int tclSetResult(CalogTclT *context, Tcl_Interp *ip, int32_t status, CalogValueT *result); static int tclSetResult(CalogTclT *context, Tcl_Interp *ip, int32_t status, CalogValueT *result);
static void tclTimeLimit(void *cd, Tcl_Interp *ip);
static int32_t tclToValue(CalogTclT *context, Tcl_Obj *obj, CalogValueT *out, int32_t depth); static int32_t tclToValue(CalogTclT *context, Tcl_Obj *obj, CalogValueT *out, int32_t depth);
static int tclTrampoline(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]); static int tclTrampoline(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclUnknownCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]); static int tclUnknownCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int32_t tclWrapCommand(CalogTclT *context, Tcl_Obj *prefix, CalogFnT **out); static int32_t tclWrapCommand(CalogTclT *context, Tcl_Obj *prefix, CalogFnT **out);
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId) { int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
CalogTclT *context; CalogTclT *context;
*out = NULL; *out = NULL;
@ -91,6 +107,37 @@ int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId) {
} }
context->broker = broker; context->broker = broker;
context->ctxId = ctxId; context->ctxId = ctxId;
context->limits = limits;
// A memory-capped context arms allocator counting on this thread and creates an async handler
// the allocator marks once over budget (fired at the next bytecode async check, every 64
// instructions). A time-limited context uses Tcl's built-in per-interp time limit, checked from
// the bytecode loop, with a handler that is authoritative on calog's monotonic clock. Both are
// installed after Tcl_CreateInterp, so the base interpreter is not itself charged/limited (the
// cap must exceed the base runtime, as with Lua).
if (limits != NULL && limits->memCap > 0) {
context->memAsync = Tcl_AsyncCreate(tclMemAsync, context);
gTclMemAsync = context->memAsync;
gTclLimits = limits;
}
if (limits != NULL && limits->deadlineMs > 0) {
Tcl_Time t;
uint64_t nowMs;
uint64_t remainMs;
nowMs = calogMonotonicMillis();
remainMs = limits->deadlineMs > nowMs ? limits->deadlineMs - nowMs : 0;
Tcl_GetTime(&t);
t.sec += (long long)(remainMs / 1000);
t.usec += (long)((remainMs % 1000) * 1000);
if (t.usec >= 1000000) {
t.sec += 1;
t.usec -= 1000000;
}
Tcl_LimitSetTime(context->interp, &t);
Tcl_LimitTypeSet(context->interp, TCL_LIMIT_TIME);
Tcl_LimitSetGranularity(context->interp, TCL_LIMIT_TIME, 1);
Tcl_LimitAddHandler(context->interp, TCL_LIMIT_TIME, tclTimeLimit, context, NULL);
}
Tcl_SetAssocData(context->interp, "calogCtx", NULL, context); // recovered by tclOf Tcl_SetAssocData(context->interp, "calogCtx", NULL, context); // recovered by tclOf
// puts/print write to stdout directly: Tcl's channel-based puts needs the IO subsystem calog // puts/print write to stdout directly: Tcl's channel-based puts needs the IO subsystem calog
// does not initialize. calogCallback wraps a command prefix into a callable function value. // does not initialize. calogCallback wraps a command prefix into a callable function value.
@ -105,6 +152,86 @@ int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId) {
} }
// Charge point for the vendored zippy-allocator cap patch (calogTclMemCharge in tclThreadAlloc.c):
// track this thread's live Tcl heap usage and, once over the cap, mark the async handler so the
// running script unwinds at its next bytecode async check. Never refuses an allocation (Tcl_Alloc
// panics on NULL) -- enforcement is deferred to the async, so the bound is async-granular (a single
// allocation can transiently overshoot, as with my-basic's statement-granular cap). memUsed is
// clamped at zero: base-interpreter blocks allocated before the cap was armed are uncharged, so
// their later free must not drive the counter negative. A no-op for an unlimited context.
void calogTclMemCharge(long long delta) {
CalogLimitStateT *limits;
limits = gTclLimits;
if (limits == NULL) {
return;
}
limits->memUsed += delta;
if (limits->memUsed < 0) {
limits->memUsed = 0;
}
if (limits->memCap > 0 && limits->memUsed > limits->memCap && gTclMemAsync != NULL && !gTclInMemAsync) {
Tcl_AsyncMark(gTclMemAsync);
}
}
// The memory async handler: fired at a bytecode async check after the allocator flagged the cap as
// exceeded. If still over budget, retire the context and unwind the eval with an error; otherwise
// (a transient that a free has since relieved) pass the running result code through unchanged.
static int tclMemAsync(void *cd, Tcl_Interp *ip, int code) {
CalogTclT *context;
context = (CalogTclT *)cd;
if (context->limits != NULL && context->limits->memCap > 0
&& context->limits->memUsed > context->limits->memCap) {
gTclInMemAsync = true;
calogCurrentRetire();
// A runaway (non-catching) script unwinds to the top of Tcl_EvalEx here, which lets the
// deferred retire fire. A script that deliberately `catch`es this and loops can defeat the
// budget and pin its thread -- an accepted cooperative-model limitation shared by every
// engine including the Lua reference (see design.md sec 24).
Tcl_SetObjResult(ip, Tcl_NewStringObj("context exceeded its memory budget", -1));
gTclInMemAsync = false;
return TCL_ERROR;
}
return code;
}
// The time-limit handler: Tcl fires this when its wall-clock time limit elapses, but calog's
// deadline is on the monotonic clock, so this is authoritative on that. Past the monotonic
// deadline -> retire and leave the limit exceeded (Tcl unwinds with TCL_ERROR). Fired early (the
// wall clock ran ahead of monotonic) -> push the Tcl limit forward by the remaining budget so the
// script keeps running.
static void tclTimeLimit(void *cd, Tcl_Interp *ip) {
CalogTclT *context;
uint64_t nowMs;
context = (CalogTclT *)cd;
if (context->limits == NULL || context->limits->deadlineMs == 0) {
return;
}
nowMs = calogMonotonicMillis();
if (nowMs >= context->limits->deadlineMs) {
calogCurrentRetire();
} else {
Tcl_Time t;
uint64_t remainMs;
remainMs = context->limits->deadlineMs - nowMs;
Tcl_GetTime(&t);
t.sec += (long long)(remainMs / 1000);
t.usec += (long)((remainMs % 1000) * 1000);
if (t.usec >= 1000000) {
t.sec += 1;
t.usec -= 1000000;
}
Tcl_LimitSetTime(ip, &t);
}
}
// calogCallback command ?arg ...? -- wrap a Tcl command prefix as a calog function value (its name). // calogCallback command ?arg ...? -- wrap a Tcl command prefix as a calog function value (its name).
static int tclCallbackCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) { static int tclCallbackCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
CalogTclT *context; CalogTclT *context;
@ -139,6 +266,13 @@ void calogTclDestroy(CalogTclT *context) {
if (context == NULL) { if (context == NULL) {
return; return;
} }
// This thread's limit pointers alias the context's limit state, which is freed with the
// context; clear them (and drop the async token) so nothing on this thread reads them after.
gTclLimits = NULL;
gTclMemAsync = NULL;
if (context->memAsync != NULL) {
Tcl_AsyncDelete(context->memAsync);
}
if (context->interp != NULL) { if (context->interp != NULL) {
Tcl_DeleteInterp(context->interp); // fires every function-value command's delete proc Tcl_DeleteInterp(context->interp); // fires every function-value command's delete proc
} }

2
src/tcl/tclAdapter.h
View file

@ -22,7 +22,7 @@
typedef struct CalogTclT CalogTclT; typedef struct CalogTclT CalogTclT;
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId); int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
void calogTclDestroy(CalogTclT *context); void calogTclDestroy(CalogTclT *context);
int32_t calogTclExport(CalogTclT *context, const char *name, CalogFnT **out); int32_t calogTclExport(CalogTclT *context, const char *name, CalogFnT **out);
int32_t calogTclExpose(CalogTclT *context, const char *name); int32_t calogTclExpose(CalogTclT *context, const char *name);

2
src/tcl/tclEngine.c
View file

@ -30,7 +30,7 @@ static int32_t tclEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status; int32_t status;
*interpOut = NULL; *interpOut = NULL;
status = calogTclCreate(&tcl, calogContextBroker(context), calogContextId(context)); status = calogTclCreate(&tcl, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
if (status != calogOkE) { if (status != calogOkE) {
return status; return status;
} }

47
src/wren/wrenAdapter.c
View file

@ -25,13 +25,45 @@
#define WREN_MAX_CALL_ARITY 16 #define WREN_MAX_CALL_ARITY 16
struct CalogWrenT { struct CalogWrenT {
WrenVM *vm; WrenVM *vm;
CalogT *broker; CalogT *broker;
uint64_t ctxId; uint64_t ctxId;
char *errorMsg; // last error captured by wrenError CalogLimitStateT *limits; // sandbox limits (mem cap + deadline), or NULL
WrenHandle *callHandles[WREN_MAX_CALL_ARITY + 1]; // lazily-made "call(...)" handles char *errorMsg; // last error captured by wrenError
WrenHandle *callHandles[WREN_MAX_CALL_ARITY + 1]; // lazily-made "call(...)" handles
}; };
// Called from the patched Wren bytecode loop (CASE_CODE(LOOP) in wren.c) once per loop iteration.
// Returns 1 if the context's live allocation (Wren's own vm->bytesAllocated) is over its memory cap,
// 2 if the wall-clock deadline has passed, else 0. The context rides on the VM's userData, so no
// thread-local is needed; unlimited contexts return 0 after two loads. memUsed mirrors the VM's
// byte count for reporting. The deadline is read every iteration (not amortized) so a slow loop is
// still retired near its budget; only limited contexts reach the clock read.
int calogWrenLoopCheck(void *userData, size_t bytesAllocated) {
CalogWrenT *context;
CalogLimitStateT *limits;
context = (CalogWrenT *)userData;
if (context == NULL) {
return 0;
}
limits = context->limits;
if (limits == NULL) {
return 0;
}
if (limits->memCap > 0) {
limits->memUsed = (int64_t)bytesAllocated;
if ((int64_t)bytesAllocated > limits->memCap) {
return 1;
}
}
if (limits->deadlineMs != 0 && calogMonotonicMillis() >= limits->deadlineMs) {
return 2;
}
return 0;
}
// Backs a CalogFnT exported from this VM: the owning context and the retained function // Backs a CalogFnT exported from this VM: the owning context and the retained function
// handle (released on drop). // handle (released on drop).
typedef struct WrenExportT { typedef struct WrenExportT {
@ -79,7 +111,7 @@ static const char WREN_PREAMBLE[] =
"}"; "}";
int32_t calogWrenCreate(CalogWrenT **out, CalogT *broker, uint64_t ctxId) { int32_t calogWrenCreate(CalogWrenT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
CalogWrenT *context; CalogWrenT *context;
WrenConfiguration config; WrenConfiguration config;
@ -107,6 +139,9 @@ int32_t calogWrenCreate(CalogWrenT **out, CalogT *broker, uint64_t ctxId) {
free(context); free(context);
return calogErrUnsupportedE; return calogErrUnsupportedE;
} }
// Armed only after the preamble, so the base runtime is neither charged nor deadline-checked
// (the memory cap must exceed the base runtime, as with Lua); the loop check reads this pointer.
context->limits = limits;
*out = context; *out = context;
return calogOkE; return calogOkE;
} }

2
src/wren/wrenAdapter.h
View file

@ -20,7 +20,7 @@
typedef struct CalogWrenT CalogWrenT; typedef struct CalogWrenT CalogWrenT;
int32_t calogWrenCreate(CalogWrenT **out, CalogT *broker, uint64_t ctxId); int32_t calogWrenCreate(CalogWrenT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
void calogWrenDestroy(CalogWrenT *context); void calogWrenDestroy(CalogWrenT *context);
int32_t calogWrenExport(CalogWrenT *context, const char *globalName, CalogFnT **out); int32_t calogWrenExport(CalogWrenT *context, const char *globalName, CalogFnT **out);
int32_t calogWrenExpose(CalogWrenT *context, const char *name); int32_t calogWrenExpose(CalogWrenT *context, const char *name);

2
src/wren/wrenEngine.c
View file

@ -29,7 +29,7 @@ static int32_t wrenEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status; int32_t status;
*interpOut = NULL; *interpOut = NULL;
status = calogWrenCreate(&wren, calogContextBroker(context), calogContextId(context)); status = calogWrenCreate(&wren, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
if (status != calogOkE) { if (status != calogOkE) {
return status; return status;
} }

108
tests/testSandbox.c
View file

@ -196,6 +196,114 @@ int main(void) {
runLimited(&calogMyBasicEngine, "s = \"x\"\nWHILE 1\ns = s + s\nWEND", &memLimits); runLimited(&calogMyBasicEngine, "s = \"x\"\nWHILE 1\ns = s + s\nWEND", &memLimits);
CHECK(atomic_load(&errorCount) >= 1, "memory cap (my-basic): an over-budget script is retired"); CHECK(atomic_load(&errorCount) >= 1, "memory cap (my-basic): an over-budget script is retired");
// 5. Berry parity: the allow-list (engine-agnostic), the wall-clock budget (the VM's
// instruction-loop heartbeat hook), and the memory cap (the be_realloc cap patch, which
// refuses a grow past budget with a clean be_throw).
resetFlags();
runLimited(&calogBerryEngine, "reached()\nforbidden()\ndone()", &allowLimits);
CHECK(atomic_load(&reachedFlag), "allow-list (berry): a permitted native runs");
CHECK(atomic_load(&errorCount) >= 1, "allow-list (berry): calling a forbidden native errors");
CHECK(!atomic_load(&forbiddenFlag), "allow-list (berry): the forbidden native body never ran");
resetFlags();
runLimited(&calogBerryEngine, "x = 0\nwhile true\nx = x + 1\nend", &timeLimits);
CHECK(atomic_load(&errorCount) >= 1, "time budget (berry): a runaway loop is retired");
resetFlags();
runLimited(&calogBerryEngine, "s = 'x'\nwhile true\ns = s + s\nend", &memLimits);
CHECK(atomic_load(&errorCount) >= 1, "memory cap (berry): an over-budget script is retired");
// 6. Tcl parity: the allow-list (engine-agnostic), the wall-clock budget (Tcl's built-in
// per-interp time limit, checked from the bytecode loop), and the memory cap (the zippy-allocator
// counting patch that trips an async handler once over budget).
resetFlags();
runLimited(&calogTclEngine, "reached\nforbidden\ndone", &allowLimits);
CHECK(atomic_load(&reachedFlag), "allow-list (tcl): a permitted native runs");
CHECK(atomic_load(&errorCount) >= 1, "allow-list (tcl): calling a forbidden native errors");
CHECK(!atomic_load(&forbiddenFlag), "allow-list (tcl): the forbidden native body never ran");
resetFlags();
runLimited(&calogTclEngine, "while {1} {}", &timeLimits);
CHECK(atomic_load(&errorCount) >= 1, "time budget (tcl): a runaway loop is retired");
resetFlags();
runLimited(&calogTclEngine, "set s x\nwhile {1} {append s $s}", &memLimits);
CHECK(atomic_load(&errorCount) >= 1, "memory cap (tcl): an over-budget script is retired");
// 7. mruby parity: the allow-list (engine-agnostic), the wall-clock budget (the per-instruction
// code-fetch hook, compiled in via MRB_USE_DEBUG_HOOK), and the memory cap (the mrb_basic_alloc_func
// override, which refuses a grow past budget for a clean NoMemoryError).
resetFlags();
runLimited(&calogMrubyEngine, "reached()\nforbidden()\ndone()", &allowLimits);
CHECK(atomic_load(&reachedFlag), "allow-list (mruby): a permitted native runs");
CHECK(atomic_load(&errorCount) >= 1, "allow-list (mruby): calling a forbidden native errors");
CHECK(!atomic_load(&forbiddenFlag), "allow-list (mruby): the forbidden native body never ran");
resetFlags();
runLimited(&calogMrubyEngine, "while true do end", &timeLimits);
CHECK(atomic_load(&errorCount) >= 1, "time budget (mruby): a runaway loop is retired");
resetFlags();
runLimited(&calogMrubyEngine, "s = 'x'\nwhile true do\ns = s + s\nend", &memLimits);
CHECK(atomic_load(&errorCount) >= 1, "memory cap (mruby): an over-budget script is retired");
// 8. Squirrel parity: the allow-list (engine-agnostic), the wall-clock budget and the memory cap
// (both enforced from the VM's Execute dispatch loop -- the counting allocator trips a flag the
// loop checks every instruction, and a periodic poll checks the deadline).
resetFlags();
runLimited(&calogSquirrelEngine, "reached(); forbidden(); done();", &allowLimits);
CHECK(atomic_load(&reachedFlag), "allow-list (squirrel): a permitted native runs");
CHECK(atomic_load(&errorCount) >= 1, "allow-list (squirrel): calling a forbidden native errors");
CHECK(!atomic_load(&forbiddenFlag), "allow-list (squirrel): the forbidden native body never ran");
resetFlags();
runLimited(&calogSquirrelEngine, "while(true){}", &timeLimits);
CHECK(atomic_load(&errorCount) >= 1, "time budget (squirrel): a runaway loop is retired");
resetFlags();
runLimited(&calogSquirrelEngine, "local s = \"x\"; while(true){ s = s + s; }", &memLimits);
CHECK(atomic_load(&errorCount) >= 1, "memory cap (squirrel): an over-budget script is retired");
// 9. Wren parity: the allow-list (engine-agnostic), the wall-clock budget and the memory cap
// (both enforced from the bytecode loop's back-jump, so a runaway loop and an exponential
// doubling are caught within one iteration). Wren reaches natives via Calog.call.
resetFlags();
runLimited(&calogWrenEngine, "Calog.call(\"reached\", [])\nCalog.call(\"forbidden\", [])\nCalog.call(\"done\", [])", &allowLimits);
CHECK(atomic_load(&reachedFlag), "allow-list (wren): a permitted native runs");
CHECK(atomic_load(&errorCount) >= 1, "allow-list (wren): calling a forbidden native errors");
CHECK(!atomic_load(&forbiddenFlag), "allow-list (wren): the forbidden native body never ran");
resetFlags();
runLimited(&calogWrenEngine, "while (true) {}", &timeLimits);
CHECK(atomic_load(&errorCount) >= 1, "time budget (wren): a runaway loop is retired");
resetFlags();
runLimited(&calogWrenEngine, "var s = \"x\"\nwhile (true) { s = s + s }", &memLimits);
CHECK(atomic_load(&errorCount) >= 1, "memory cap (wren): an over-budget script is retired");
// Unbounded recursion executes no LOOP back-jump, so it is caught by the post-call check, not the
// loop check -- a runaway that the loop-only check would have missed.
resetFlags();
runLimited(&calogWrenEngine, "class R { static go() { R.go() } }\nR.go()", &timeLimits);
CHECK(atomic_load(&errorCount) >= 1, "time budget (wren): runaway recursion is retired");
// 10. Janet parity: the allow-list (engine-agnostic), the wall-clock budget (an out-of-band
// watchdog thread interrupts the VM at the deadline -- Janet has no in-loop time hook), and the
// memory cap (the header allocator interrupts the VM on an over-cap allocation).
resetFlags();
runLimited(&calogJanetEngine, "(reached) (forbidden) (done)", &allowLimits);
CHECK(atomic_load(&reachedFlag), "allow-list (janet): a permitted native runs");
CHECK(atomic_load(&errorCount) >= 1, "allow-list (janet): calling a forbidden native errors");
CHECK(!atomic_load(&forbiddenFlag), "allow-list (janet): the forbidden native body never ran");
resetFlags();
runLimited(&calogJanetEngine, "(var i 0) (while true (set i (+ i 1)))", &timeLimits);
CHECK(atomic_load(&errorCount) >= 1, "time budget (janet): a runaway loop is retired");
resetFlags();
runLimited(&calogJanetEngine, "(var s \"x\") (while true (set s (string s s)))", &memLimits);
CHECK(atomic_load(&errorCount) >= 1, "memory cap (janet): an over-budget script is retired");
calogDestroy(calog); calogDestroy(calog);
printf("\n%d checks, %d failed\n", testsRun, testsFailed); printf("\n%d checks, %d failed\n", testsRun, testsFailed);

2
tests/testSquirrel.c
View file

@ -130,7 +130,7 @@ int main(void) {
printf("broker create failed\n"); printf("broker create failed\n");
return 1; return 1;
} }
if (calogSquirrelCreate(&sqctx, broker, 0) != calogOkE) { if (calogSquirrelCreate(&sqctx, broker, 0, NULL) != calogOkE) {
printf("squirrel context create failed\n"); printf("squirrel context create failed\n");
return 1; return 1;
} }

29
vendor/berry/src/be_mem.c vendored
View file

@ -14,6 +14,14 @@
#define GC_ALLOC (1 << 2) /* GC in alloc */ #define GC_ALLOC (1 << 2) /* GC in alloc */
// --- calog patch: per-context memory cap (calog sandbox) ---
// Returns non-zero when charging `growth` more bytes on top of the running context's
// current live usage would exceed its memory budget. Defined in src/berry/berryAdapter.c
// (reads a thread-local limit state); a plain (size_t,size_t)->int signature keeps calog
// types out of the vendored VM. Returns 0 for an unlimited context.
extern int calogBerryMemOverCap(size_t usage, size_t growth);
// --- end calog patch ---
#ifdef BE_EXPLICIT_MALLOC #ifdef BE_EXPLICIT_MALLOC
#define malloc BE_EXPLICIT_MALLOC #define malloc BE_EXPLICIT_MALLOC
#endif #endif
@ -94,6 +102,27 @@ BERRY_API void* be_realloc(bvm *vm, void *ptr, size_t old_size, size_t new_size)
} }
/* from now on, block == NULL means allocation failure */ /* from now on, block == NULL means allocation failure */
// --- calog patch: refuse a growth past the context's memory cap ---
// Force a GC first (mirroring the allocation-failure retry below), then refuse if
// still over budget, so the block is never allocated past the cap -- no transient
// host-OOM spike. Skipped while a GC is already running (GC_ALLOC) so the collector's
// own allocations do not re-enter this check. Also skipped when vm->errjmp == NULL: the
// VM is idle (e.g. the adapter marshalling callback args or reading an error string
// between be_pcalls), where be_throw would _os_abort() instead of unwinding -- turning a
// cap trip into a host crash. There the (rare, small) allocation is allowed; the cap is
// enforced on every allocation made while a script is actually executing (errjmp set),
// whereupon be_throw longjmps to the protected frame like the real-OOM path.
if (new_size > old_size && vm->errjmp != NULL && !(vm->gc.status & GC_ALLOC)
&& calogBerryMemOverCap(vm->gc.usage, new_size - old_size)) {
vm->gc.status |= GC_ALLOC;
be_gc_collect(vm);
vm->gc.status &= ~GC_ALLOC;
if (calogBerryMemOverCap(vm->gc.usage, new_size - old_size)) {
be_throw(vm, BE_MALLOC_FAIL);
}
}
// --- end calog patch ---
while (1) { while (1) {
/* Case 1: new allocation */ /* Case 1: new allocation */
#if BE_USE_PERF_COUNTERS #if BE_USE_PERF_COUNTERS

4
vendor/janet/janet.c vendored
View file

@ -24088,7 +24088,9 @@ JANET_CORE_FN(os_realpath,
janet_panicf("path does not exist: %v", ret); janet_panicf("path does not exist: %v", ret);
} }
#else #else
janet_free(dest); free(dest); /* calog patch: realpath() returns a libc-malloc'd buffer, not a janet_malloc one --
* free it raw, matching the _fullpath branch above, so calog's header allocator
* (janet.h macros -> calogJanetFree) does not read a header that is not there. */
#endif #endif
return ret; return ret;
#endif #endif

14
vendor/janet/janet.h vendored
View file

@ -2428,6 +2428,20 @@ JANET_API void *(janet_malloc)(size_t);
JANET_API void *(janet_realloc)(void *, size_t); JANET_API void *(janet_realloc)(void *, size_t);
JANET_API void *(janet_calloc)(size_t, size_t); JANET_API void *(janet_calloc)(size_t, size_t);
JANET_API void (janet_free)(void *); JANET_API void (janet_free)(void *);
/* --- calog patch: route all Janet allocation through the per-context memory-cap allocator ---
* Defined in src/janet/janetAdapter.c: a header allocator that tallies the running context's live
* bytes via a thread-local and, once over the cap, interrupts the VM (janet_interpreter_interrupt)
* so the bytecode loop suspends at its next back-jump/call. Defining the macros here (before the
* guards below) makes the #ifndef blocks skip Janet's malloc/realloc/calloc/free defaults. */
extern void *calogJanetMalloc(size_t size);
extern void *calogJanetRealloc(void *ptr, size_t size);
extern void *calogJanetCalloc(size_t nmemb, size_t size);
extern void calogJanetFree(void *ptr);
#define janet_malloc(X) calogJanetMalloc((X))
#define janet_realloc(X, Y) calogJanetRealloc((X), (Y))
#define janet_calloc(X, Y) calogJanetCalloc((X), (Y))
#define janet_free(X) calogJanetFree((X))
/* --- end calog patch --- */
#ifndef janet_malloc #ifndef janet_malloc
#define janet_malloc(X) malloc((X)) #define janet_malloc(X) malloc((X))
#endif #endif

15
vendor/squirrel-src/squirrel/sqmem.cpp vendored
View file

@ -2,10 +2,19 @@
see copyright notice in squirrel.h see copyright notice in squirrel.h
*/ */
#include "sqpcheader.h" #include "sqpcheader.h"
// --- calog patch: count every allocation against the running context's memory cap ---
// Squirrel's allocator is process-global and passes exact sizes (so no per-block header is needed);
// calogSquirrelMemCharge (src/squirrel/squirrelAdapter.c) tallies the running context's live bytes
// via a thread-local and returns non-zero once over the cap, tripping the flag the Execute loop
// checks. The allocator never refuses (Squirrel does not NULL-check allocations) -- enforcement is
// the Execute-loop unwind. _calogSqTrip is defined in sqvm.cpp.
extern "C" int calogSquirrelMemCharge(long long delta);
extern thread_local int _calogSqTrip;
// --- end calog patch ---
#ifndef SQ_EXCLUDE_DEFAULT_MEMFUNCTIONS #ifndef SQ_EXCLUDE_DEFAULT_MEMFUNCTIONS
void *sq_vm_malloc(SQUnsignedInteger size){ return malloc(size); } void *sq_vm_malloc(SQUnsignedInteger size){ void *p = malloc(size); if (p && calogSquirrelMemCharge((long long)size)) { _calogSqTrip = 1; } return p; }
void *sq_vm_realloc(void *p, SQUnsignedInteger SQ_UNUSED_ARG(oldsize), SQUnsignedInteger size){ return realloc(p, size); } void *sq_vm_realloc(void *p, SQUnsignedInteger oldsize, SQUnsignedInteger size){ void *q = realloc(p, size); if (q && calogSquirrelMemCharge((long long)size - (long long)oldsize)) { _calogSqTrip = 1; } return q; }
void sq_vm_free(void *p, SQUnsignedInteger SQ_UNUSED_ARG(size)){ free(p); } void sq_vm_free(void *p, SQUnsignedInteger size){ free(p); calogSquirrelMemCharge(-(long long)size); }
#endif #endif

32
vendor/squirrel-src/squirrel/sqvm.cpp vendored
View file

@ -695,6 +695,21 @@ bool SQVM::IsFalse(SQObjectPtr &o)
return false; return false;
} }
extern SQInstructionDesc g_InstrDesc[]; extern SQInstructionDesc g_InstrDesc[];
// --- calog patch: per-context sandbox limits (memory cap + wall-clock budget) ---
// Squirrel has no per-VM allocator or a hook that fires inside a tight loop, so both limits are
// enforced from the Execute dispatch loop below. _calogSqTrip is set to 1 by the counting allocator
// (sqmem.cpp) the instant a context's live memory crosses its cap -- checked every instruction so an
// exponential doubling loop is caught at the next opcode, not after a poll interval -- and to 2 by
// the periodic time poll when the wall-clock deadline passes. Enforcement uses the VM's own
// Raise_Error + SQ_THROW so the script unwinds cleanly through exception_trap. The calog helpers are
// C-linkage (defined in src/squirrel/squirrelAdapter.c).
extern "C" void calogCurrentRetire(void);
extern "C" int calogSquirrelTimeExpired(void);
extern "C" int calogSquirrelMemExceeded(void);
thread_local int _calogSqTrip = 0;
thread_local SQUnsignedInteger _calogSqPoll = 0;
// --- end calog patch ---
bool SQVM::Execute(SQObjectPtr &closure, SQInteger nargs, SQInteger stackbase,SQObjectPtr &outres, SQBool raiseerror,ExecutionType et) bool SQVM::Execute(SQObjectPtr &closure, SQInteger nargs, SQInteger stackbase,SQObjectPtr &outres, SQBool raiseerror,ExecutionType et)
{ {
if ((_nnativecalls + 1) > MAX_NATIVE_CALLS) { Raise_Error(_SC("Native stack overflow")); return false; } if ((_nnativecalls + 1) > MAX_NATIVE_CALLS) { Raise_Error(_SC("Native stack overflow")); return false; }
@ -739,6 +754,23 @@ exception_restore:
{ {
for(;;) for(;;)
{ {
// --- calog patch: enforce the running context's sandbox limits (see note above Execute) ---
if (_calogSqTrip) {
SQInteger _calogWhy = _calogSqTrip;
_calogSqTrip = 0;
// Re-verify memory (a transient spike freed within the same opcode must not kill the
// context); a time trip is authoritative.
if (_calogWhy == 2 || calogSquirrelMemExceeded()) {
calogCurrentRetire();
Raise_Error(_calogWhy == 2 ? _SC("context exceeded its time budget")
: _SC("context exceeded its memory budget"));
SQ_THROW();
}
}
if ((++_calogSqPoll & 1023) == 0 && calogSquirrelTimeExpired()) {
_calogSqTrip = 2;
}
// --- end calog patch ---
const SQInstruction &_i_ = *ci->_ip++; const SQInstruction &_i_ = *ci->_ip++;
//dumpstack(_stackbase); //dumpstack(_stackbase);
//scprintf("\n[%d] %s %d %d %d %d\n",ci->_ip-_closure(ci->_closure)->_function->_instructions,g_InstrDesc[_i_.op].name,arg0,arg1,arg2,arg3); //scprintf("\n[%d] %s %d %d %d %d\n",ci->_ip-_closure(ci->_closure)->_function->_instructions,g_InstrDesc[_i_.op].name,arg0,arg1,arg2,arg3);

20
vendor/tcl/generic/tclThreadAlloc.c vendored
View file

@ -15,6 +15,15 @@
#include "tclInt.h" #include "tclInt.h"
#if TCL_THREADS && defined(USE_THREAD_ALLOC) #if TCL_THREADS && defined(USE_THREAD_ALLOC)
/* --- calog patch: per-context memory cap (calog sandbox) ---
* Charge every user allocation/free of the zippy allocator against the running context's
* budget. Defined in src/tcl/tclAdapter.c (updates a thread-local limit state and, once over
* budget, marks a Tcl async handler that unwinds the eval on the next bytecode async check).
* A plain (int64)->void signature keeps calog types out of the vendored VM; it is a no-op for
* an unlimited context. Positive delta = bytes gained, negative = bytes released. */
extern void calogTclMemCharge(long long delta);
/* --- end calog patch --- */
/* /*
* If range checking is enabled, an additional byte will be allocated to store * If range checking is enabled, an additional byte will be allocated to store
* the magic number at the end of the requested memory. * the magic number at the end of the requested memory.
@ -343,6 +352,7 @@ TclpAlloc(
if (blockPtr == NULL) { if (blockPtr == NULL) {
return NULL; return NULL;
} }
calogTclMemCharge((long long)reqSize); /* calog: charge the user request */
return Block2Ptr(blockPtr, bucket, reqSize); return Block2Ptr(blockPtr, bucket, reqSize);
} }
@ -384,6 +394,7 @@ TclpFree(
blockPtr = Ptr2Block(ptr); blockPtr = Ptr2Block(ptr);
bucket = blockPtr->sourceBucket; bucket = blockPtr->sourceBucket;
calogTclMemCharge(-(long long)blockPtr->blockReqSize); /* calog: release the user request */
if (bucket == NBUCKETS) { if (bucket == NBUCKETS) {
cachePtr->totalAssigned -= blockPtr->blockReqSize; cachePtr->totalAssigned -= blockPtr->blockReqSize;
TclpSysFree(blockPtr); TclpSysFree(blockPtr);
@ -457,17 +468,20 @@ TclpRealloc(
min = 0; min = 0;
} }
if (size > min && size <= bucketInfo[bucket].blockSize) { if (size > min && size <= bucketInfo[bucket].blockSize) {
calogTclMemCharge((long long)reqSize - (long long)blockPtr->blockReqSize); /* calog: in-place resize */
cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize; cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
cachePtr->buckets[bucket].totalAssigned += reqSize; cachePtr->buckets[bucket].totalAssigned += reqSize;
return Block2Ptr(blockPtr, bucket, reqSize); return Block2Ptr(blockPtr, bucket, reqSize);
} }
} else if (size > MAXALLOC) { } else if (size > MAXALLOC) {
size_t calogOldReq = blockPtr->blockReqSize; /* calog: save before the block header is realloc'd away */
cachePtr->totalAssigned -= blockPtr->blockReqSize; cachePtr->totalAssigned -= blockPtr->blockReqSize;
cachePtr->totalAssigned += reqSize; cachePtr->totalAssigned += reqSize;
blockPtr = (Block*)TclpSysRealloc(blockPtr, size); blockPtr = (Block*)TclpSysRealloc(blockPtr, size);
if (blockPtr == NULL) { if (blockPtr == NULL) {
return NULL; return NULL;
} }
calogTclMemCharge((long long)reqSize - (long long)calogOldReq); /* calog: system resize */
return Block2Ptr(blockPtr, NBUCKETS, reqSize); return Block2Ptr(blockPtr, NBUCKETS, reqSize);
} }
@ -540,6 +554,12 @@ TclThreadAllocObj(void)
if (newObjsPtr == NULL) { if (newObjsPtr == NULL) {
Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove); Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove);
} }
/* calog: Tcl_Obj bodies come from this bulk pool chunk, bypassing TclpAlloc's per-block
* charge (and the inlined TclAllocObjStorageEx fast path bypasses per-object accounting),
* so charge the whole chunk here or the cap undercounts an object-heavy workload. The
* chunk is thread-lifetime (freed only at teardown, when the context and its counter are
* gone), so no matching uncharge is needed. */
calogTclMemCharge((long long)(sizeof(Tcl_Obj) * numMove));
cachePtr->lastPtr = newObjsPtr + numMove - 1; cachePtr->lastPtr = newObjsPtr + numMove - 1;
objPtr = cachePtr->firstObjPtr; /* NULL */ objPtr = cachePtr->firstObjPtr; /* NULL */
while (numMove-- > 0) { while (numMove-- > 0) {

38
vendor/wren/wren.c vendored
View file

@ -3372,6 +3372,16 @@ inline static bool checkArity(WrenVM* vm, Value value, int numArgs)
// The main bytecode interpreter loop. This is where the magic happens. It is // The main bytecode interpreter loop. This is where the magic happens. It is
// also, as you can imagine, highly performance critical. // also, as you can imagine, highly performance critical.
// --- calog patch: per-context sandbox limits (memory cap + wall-clock budget) ---
// Wren exposes no allocator hook that can refuse and no interrupt callback, so both limits are
// enforced from the bytecode loop. calogWrenLoopCheck (src/wren/wrenAdapter.c) is called once per
// loop back-jump (CASE_CODE(LOOP) below) -- the natural throttle point, so a runaway loop and an
// exponential doubling are each caught within one iteration -- and returns 1 (memory: vm's own
// bytesAllocated over the cap) or 2 (wall-clock deadline passed) or 0. Enforcement uses Wren's own
// RUNTIME_ERROR unwind. calogCurrentRetire is the calog core's context-retire request.
extern int calogWrenLoopCheck(void* userData, size_t bytesAllocated);
extern void calogCurrentRetire(void);
static WrenInterpretResult runInterpreter(WrenVM* vm, register ObjFiber* fiber) static WrenInterpretResult runInterpreter(WrenVM* vm, register ObjFiber* fiber)
{ {
// Remember the current fiber so we can find it if a GC happens. // Remember the current fiber so we can find it if a GC happens.
@ -3855,6 +3865,23 @@ OPCODE(END, 0)
UNREACHABLE(); UNREACHABLE();
break; break;
} }
// --- calog patch: also enforce limits after a call completes ---
// The LOOP check alone misses a runaway that never loops: unbounded recursion (each frame
// pushed here, not at a LOOP back-jump) and a single long-running primitive. Checking once
// per completed call bounds both. Skipped when the primitive already stopped the fiber.
if (vm->fiber != NULL)
{
int calogStop = calogWrenLoopCheck(vm->config.userData, vm->bytesAllocated);
if (calogStop != 0)
{
const char* calogMsg = calogStop == 2 ? "context exceeded its time budget"
: "context exceeded its memory budget";
calogCurrentRetire();
vm->fiber->error = wrenNewStringLength(vm, calogMsg, strlen(calogMsg));
RUNTIME_ERROR();
}
}
// --- end calog patch ---
DISPATCH(); DISPATCH();
} }
@ -3922,6 +3949,17 @@ OPCODE(END, 0)
CASE_CODE(LOOP): CASE_CODE(LOOP):
{ {
// --- calog patch: enforce the running context's sandbox limits once per loop iteration ---
int calogStop = calogWrenLoopCheck(vm->config.userData, vm->bytesAllocated);
if (calogStop != 0)
{
const char* calogMsg = calogStop == 2 ? "context exceeded its time budget"
: "context exceeded its memory budget";
calogCurrentRetire();
vm->fiber->error = wrenNewStringLength(vm, calogMsg, strlen(calogMsg));
RUNTIME_ERROR();
}
// --- end calog patch ---
// Jump back to the top of the loop. // Jump back to the top of the loop.
uint16_t offset = READ_SHORT(); uint16_t offset = READ_SHORT();
ip -= offset; ip -= offset;