// berryAdapter.c -- Berry engine adapter for the broker.
//
// Every exposed native is a Berry native closure carrying two upvalues -- the context
// (a comptr) and the native's name -- so the trampoline recovers its binding via
// be_getupval, marshals the Berry arguments to CalogValueT, and dispatches through
// calogCall (honoring the actor route hook). Marshalling covers scalars and binary-safe
// strings; aggregates cross both ways (out as a Berry list/map instance -- a host record
// materializes as a map -- and a script's list/map is read back by iterating its raw
// container). Functions cross both ways too: a Berry function out becomes a refcounted
// CalogFnT kept reachable by a hidden global (a GC root); a foreign CalogFnT pushed in
// becomes a native closure the script calls directly (tracked on the context and released
// at destroy, since Berry has no per-value finalizer).
//
// Error model: on failure the trampoline raises a Berry exception (be_raise, which
// longjmps out of the VM) after releasing any CalogValueT it owns.

#define _POSIX_C_SOURCE 200809L

#include "berryAdapter.h"

#include "berry.h"

#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define BERRY_REF_CAP        32
#define BERRY_FOREIGN_INITIAL 8

struct CalogBerryT {
    bvm              *vm;
    CalogT           *broker;
    uint64_t          ctxId;
    CalogLimitStateT *limits;   // sandbox limits (mem cap + deadline), or NULL if unlimited
    int32_t           nextRef;
    CalogFnT        **foreignFns;    // foreign function values pushed into this VM
    int32_t           foreignCount;
    int32_t           foreignCap;
    int32_t          *freeRefs;      // reclaimed _calog_fn_N slot numbers, reused before minting new ones
    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;
// The broker of the Berry context running on THIS thread. The heartbeat hook gets only the bvm, so
// this is how it reaches the runtime to ask whether the abort latch is set. Armed for every context,
// limited or not, because an unlimited script must be interruptible too.
static _Thread_local CalogT            *gBerryBroker = NULL;

// 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.
typedef struct BerryExportT {
    CalogBerryT *context;
    int32_t      refNum;
    char         refName[BERRY_REF_CAP];
} BerryExportT;

static int32_t berryCallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void    berryCallableRelease(CalogFnT *callable);
static int32_t berryExportValue(CalogBerryT *context, int index, CalogFnT **out);
static int     berryForeignCall(bvm *vm);
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 berryToValue(CalogBerryT *context, int index, CalogValueT *out, int32_t depth);
static int     berryTrampoline(bvm *vm);


int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
    CalogBerryT *context;

    *out = NULL;
    context = (CalogBerryT *)calloc(1, sizeof(*context));
    if (context == NULL) {
        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();
    if (context->vm == NULL) {
        free(context);
        return calogErrOomE;
    }
    context->broker = broker;
    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;
    gBerryBroker = broker;
    be_set_obs_hook(context->vm, berryObsHook);
    *out = context;
    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;
    }
    // The runtime was latched aborting (calogExit, or a signal): unwind this script even though it
    // may never call a native. Deliberately no retire -- teardown order stays the host's.
    if (gBerryBroker != NULL && calogAborting(gBerryBroker)) {
        calogAbortRaise();
        be_raise(vm, "calog_abort", CALOG_ABORT_MESSAGE);
    }
    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) {
    BerryExportT *export;
    CalogBerryT  *context;
    bvm          *vm;
    int           base;
    int32_t       index;
    int32_t       status;
    int           code;

    export  = (BerryExportT *)userData;
    context = export->context;
    vm      = context->vm;
    calogValueNil(result);
    base = be_top(vm);
    be_getglobal(vm, export->refName);
    if (be_isnil(vm, -1)) {
        be_pop(vm, be_top(vm) - base);
        return calogFail(result, calogErrDeadE, "berry callable no longer exists");
    }
    for (index = 0; index < argCount; index++) {
        status = berryFromValue(context, &args[index], 0);
        if (status != calogOkE) {
            be_pop(vm, be_top(vm) - base);
            return calogFail(result, status, "failed to marshal argument into berry");
        }
    }
    code = be_pcall(vm, argCount);
    if (code != BE_OK) {
        const char *message;
        message = be_tostring(vm, -1);
        status  = calogFail(result, calogErrArgE, message != NULL ? message : "berry call failed");
        be_pop(vm, be_top(vm) - base);
        return status;
    }
    status = berryToValue(context, base + 1, result, 0);
    be_pop(vm, be_top(vm) - base);
    return status;
}


static void berryCallableRelease(CalogFnT *callable) {
    BerryExportT *export;
    CalogBerryT  *context;
    bvm          *vm;
    void         *buffer;
    int64_t       cap64;

    export  = (BerryExportT *)calogFnUserData(callable);
    context = export->context;
    vm      = context->vm;
    // Drop the hidden global so the pinned function becomes collectable.
    be_pushnil(vm);
    be_setglobal(vm, export->refName);
    be_pop(vm, 1);
    // Reclaim the slot number so the next export reuses it instead of minting a fresh
    // hidden global. If the free list cannot grow, the number is simply not reused --
    // no leak, just a missed optimization on this release.
    buffer = context->freeRefs;
    cap64  = context->freeCap;
    if (calogGrow(&buffer, &cap64, (int64_t)context->freeCount + 1, sizeof(int32_t)) == calogOkE) {
        context->freeRefs                    = (int32_t *)buffer;
        context->freeCap                     = (int32_t)cap64;
        context->freeRefs[context->freeCount] = export->refNum;
        context->freeCount++;
    }
    free(export);
}


void calogBerryDestroy(CalogBerryT *context) {
    int32_t index;

    if (context == NULL) {
        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;
    gBerryBroker = NULL;
    // Release the foreign function values pushed into this VM (see berryTrackForeign).
    for (index = 0; index < context->foreignCount; index++) {
        calogFnRelease(context->foreignFns[index]);
    }
    free(context->foreignFns);
    free(context->freeRefs);
    if (context->vm != NULL) {
        be_vm_delete(context->vm);
    }
    free(context);
}


int32_t calogBerryExport(CalogBerryT *context, const char *globalName, CalogFnT **out) {
    bvm     *vm;
    int      base;
    int32_t  status;

    vm   = context->vm;
    *out = NULL;
    base = be_top(vm);
    if (!be_getglobal(vm, globalName)) {
        be_pop(vm, be_top(vm) - base);
        return calogErrNotFoundE;
    }
    if (!be_isfunction(vm, -1)) {
        be_pop(vm, be_top(vm) - base);
        return calogErrTypeE;
    }
    status = berryExportValue(context, -1, out);
    be_pop(vm, be_top(vm) - base);
    return status;
}


static int32_t berryExportValue(CalogBerryT *context, int index, CalogFnT **out) {
    bvm          *vm;
    BerryExportT *export;
    int32_t       status;

    vm     = context->vm;
    *out   = NULL;
    export = (BerryExportT *)malloc(sizeof(*export));
    if (export == NULL) {
        return calogErrOomE;
    }
    export->context = context;
    if (context->freeCount > 0) {
        // Reuse a slot released by a prior berryCallableRelease instead of minting a
        // new global name, so the hidden global table stays bounded by the peak number
        // of simultaneously live exports.
        context->freeCount--;
        export->refNum = context->freeRefs[context->freeCount];
    } else {
        export->refNum = context->nextRef;
        context->nextRef++;
    }
    snprintf(export->refName, sizeof(export->refName), "_calog_fn_%d", export->refNum);
    // Pin the function under a hidden global name (globals are GC roots).
    be_pushvalue(vm, index);
    be_setglobal(vm, export->refName);
    be_pop(vm, 1);
    status = calogFnCreate(out, context->broker, berryCallableInvoke, export, berryCallableRelease, context->ctxId);
    if (status != calogOkE) {
        be_pushnil(vm);
        be_setglobal(vm, export->refName);
        be_pop(vm, 1);
        free(export);
        return status;
    }
    return calogOkE;
}


int32_t calogBerryExpose(CalogBerryT *context, const char *name) {
    bvm         *vm;
    CalogEntryT *entry;

    vm    = context->vm;
    entry = calogLookup(context->broker, name);
    if (entry == NULL) {
        return calogErrNotFoundE;
    }
    // A native closure with two upvalues: the context (comptr) and the name. The
    // trampoline recovers them and dispatches through calogCall by name.
    be_pushntvclosure(vm, berryTrampoline, 2);
    be_pushcomptr(vm, context);
    be_setupval(vm, -2, 0);
    be_pop(vm, 1);
    be_pushstring(vm, name);
    be_setupval(vm, -2, 1);
    be_pop(vm, 1);
    be_setglobal(vm, name);
    be_pop(vm, 1);
    return calogOkE;
}


// Call trampoline for a foreign CalogFnT pushed into Berry as a native closure. Its two
// upvalues are the context and the CalogFnT (both comptrs), pushed above the arguments.
static int berryForeignCall(bvm *vm) {
    CalogBerryT *context;
    CalogFnT    *callable;
    CalogValueT *args;
    CalogValueT  result;
    int          argc;
    int          index;
    int32_t      status;
    char         message[CALOG_ERR_MSG_CAP];

    argc = be_top(vm);   // arguments occupy stack slots 1..argc
    be_getupval(vm, 0, 0);
    context  = (CalogBerryT *)be_tocomptr(vm, -1);
    be_getupval(vm, 0, 1);
    callable = (CalogFnT *)be_tocomptr(vm, -1);
    be_pop(vm, 2);
    args = NULL;
    if (argc > 0) {
        args = (CalogValueT *)calloc((size_t)argc, sizeof(CalogValueT));
        if (args == NULL) {
            be_raise(vm, "memory_error", "out of memory marshalling function-value args");
            return 0;
        }
    }
    for (index = 0; index < argc; index++) {
        status = berryToValue(context, index + 1, &args[index], 0);
        if (status != calogOkE) {
            int cleanup;
            for (cleanup = 0; cleanup < index; cleanup++) {
                calogValueFree(&args[cleanup]);
            }
            free(args);
            be_raise(vm, "value_error", "failed to marshal a function-value argument");
            return 0;
        }
    }
    status = calogFnInvoke(callable, args, argc, &result);
    for (index = 0; index < argc; index++) {
        calogValueFree(&args[index]);
    }
    free(args);
    if (status != calogOkE) {
        snprintf(message, sizeof(message), "%s", (result.type == calogStringE) ? result.as.s.bytes : "function value failed");
        calogValueFree(&result);
        be_raise(vm, "calog_error", message);
        return 0;
    }
    status = berryFromValue(context, &result, 0);
    calogValueFree(&result);
    if (status != calogOkE) {
        be_pop(vm, 1);
        be_raise(vm, "type_error", "failed to marshal the function-value result");
        return 0;
    }
    be_return(vm);
}


static int32_t berryFromValue(CalogBerryT *context, const CalogValueT *value, int32_t depth) {
    bvm *vm;

    vm = context->vm;
    if (depth >= CALOG_MAX_DEPTH) {
        be_pushnil(vm);
        return calogErrDepthE;
    }
    switch (value->type) {
        case calogNilE:
            be_pushnil(vm);
            return calogOkE;
        case calogBoolE:
            be_pushbool(vm, value->as.b);
            return calogOkE;
        case calogIntE:
            be_pushint(vm, (bint)value->as.i);
            return calogOkE;
        case calogRealE:
            be_pushreal(vm, (breal)value->as.r);
            return calogOkE;
        case calogStringE:
            be_pushnstring(vm, value->as.s.bytes, (size_t)value->as.s.length);
            return calogOkE;
        case calogAggE: {
            CalogAggT  *aggregate;
            const char *className;
            int64_t     index;
            int         containerBase;
            int32_t     childStatus;
            aggregate     = value->as.agg;
            containerBase = be_top(vm);
            // Populate a raw container: anything keyed (or an explicit map) is a map with
            // the sequence part at integer keys, else a list. be_setindex and be_data_push
            // take the value on top and do not pop, so drop it after each. A failed
            // recursive marshal leaves a nil on top of the failing key (or bare), so
            // unwind the whole container (Berry GC owns it) and propagate the error --
            // a single nil is left on top to keep this frame's own stack contract.
            if (calogAggIsKeyed(aggregate)) {
                className = "map";
                be_newmap(vm);
                for (index = 0; index < aggregate->arrayCount; index++) {
                    be_pushint(vm, (bint)index);
                    childStatus = berryFromValue(context, &aggregate->array[index], depth + 1);
                    if (childStatus != calogOkE) {
                        be_pop(vm, be_top(vm) - containerBase);
                        be_pushnil(vm);
                        return childStatus;
                    }
                    be_setindex(vm, -3);
                    be_pop(vm, 2);
                }
                for (index = 0; index < aggregate->pairCount; index++) {
                    const CalogValueT *key;
                    key = &aggregate->pairs[index].key;
                    if (key->type == calogStringE) {
                        be_pushnstring(vm, key->as.s.bytes, (size_t)key->as.s.length);
                    } else if (key->type == calogIntE) {
                        be_pushint(vm, (bint)key->as.i);
                    } else {
                        continue;   // non-scalar key: no Berry equivalent, drop the pair
                    }
                    childStatus = berryFromValue(context, &aggregate->pairs[index].value, depth + 1);
                    if (childStatus != calogOkE) {
                        be_pop(vm, be_top(vm) - containerBase);
                        be_pushnil(vm);
                        return childStatus;
                    }
                    be_setindex(vm, -3);
                    be_pop(vm, 2);
                }
            } else {
                className = "list";
                be_newlist(vm);
                for (index = 0; index < aggregate->arrayCount; index++) {
                    childStatus = berryFromValue(context, &aggregate->array[index], depth + 1);
                    if (childStatus != calogOkE) {
                        be_pop(vm, be_top(vm) - containerBase);
                        be_pushnil(vm);
                        return childStatus;
                    }
                    be_data_push(vm, -2);
                    be_pop(vm, 1);
                }
            }
            // A raw map/list is not subscriptable in a script; wrap it in its class
            // instance (map(raw) / list(raw)). Calling a class leaves the instance and
            // init's (nil) return above the raw, so move the instance down over the raw
            // and drop the two spare slots.
            be_getbuiltin(vm, className);
            be_pushvalue(vm, -2);
            be_call(vm, 1);
            be_moveto(vm, -2, -3);
            be_pop(vm, 2);
            return calogOkE;
        }
        case calogFnE: {
            // Berry has no per-value finalizer, so track the foreign function on the
            // context (released at destroy) and wrap it in a native closure -- callable
            // as f(x) -- whose upvalues are the context and the CalogFnT.
            if (berryTrackForeign(context, value->as.fn) != calogOkE) {
                be_pushnil(vm);
                return calogErrOomE;
            }
            be_pushntvclosure(vm, berryForeignCall, 2);
            be_pushcomptr(vm, context);
            be_setupval(vm, -2, 0);
            be_pop(vm, 1);
            be_pushcomptr(vm, value->as.fn);
            be_setupval(vm, -2, 1);
            be_pop(vm, 1);
            calogFnRetain(value->as.fn);
            return calogOkE;
        }
    }
    be_pushnil(vm);
    return calogErrTypeE;
}


int32_t calogBerryRun(CalogBerryT *context, const char *source) {
    bvm  *vm;
    bool  compiled;
    int   base;
    int   code;

    vm       = context->vm;
    base     = be_top(vm);
    code     = be_loadstring(vm, source);
    compiled = (code == BE_OK);
    if (compiled) {
        code = be_pcall(vm, 0);
    }
    if (code != BE_OK) {
        const char *message;
        // calogExit (calogAbortAll) unwound this script deliberately: not a failure, so report
        // nothing. Asked as "is this error ours", which can only be true of a script that
        // actually ran, so a syntax error still gets its diagnostic even mid-teardown.
        if (calogAbortRaised(context->broker)) {
            be_pop(vm, be_top(vm) - base);
            return calogOkE;
        }
        message = be_tostring(vm, -1);
        fprintf(stderr, "berry error: %s\n", message != NULL ? message : "(unknown)");
        be_pop(vm, be_top(vm) - base);
        return calogErrArgE;
    }
    be_pop(vm, be_top(vm) - base);
    return calogOkE;
}


static int32_t berryToValue(CalogBerryT *context, int index, CalogValueT *out, int32_t depth) {
    bvm *vm;

    vm = context->vm;
    calogValueNil(out);
    if (depth >= CALOG_MAX_DEPTH) {
        return calogErrDepthE;
    }
    if (be_isnil(vm, index)) {
        return calogOkE;
    }
    if (be_isbool(vm, index)) {
        calogValueBool(out, be_tobool(vm, index) != 0);
        return calogOkE;
    }
    if (be_isint(vm, index)) {
        calogValueInt(out, (int64_t)be_toint(vm, index));
        return calogOkE;
    }
    if (be_isreal(vm, index)) {
        calogValueReal(out, (double)be_toreal(vm, index));
        return calogOkE;
    }
    if (be_isstring(vm, index)) {
        const char *bytes;
        int         len;
        bytes = be_tostring(vm, index);
        len   = be_strlen(vm, index);
        return calogValueString(out, bytes, (int64_t)len);
    }
    if (be_isfunction(vm, index)) {
        CalogFnT *callable;
        int32_t   status;
        status = berryExportValue(context, index, &callable);
        if (status != calogOkE) {
            return status;
        }
        calogValueFn(out, callable);
        return calogOkE;
    }
    // A list/map instance holds its raw container in the hidden ".p" member. be_iter_*
    // take the CONTAINER index with the iterator on top of the stack (be_iter_next pushes
    // one value for a list, key+value for a map), so keep the container at -2 and restore
    // the iterator to the top after reading each entry.
    if (be_islistinstance(vm, index)) {
        CalogAggT *aggregate;
        int        base;
        int32_t    status;
        status = calogAggCreate(&aggregate, calogListE);
        if (status != calogOkE) {
            return status;
        }
        base = be_top(vm);
        be_getmember(vm, index, ".p");   // raw list -> top
        be_pushiter(vm, -1);             // iterator on top; container at -2
        while (be_iter_hasnext(vm, -2)) {
            CalogValueT element;
            be_iter_next(vm, -2);        // value on top
            status = berryToValue(context, -1, &element, depth + 1);
            be_pop(vm, be_top(vm) - (base + 2));   // restore to [container, iterator]
            if (status != calogOkE) {
                be_pop(vm, 2);
                calogAggFree(aggregate);
                return status;
            }
            status = calogAggPush(aggregate, &element);
            if (status != calogOkE) {
                calogValueFree(&element);
                be_pop(vm, 2);
                calogAggFree(aggregate);
                return status;
            }
        }
        be_pop(vm, 2);                   // container + iterator
        calogValueAgg(out, aggregate);
        return calogOkE;
    }
    if (be_ismapinstance(vm, index)) {
        CalogAggT *aggregate;
        int        base;
        int32_t    status;
        status = calogAggCreate(&aggregate, calogMapE);
        if (status != calogOkE) {
            return status;
        }
        base = be_top(vm);
        be_getmember(vm, index, ".p");   // raw map -> top
        be_pushiter(vm, -1);             // iterator on top; container at -2
        while (be_iter_hasnext(vm, -2)) {
            CalogValueT key;
            CalogValueT value;
            be_iter_next(vm, -2);        // key at -2, value at -1 (above the iterator)
            status = berryToValue(context, -2, &key, depth + 1);
            if (status != calogOkE) {
                be_pop(vm, be_top(vm) - base);
                calogAggFree(aggregate);
                return status;
            }
            status = berryToValue(context, -1, &value, depth + 1);
            if (status != calogOkE) {
                calogValueFree(&key);
                be_pop(vm, be_top(vm) - base);
                calogAggFree(aggregate);
                return status;
            }
            be_pop(vm, be_top(vm) - (base + 2));   // restore to [container, iterator]
            status = calogAggSet(aggregate, &key, &value);
            if (status != calogOkE) {
                calogValueFree(&key);
                calogValueFree(&value);
                be_pop(vm, 2);
                calogAggFree(aggregate);
                return status;
            }
        }
        be_pop(vm, 2);                   // container + iterator
        calogValueAgg(out, aggregate);
        return calogOkE;
    }
    // Other reference types have no CalogValueT equivalent.
    return calogErrUnsupportedE;
}


// Record a foreign function pushed into this VM so it is released at destroy (Berry has
// no per-value finalizer to release it when the wrapping closure is collected).
static int32_t berryTrackForeign(CalogBerryT *context, CalogFnT *callable) {
    if (context->foreignCount == context->foreignCap) {
        int32_t    newCap;
        CalogFnT **resized;
        newCap  = (context->foreignCap == 0) ? BERRY_FOREIGN_INITIAL : context->foreignCap * CALOG_GROWTH_FACTOR;
        resized = (CalogFnT **)realloc(context->foreignFns, (size_t)newCap * sizeof(CalogFnT *));
        if (resized == NULL) {
            return calogErrOomE;
        }
        context->foreignFns = resized;
        context->foreignCap = newCap;
    }
    context->foreignFns[context->foreignCount] = callable;
    context->foreignCount++;
    return calogOkE;
}


static int berryTrampoline(bvm *vm) {
    CalogBerryT *context;
    const char  *name;
    CalogValueT *args;
    CalogValueT  result;
    int          argc;
    int          index;
    int32_t      status;
    char         message[CALOG_ERR_MSG_CAP];

    argc = be_top(vm);   // arguments occupy stack slots 1..argc
    // Recover the binding from the closure's upvalues (pushed above the args).
    be_getupval(vm, 0, 0);
    context = (CalogBerryT *)be_tocomptr(vm, -1);
    be_getupval(vm, 0, 1);
    name = be_tostring(vm, -1);   // borrowed; valid until popped after the call

    args = NULL;
    if (argc > 0) {
        args = (CalogValueT *)calloc((size_t)argc, sizeof(CalogValueT));
        if (args == NULL) {
            be_pop(vm, 2);
            be_raise(vm, "memory_error", "out of memory marshalling native arguments");
            return 0;
        }
    }
    for (index = 0; index < argc; index++) {
        status = berryToValue(context, index + 1, &args[index], 0);
        if (status != calogOkE) {
            int cleanup;
            for (cleanup = 0; cleanup < index; cleanup++) {
                calogValueFree(&args[cleanup]);
            }
            free(args);
            be_pop(vm, 2);
            be_raise(vm, "type_error", "failed to marshal a native argument");
            return 0;
        }
    }
    status = calogCall(context->broker, name, args, argc, &result);
    for (index = 0; index < argc; index++) {
        calogValueFree(&args[index]);
    }
    free(args);
    be_pop(vm, 2);   // pop the two upvalues (name, context)
    if (status != calogOkE) {
        snprintf(message, sizeof(message), "%s", (result.type == calogStringE) ? result.as.s.bytes : "native call failed");
        calogValueFree(&result);
        be_raise(vm, "calog_error", message);
        return 0;
    }
    status = berryFromValue(context, &result, 0);
    calogValueFree(&result);
    if (status != calogOkE) {
        be_pop(vm, 1);
        be_raise(vm, "type_error", "failed to marshal the native result");
        return 0;
    }
    be_return(vm);
}