russell@unturf.com
b841b30bc4
Boehm's conservative pointer scan cannot recognize lumbda's Value layout — heap pointers live in the low 48 bits with QNAN + tag bits in the upper mantissa, so a raw word never looks like a heap address. Until now main.c neutralized this with GC_disable(): every allocation leaked, OOMing any long-running workload. Add precise tracing via a custom Boehm kind: - New c/gc.c: mark proc walks 8-byte words in mixed mode — when the QNAN bits are set with a pointer-bearing tag (0/2/4/5/6) extract the low-48 pointer; otherwise fall through to raw-pointer validation. GC_set_push_other_roots callback decodes NaN-boxed Values on the C stack via setjmp anchor + scan up to the stack base captured at process start. - Allocations holding Values (Pair, Env bindings, ValueStack data, ULVector data, HTEntry, Proc params + body, FullCont stack, CodeObj instrs, SymbolEntry) route through lumbda_value_malloc. Pure-byte sites (bignum limbs, char buffers, source files) stay on regular GC_MALLOC. - main.c / test.c / bench.c capture stack-base then drop GC_disable. types.c also zeros popped slots on the value stack so stale pointers do not survive a vs_pop and pin freed objects — independent correctness fix that pays off once GC actually runs. Build: USE_GC=1 (default when /usr/include/gc.h exists). Tests with GC enabled: - 88/88 c-test - 4/4 regression-named-let-leak (test that motivated GC_disable) - 205/205 functional (Python + C) - zoe-favorites all tiers (Python + C + asm + asm-full) alloc-test 1M cons drop-loop: - Before: 0.60s wall, 156 MB RSS, leaks every cell - After: 0.37s wall, 4 MB RSS, ~1500 GC cycles each freeing ~370 KB
832 lines
31 KiB
C
832 lines
31 KiB
C
/*
|
||
* portal.c — Save/resume machine state to JSON files
|
||
*
|
||
* Port of the Python portal_save/portal_resume system.
|
||
* Serializes environment bindings and full continuations.
|
||
*/
|
||
#include "lumbda.h"
|
||
#include <fcntl.h>
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* Portal checkpoint — thread-local signal for mid-execution save
|
||
*
|
||
* MOAD-0002: Module-level global — intentional coupling. Checked in the VM
|
||
* hot loop (OP_JUMP, OP_TAIL_CALL) so passing it as a parameter would add
|
||
* overhead to every iteration.
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
__thread const char *g_portal_checkpoint_path = NULL;
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* xoshiro256** — deterministic, portable PRNG shared with Python and asm.
|
||
* Portal serializes these 4 words so simulations continue across processes
|
||
* with a bit-identical random stream. Reference: Blackman & Vigna 2018.
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
static uint64_t g_rng_state[4] = {0, 0, 0, 0};
|
||
|
||
static uint64_t rng_rotl(uint64_t x, int k) {
|
||
return (x << k) | (x >> (64 - k));
|
||
}
|
||
|
||
static uint64_t rng_splitmix64_step(uint64_t *z) {
|
||
*z += 0x9e3779b97f4a7c15ULL;
|
||
uint64_t r = *z;
|
||
r = (r ^ (r >> 30)) * 0xbf58476d1ce4e5b9ULL;
|
||
r = (r ^ (r >> 27)) * 0x94d049bb133111ebULL;
|
||
return r ^ (r >> 31);
|
||
}
|
||
|
||
static void rng_seed(uint64_t k) {
|
||
uint64_t z = k;
|
||
for (int i = 0; i < 4; i++) g_rng_state[i] = rng_splitmix64_step(&z);
|
||
}
|
||
|
||
static uint64_t rng_next(void) {
|
||
uint64_t result = rng_rotl(g_rng_state[1] * 5, 7) * 9;
|
||
uint64_t t = g_rng_state[1] << 17;
|
||
g_rng_state[2] ^= g_rng_state[0];
|
||
g_rng_state[3] ^= g_rng_state[1];
|
||
g_rng_state[1] ^= g_rng_state[2];
|
||
g_rng_state[0] ^= g_rng_state[3];
|
||
g_rng_state[2] ^= t;
|
||
g_rng_state[3] = rng_rotl(g_rng_state[3], 45);
|
||
return result;
|
||
}
|
||
|
||
void rng_get_halves(uint32_t out[8]) {
|
||
for (int i = 0; i < 4; i++) {
|
||
out[2 * i] = (uint32_t)(g_rng_state[i] & 0xffffffffULL);
|
||
out[2 * i + 1] = (uint32_t)(g_rng_state[i] >> 32);
|
||
}
|
||
}
|
||
|
||
void rng_set_halves(const uint32_t in[8]) {
|
||
for (int i = 0; i < 4; i++) {
|
||
g_rng_state[i] = ((uint64_t)in[2 * i + 1] << 32) | (uint64_t)in[2 * i];
|
||
}
|
||
}
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* Minimal JSON writer — writes directly to FILE*
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
static void json_write_string(FILE *fp, const char *s) {
|
||
fputc('"', fp);
|
||
for (const char *p = s; *p; p++) {
|
||
switch (*p) {
|
||
case '"': fputs("\\\"", fp); break;
|
||
case '\\': fputs("\\\\", fp); break;
|
||
case '\n': fputs("\\n", fp); break;
|
||
case '\r': fputs("\\r", fp); break;
|
||
case '\t': fputs("\\t", fp); break;
|
||
default:
|
||
if ((unsigned char)*p < 0x20)
|
||
fprintf(fp, "\\u%04x", (unsigned)*p);
|
||
else
|
||
fputc(*p, fp);
|
||
}
|
||
}
|
||
fputc('"', fp);
|
||
}
|
||
|
||
static void json_write_value(FILE *fp, Value v);
|
||
|
||
static void json_write_env_bindings(FILE *fp, Env *env, bool global_only) {
|
||
/* Write user-defined bindings as a JSON object */
|
||
fputc('{', fp);
|
||
bool first = true;
|
||
for (size_t i = 0; i < env->nbuckets; i++) {
|
||
EnvBinding *b = env->buckets[i];
|
||
while (b) {
|
||
if (global_only) {
|
||
/* Skip builtins for global env — only save user values */
|
||
if (IS_BUILTIN(b->val)) { b = b->next; continue; }
|
||
if (IS_MACRO(b->val)) { b = b->next; continue; }
|
||
}
|
||
if (!first) fputc(',', fp);
|
||
first = false;
|
||
json_write_string(fp, sym_name(b->sym));
|
||
fputc(':', fp);
|
||
json_write_value(fp, b->val);
|
||
b = b->next;
|
||
}
|
||
}
|
||
fputc('}', fp);
|
||
}
|
||
|
||
static void json_write_value(FILE *fp, Value v) {
|
||
if (IS_NIL(v)) {
|
||
fputs("{\"t\":\"nil\"}", fp);
|
||
} else if (IS_VOID(v)) {
|
||
fputs("{\"t\":\"void\"}", fp);
|
||
} else if (IS_TRUE(v)) {
|
||
fputs("{\"t\":\"bool\",\"v\":true}", fp);
|
||
} else if (IS_FALSE(v)) {
|
||
fputs("{\"t\":\"bool\",\"v\":false}", fp);
|
||
} else if (IS_EOF(v)) {
|
||
fputs("{\"t\":\"eof\"}", fp);
|
||
} else if (IS_INT(v)) {
|
||
fprintf(fp, "%lld", (long long)as_int(v));
|
||
} else if (IS_DOUBLE(v)) {
|
||
double d = as_double(v);
|
||
if (isinf(d)) fprintf(fp, "{\"t\":\"float\",\"v\":\"%s\"}", d > 0 ? "+inf" : "-inf");
|
||
else if (isnan(d)) fputs("{\"t\":\"float\",\"v\":\"nan\"}", fp);
|
||
else fprintf(fp, "{\"t\":\"float\",\"v\":%.17g}", d);
|
||
} else if (IS_RATIONAL(v)) {
|
||
Rational *r = AS_RATIONAL(v);
|
||
fprintf(fp, "{\"t\":\"frac\",\"n\":%lld,\"d\":%lld}",
|
||
(long long)r->num, (long long)r->den);
|
||
} else if (IS_SYM(v)) {
|
||
fputs("{\"t\":\"sym\",\"v\":", fp);
|
||
json_write_string(fp, sym_name(v));
|
||
fputc('}', fp);
|
||
} else if (IS_STRING(v)) {
|
||
ULString *s = AS_STRING(v);
|
||
fputs(s->mutable ? "{\"t\":\"mstr\",\"v\":" : "{\"t\":\"str\",\"v\":", fp);
|
||
json_write_string(fp, s->data);
|
||
fputc('}', fp);
|
||
} else if (IS_CHAR(v)) {
|
||
fprintf(fp, "{\"t\":\"char\",\"v\":%d}", AS_CHAR(v));
|
||
} else if (IS_PAIR(v)) {
|
||
fputs("{\"t\":\"pair\",\"car\":", fp);
|
||
json_write_value(fp, CAR(v));
|
||
fputs(",\"cdr\":", fp);
|
||
json_write_value(fp, CDR(v));
|
||
fputc('}', fp);
|
||
} else if (IS_VECTOR(v)) {
|
||
ULVector *vec = AS_VECTOR(v);
|
||
fputs("{\"t\":\"vec\",\"v\":[", fp);
|
||
for (size_t i = 0; i < vec->len; i++) {
|
||
if (i > 0) fputc(',', fp);
|
||
json_write_value(fp, vec->data[i]);
|
||
}
|
||
fputs("]}", fp);
|
||
} else if (IS_HASHTABLE(v)) {
|
||
ULHashTable *ht = AS_HASHTABLE(v);
|
||
fputs("{\"t\":\"hash\",\"entries\":[", fp);
|
||
bool first = true;
|
||
for (size_t i = 0; i < ht->nbuckets; i++) {
|
||
HTEntry *e = ht->buckets[i];
|
||
while (e) {
|
||
if (!first) fputc(',', fp);
|
||
first = false;
|
||
fputc('[', fp);
|
||
json_write_value(fp, e->key);
|
||
fputc(',', fp);
|
||
json_write_value(fp, e->value);
|
||
fputc(']', fp);
|
||
e = e->next;
|
||
}
|
||
}
|
||
fputs("]}", fp);
|
||
} else if (IS_PROC(v)) {
|
||
/* Serialize procedure body as source text */
|
||
Proc *p = AS_PROC(v);
|
||
fputs("{\"t\":\"proc\"", fp);
|
||
if (p->name) { fputs(",\"name\":", fp); json_write_string(fp, p->name); }
|
||
fputs(",\"params\":[", fp);
|
||
for (int i = 0; i < p->nparams; i++) {
|
||
if (i > 0) fputc(',', fp);
|
||
json_write_string(fp, sym_name(p->params[i]));
|
||
}
|
||
fputs("]", fp);
|
||
if (!IS_NIL(p->rest)) {
|
||
fputs(",\"rest\":", fp);
|
||
json_write_string(fp, sym_name(p->rest));
|
||
}
|
||
fputs(",\"body\":[", fp);
|
||
for (int i = 0; i < p->body.count; i++) {
|
||
if (i > 0) fputc(',', fp);
|
||
char *s = show(p->body.exprs[i], false);
|
||
json_write_string(fp, s);
|
||
ul_free(s);
|
||
}
|
||
fputs("]}", fp);
|
||
} else if (IS_COMPILED_PROC(v)) {
|
||
/* For compiled procs, we save minimal info */
|
||
CompiledProc *cp = AS_COMPILED_PROC(v);
|
||
fputs("{\"t\":\"cproc\"", fp);
|
||
if (cp->name) { fputs(",\"name\":", fp); json_write_string(fp, cp->name); }
|
||
fputs(",\"params\":[", fp);
|
||
for (int i = 0; i < cp->nparams; i++) {
|
||
if (i > 0) fputc(',', fp);
|
||
json_write_string(fp, sym_name(cp->params[i]));
|
||
}
|
||
fputs("]", fp);
|
||
if (!IS_NIL(cp->rest)) {
|
||
fputs(",\"rest\":", fp);
|
||
json_write_string(fp, sym_name(cp->rest));
|
||
}
|
||
fputs("}", fp);
|
||
} else if (IS_CONTINUATION(v)) {
|
||
fputs("{\"t\":\"cont_marker\"}", fp);
|
||
} else if (IS_BUILTIN(v)) {
|
||
fputs("{\"t\":\"builtin\"}", fp);
|
||
} else {
|
||
fputs("{\"t\":\"opaque\"}", fp);
|
||
}
|
||
}
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* portal_save — write env + optional continuation to JSON
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
void portal_save(Env *env, const char *path, FullCont *continuation) {
|
||
FILE *fp = fopen(path, "w");
|
||
if (!fp) {
|
||
lisp_error("portal_save: cannot open %s", path);
|
||
return;
|
||
}
|
||
|
||
fputs("{\"format\":\"lumbda-portal-v1\",\n", fp);
|
||
|
||
/* RNG state — xoshiro256** as 8 × u32 halves (low, high, low, high, ...) */
|
||
{
|
||
uint32_t halves[8];
|
||
rng_get_halves(halves);
|
||
fputs("\"rng\":{\"algo\":\"xoshiro256**\",\"state\":[", fp);
|
||
for (int i = 0; i < 8; i++) {
|
||
if (i > 0) fputc(',', fp);
|
||
fprintf(fp, "%u", halves[i]);
|
||
}
|
||
fputs("]},\n", fp);
|
||
}
|
||
|
||
/* Environment bindings (user-defined only from global) */
|
||
fputs("\"env\":", fp);
|
||
json_write_env_bindings(fp, env, (env->global == env));
|
||
fputs(",\n", fp);
|
||
|
||
/* Continuation */
|
||
if (continuation) {
|
||
fputs("\"continuation\":{\"t\":\"cont\",\n", fp);
|
||
fprintf(fp, "\"ip\":%d,\n", continuation->ip);
|
||
fprintf(fp, "\"n_instrs\":%d,\n", continuation->n_instrs);
|
||
|
||
/* Stack */
|
||
fputs("\"stack\":[", fp);
|
||
for (int i = 0; i < continuation->stack_len; i++) {
|
||
if (i > 0) fputc(',', fp);
|
||
json_write_value(fp, continuation->stack[i]);
|
||
}
|
||
fputs("],\n", fp);
|
||
|
||
/* Environment */
|
||
fputs("\"env\":", fp);
|
||
json_write_env_bindings(fp, continuation->env, false);
|
||
fputs(",\n", fp);
|
||
|
||
/* Frames */
|
||
fprintf(fp, "\"nframes\":%d,\n", continuation->nframes);
|
||
fputs("\"frames\":[", fp);
|
||
for (int i = 0; i < continuation->nframes; i++) {
|
||
if (i > 0) fputc(',', fp);
|
||
VMFrame *f = &continuation->frames[i];
|
||
fputs("{", fp);
|
||
fprintf(fp, "\"ip\":%d,\"n_instrs\":%d,", f->ip, f->n_instrs);
|
||
fputs("\"stack\":[", fp);
|
||
for (int j = 0; j < f->stack_len; j++) {
|
||
if (j > 0) fputc(',', fp);
|
||
json_write_value(fp, f->stack[j]);
|
||
}
|
||
fputs("],\"env\":", fp);
|
||
json_write_env_bindings(fp, f->env, false);
|
||
fputc('}', fp);
|
||
}
|
||
fputs("]\n", fp);
|
||
|
||
fputc('}', fp);
|
||
} else {
|
||
fputs("\"continuation\":null", fp);
|
||
}
|
||
|
||
fputs("\n}\n", fp);
|
||
fclose(fp);
|
||
}
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* Minimal JSON reader — for portal_resume
|
||
*
|
||
* Supports: objects, arrays, strings, numbers, true, false, null
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
typedef enum {
|
||
JT_NULL, JT_BOOL, JT_INT, JT_FLOAT, JT_STRING, JT_ARRAY, JT_OBJECT
|
||
} JsonType;
|
||
|
||
typedef struct JsonNode JsonNode;
|
||
|
||
typedef struct JsonKV {
|
||
char *key;
|
||
JsonNode *value;
|
||
struct JsonKV *next;
|
||
} JsonKV;
|
||
|
||
struct JsonNode {
|
||
JsonType type;
|
||
union {
|
||
bool bval;
|
||
int64_t ival;
|
||
double fval;
|
||
char *sval;
|
||
struct { JsonNode **items; int count; } array;
|
||
JsonKV *object; /* linked list of key-value pairs */
|
||
};
|
||
};
|
||
|
||
static void skip_ws(const char **p) {
|
||
while (**p == ' ' || **p == '\t' || **p == '\n' || **p == '\r') (*p)++;
|
||
}
|
||
|
||
static JsonNode *json_parse(const char **p);
|
||
|
||
static char *json_parse_string(const char **p) {
|
||
if (**p != '"') return NULL;
|
||
(*p)++; /* skip opening " */
|
||
int cap = 256;
|
||
char *buf = (char *)ul_malloc(cap);
|
||
int len = 0;
|
||
while (**p && **p != '"') {
|
||
if (len + 8 >= cap) { cap *= 2; buf = (char *)ul_realloc(buf, cap); }
|
||
if (**p == '\\') {
|
||
(*p)++;
|
||
switch (**p) {
|
||
case '"': buf[len++] = '"'; break;
|
||
case '\\': buf[len++] = '\\'; break;
|
||
case 'n': buf[len++] = '\n'; break;
|
||
case 'r': buf[len++] = '\r'; break;
|
||
case 't': buf[len++] = '\t'; break;
|
||
case '/': buf[len++] = '/'; break;
|
||
case 'u': {
|
||
(*p)++;
|
||
char hex[5] = {0};
|
||
for (int i = 0; i < 4 && **p; i++) hex[i] = *(*p)++;
|
||
int code = (int)strtol(hex, NULL, 16);
|
||
if (code < 0x80) buf[len++] = (char)code;
|
||
else { buf[len++] = '?'; }
|
||
continue; /* skip the (*p)++ below */
|
||
}
|
||
default: buf[len++] = **p;
|
||
}
|
||
} else {
|
||
buf[len++] = **p;
|
||
}
|
||
(*p)++;
|
||
}
|
||
if (**p == '"') (*p)++; /* skip closing " */
|
||
buf[len] = '\0';
|
||
return buf;
|
||
}
|
||
|
||
static JsonNode *json_make_node(JsonType type) {
|
||
JsonNode *n = (JsonNode *)ul_malloc(sizeof(JsonNode));
|
||
memset(n, 0, sizeof(JsonNode));
|
||
n->type = type;
|
||
return n;
|
||
}
|
||
|
||
static JsonNode *json_parse(const char **p) {
|
||
skip_ws(p);
|
||
if (**p == '\0') return NULL;
|
||
|
||
if (**p == '"') {
|
||
JsonNode *n = json_make_node(JT_STRING);
|
||
n->sval = json_parse_string(p);
|
||
return n;
|
||
}
|
||
if (**p == '{') {
|
||
(*p)++;
|
||
JsonNode *n = json_make_node(JT_OBJECT);
|
||
n->object = NULL;
|
||
skip_ws(p);
|
||
if (**p == '}') { (*p)++; return n; }
|
||
JsonKV *tail = NULL;
|
||
while (1) {
|
||
skip_ws(p);
|
||
char *key = json_parse_string(p);
|
||
skip_ws(p);
|
||
if (**p == ':') (*p)++;
|
||
JsonNode *val = json_parse(p);
|
||
JsonKV *kv = (JsonKV *)ul_malloc(sizeof(JsonKV));
|
||
kv->key = key;
|
||
kv->value = val;
|
||
kv->next = NULL;
|
||
if (!tail) n->object = kv;
|
||
else tail->next = kv;
|
||
tail = kv;
|
||
skip_ws(p);
|
||
if (**p == ',') (*p)++;
|
||
else break;
|
||
}
|
||
skip_ws(p);
|
||
if (**p == '}') (*p)++;
|
||
return n;
|
||
}
|
||
if (**p == '[') {
|
||
(*p)++;
|
||
JsonNode *n = json_make_node(JT_ARRAY);
|
||
int cap = 16;
|
||
n->array.items = (JsonNode **)ul_malloc(sizeof(JsonNode *) * cap);
|
||
n->array.count = 0;
|
||
skip_ws(p);
|
||
if (**p == ']') { (*p)++; return n; }
|
||
while (1) {
|
||
if (n->array.count >= cap) {
|
||
cap *= 2;
|
||
n->array.items = (JsonNode **)ul_realloc(n->array.items, sizeof(JsonNode *) * cap);
|
||
}
|
||
n->array.items[n->array.count++] = json_parse(p);
|
||
skip_ws(p);
|
||
if (**p == ',') (*p)++;
|
||
else break;
|
||
}
|
||
skip_ws(p);
|
||
if (**p == ']') (*p)++;
|
||
return n;
|
||
}
|
||
if (strncmp(*p, "true", 4) == 0) {
|
||
*p += 4;
|
||
JsonNode *n = json_make_node(JT_BOOL);
|
||
n->bval = true;
|
||
return n;
|
||
}
|
||
if (strncmp(*p, "false", 5) == 0) {
|
||
*p += 5;
|
||
JsonNode *n = json_make_node(JT_BOOL);
|
||
n->bval = false;
|
||
return n;
|
||
}
|
||
if (strncmp(*p, "null", 4) == 0) {
|
||
*p += 4;
|
||
return json_make_node(JT_NULL);
|
||
}
|
||
/* Number */
|
||
{
|
||
char *end;
|
||
double d = strtod(*p, &end);
|
||
if (end != *p) {
|
||
/* Check if it's actually an integer */
|
||
bool is_int = true;
|
||
for (const char *c = *p; c < end; c++) {
|
||
if (*c == '.' || *c == 'e' || *c == 'E') { is_int = false; break; }
|
||
}
|
||
*p = end;
|
||
if (is_int && d >= -140737488355328LL && d <= 140737488355327LL) {
|
||
JsonNode *n = json_make_node(JT_INT);
|
||
n->ival = (int64_t)d;
|
||
return n;
|
||
}
|
||
JsonNode *n = json_make_node(JT_FLOAT);
|
||
n->fval = d;
|
||
return n;
|
||
}
|
||
}
|
||
/* Skip unknown */
|
||
(*p)++;
|
||
return json_make_node(JT_NULL);
|
||
}
|
||
|
||
static JsonNode *json_obj_get(JsonNode *obj, const char *key) {
|
||
if (!obj || obj->type != JT_OBJECT) return NULL;
|
||
for (JsonKV *kv = obj->object; kv; kv = kv->next) {
|
||
if (kv->key && strcmp(kv->key, key) == 0) return kv->value;
|
||
}
|
||
return NULL;
|
||
}
|
||
|
||
static const char *json_str(JsonNode *n) {
|
||
if (!n || n->type != JT_STRING) return NULL;
|
||
return n->sval;
|
||
}
|
||
|
||
static int64_t json_int(JsonNode *n) {
|
||
if (!n) return 0;
|
||
if (n->type == JT_INT) return n->ival;
|
||
if (n->type == JT_FLOAT) return (int64_t)n->fval;
|
||
return 0;
|
||
}
|
||
|
||
static void json_free(JsonNode *n) {
|
||
if (!n) return;
|
||
switch (n->type) {
|
||
case JT_STRING: ul_free(n->sval); break;
|
||
case JT_ARRAY:
|
||
for (int i = 0; i < n->array.count; i++) json_free(n->array.items[i]);
|
||
ul_free(n->array.items);
|
||
break;
|
||
case JT_OBJECT: {
|
||
JsonKV *kv = n->object;
|
||
while (kv) {
|
||
JsonKV *next = kv->next;
|
||
ul_free(kv->key);
|
||
json_free(kv->value);
|
||
ul_free(kv);
|
||
kv = next;
|
||
}
|
||
break;
|
||
}
|
||
default: break;
|
||
}
|
||
ul_free(n);
|
||
}
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* Deserialize a JSON value node into a Lisp Value
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
static Value json_to_value(JsonNode *n, Env *base_env) {
|
||
if (!n || n->type == JT_NULL) return VAL_NIL;
|
||
if (n->type == JT_INT) return VAL_INT(n->ival);
|
||
if (n->type == JT_FLOAT) return make_double(n->fval);
|
||
|
||
if (n->type != JT_OBJECT) return VAL_NIL;
|
||
|
||
const char *t = json_str(json_obj_get(n, "t"));
|
||
if (!t) return VAL_NIL;
|
||
|
||
if (strcmp(t, "nil") == 0) return VAL_NIL;
|
||
if (strcmp(t, "void") == 0) return VAL_VOID;
|
||
if (strcmp(t, "eof") == 0) return VAL_EOF;
|
||
if (strcmp(t, "bool") == 0) {
|
||
JsonNode *v = json_obj_get(n, "v");
|
||
return (v && v->type == JT_BOOL && v->bval) ? VAL_TRUE : VAL_FALSE;
|
||
}
|
||
if (strcmp(t, "float") == 0) {
|
||
JsonNode *v = json_obj_get(n, "v");
|
||
if (v && v->type == JT_STRING) {
|
||
if (strcmp(v->sval, "+inf") == 0) return make_double(INFINITY);
|
||
if (strcmp(v->sval, "-inf") == 0) return make_double(-INFINITY);
|
||
if (strcmp(v->sval, "nan") == 0) return make_double(NAN);
|
||
}
|
||
if (v && v->type == JT_FLOAT) return make_double(v->fval);
|
||
if (v && v->type == JT_INT) return make_double((double)v->ival);
|
||
return make_double(0.0);
|
||
}
|
||
if (strcmp(t, "frac") == 0) {
|
||
int64_t num = json_int(json_obj_get(n, "n"));
|
||
int64_t den = json_int(json_obj_get(n, "d"));
|
||
return rational_normalize(num, den);
|
||
}
|
||
if (strcmp(t, "sym") == 0) {
|
||
const char *v = json_str(json_obj_get(n, "v"));
|
||
return v ? intern(v) : VAL_NIL;
|
||
}
|
||
if (strcmp(t, "str") == 0) {
|
||
const char *v = json_str(json_obj_get(n, "v"));
|
||
return v ? make_string_from_cstr(v) : make_string_from_cstr("");
|
||
}
|
||
if (strcmp(t, "mstr") == 0) {
|
||
const char *v = json_str(json_obj_get(n, "v"));
|
||
return v ? make_string(v, strlen(v), true) : make_string("", 0, true);
|
||
}
|
||
if (strcmp(t, "char") == 0) {
|
||
return VAL_CHAR((int)json_int(json_obj_get(n, "v")));
|
||
}
|
||
if (strcmp(t, "pair") == 0) {
|
||
Value car = json_to_value(json_obj_get(n, "car"), base_env);
|
||
Value cdr = json_to_value(json_obj_get(n, "cdr"), base_env);
|
||
return cons(car, cdr);
|
||
}
|
||
if (strcmp(t, "vec") == 0) {
|
||
JsonNode *arr = json_obj_get(n, "v");
|
||
if (!arr || arr->type != JT_ARRAY) return make_vector(0, VAL_NIL);
|
||
Value vec = make_vector(arr->array.count, VAL_NIL);
|
||
for (int i = 0; i < arr->array.count; i++) {
|
||
AS_VECTOR(vec)->data[i] = json_to_value(arr->array.items[i], base_env);
|
||
}
|
||
return vec;
|
||
}
|
||
if (strcmp(t, "hash") == 0) {
|
||
Value ht = make_hashtable();
|
||
JsonNode *entries = json_obj_get(n, "entries");
|
||
if (entries && entries->type == JT_ARRAY) {
|
||
for (int i = 0; i < entries->array.count; i++) {
|
||
JsonNode *pair = entries->array.items[i];
|
||
if (pair && pair->type == JT_ARRAY && pair->array.count >= 2) {
|
||
Value k = json_to_value(pair->array.items[0], base_env);
|
||
Value v = json_to_value(pair->array.items[1], base_env);
|
||
ht_set(AS_HASHTABLE(ht), k, v);
|
||
}
|
||
}
|
||
}
|
||
return ht;
|
||
}
|
||
if (strcmp(t, "proc") == 0) {
|
||
/* Reconstruct a Proc from serialized body source */
|
||
const char *name = json_str(json_obj_get(n, "name"));
|
||
JsonNode *params_arr = json_obj_get(n, "params");
|
||
const char *rest_str = json_str(json_obj_get(n, "rest"));
|
||
JsonNode *body_arr = json_obj_get(n, "body");
|
||
|
||
int nparams = (params_arr && params_arr->type == JT_ARRAY) ? params_arr->array.count : 0;
|
||
Value *params = (Value *)ul_malloc_values(sizeof(Value) * (nparams > 0 ? nparams : 1));
|
||
for (int i = 0; i < nparams; i++) {
|
||
params[i] = intern(json_str(params_arr->array.items[i]));
|
||
}
|
||
Value rest = rest_str ? intern(rest_str) : VAL_NIL;
|
||
|
||
int nbody = (body_arr && body_arr->type == JT_ARRAY) ? body_arr->array.count : 0;
|
||
ExprList body;
|
||
body.count = nbody;
|
||
body.exprs = (Value *)ul_malloc_values(sizeof(Value) * (nbody > 0 ? nbody : 1));
|
||
for (int i = 0; i < nbody; i++) {
|
||
const char *src = json_str(body_arr->array.items[i]);
|
||
if (src) {
|
||
int count;
|
||
Value *parsed = read_all(src, &count, false);
|
||
body.exprs[i] = count > 0 ? parsed[0] : VAL_VOID;
|
||
ul_free(parsed);
|
||
} else {
|
||
body.exprs[i] = VAL_VOID;
|
||
}
|
||
}
|
||
|
||
Proc *p = make_proc(params, nparams, rest, body, base_env, name);
|
||
ul_free(params);
|
||
return VAL_PTR(p);
|
||
}
|
||
if (strcmp(t, "builtin") == 0 || strcmp(t, "opaque") == 0 ||
|
||
strcmp(t, "cproc") == 0 || strcmp(t, "cont_marker") == 0) {
|
||
/* These can't be fully reconstructed — return void */
|
||
return VAL_VOID;
|
||
}
|
||
|
||
return VAL_NIL;
|
||
}
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* portal_resume — load machine state from JSON file
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
bool portal_resume(const char *path, Env *base_env, Env **out_env, FullCont **out_cont) {
|
||
FILE *fp = fopen(path, "r");
|
||
if (!fp) return false;
|
||
|
||
fseek(fp, 0, SEEK_END);
|
||
long sz = ftell(fp);
|
||
fseek(fp, 0, SEEK_SET);
|
||
|
||
char *src = (char *)ul_malloc(sz + 1);
|
||
size_t nread = fread(src, 1, sz, fp);
|
||
src[nread] = '\0';
|
||
fclose(fp);
|
||
|
||
const char *p = src;
|
||
JsonNode *root = json_parse(&p);
|
||
ul_free(src);
|
||
|
||
if (!root || root->type != JT_OBJECT) {
|
||
json_free(root);
|
||
return false;
|
||
}
|
||
|
||
/* Check format */
|
||
const char *fmt = json_str(json_obj_get(root, "format"));
|
||
if (!fmt || strcmp(fmt, "lumbda-portal-v1") != 0) {
|
||
json_free(root);
|
||
return false;
|
||
}
|
||
|
||
/* Restore RNG state if present (absent = pre-RNG portal file, skip) */
|
||
JsonNode *rng_node = json_obj_get(root, "rng");
|
||
if (rng_node && rng_node->type == JT_OBJECT) {
|
||
JsonNode *state_arr = json_obj_get(rng_node, "state");
|
||
if (state_arr && state_arr->type == JT_ARRAY && state_arr->array.count == 8) {
|
||
uint32_t halves[8];
|
||
for (int i = 0; i < 8; i++) {
|
||
halves[i] = (uint32_t)json_int(state_arr->array.items[i]);
|
||
}
|
||
rng_set_halves(halves);
|
||
}
|
||
}
|
||
|
||
/* Merge environment bindings into base_env */
|
||
JsonNode *env_node = json_obj_get(root, "env");
|
||
if (env_node && env_node->type == JT_OBJECT) {
|
||
for (JsonKV *kv = env_node->object; kv; kv = kv->next) {
|
||
if (!kv->key) continue;
|
||
Value sym = intern(kv->key);
|
||
Value val = json_to_value(kv->value, base_env);
|
||
/* Only set if non-void (skip builtins that couldn't be serialized) */
|
||
if (!IS_VOID(val)) {
|
||
env_define(base_env, sym, val);
|
||
}
|
||
}
|
||
}
|
||
|
||
*out_env = base_env;
|
||
|
||
/* Continuation — for now, we mark it present but don't fully
|
||
* reconstruct bytecode (that requires code serialization).
|
||
* The continuation is stored so callers know one was saved. */
|
||
JsonNode *cont_node = json_obj_get(root, "continuation");
|
||
if (cont_node && cont_node->type == JT_OBJECT) {
|
||
/* A continuation was saved. We can't fully restore it without
|
||
* reconstructing the bytecode instructions, but we signal its presence. */
|
||
*out_cont = (FullCont *)ul_malloc(sizeof(FullCont));
|
||
(*out_cont)->hdr.type = OBJ_CONTINUATION;
|
||
(*out_cont)->nframes = 0;
|
||
(*out_cont)->frames = NULL;
|
||
(*out_cont)->stack = NULL;
|
||
(*out_cont)->stack_len = 0;
|
||
(*out_cont)->ip = (int)json_int(json_obj_get(cont_node, "ip"));
|
||
(*out_cont)->instrs = NULL;
|
||
(*out_cont)->n_instrs = 0;
|
||
(*out_cont)->env = base_env;
|
||
(*out_cont)->vm_id = NULL;
|
||
} else {
|
||
*out_cont = NULL;
|
||
}
|
||
|
||
json_free(root);
|
||
return true;
|
||
}
|
||
|
||
/* ═══════════════════════════════════════════════════════════════════════════
|
||
* portal-checkpoint! builtin — signals VM to save at next safe point
|
||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||
|
||
static Value builtin_portal_checkpoint(Value *args, int nargs, Env *env) {
|
||
(void)env;
|
||
if (nargs < 1 || !IS_STRING(args[0]))
|
||
lisp_error("portal-checkpoint!: expected string path");
|
||
g_portal_checkpoint_path = ul_strdup(AS_STRING(args[0])->data);
|
||
return VAL_VOID;
|
||
}
|
||
|
||
static Value builtin_random_seed_bang(Value *args, int nargs, Env *env) {
|
||
(void)env;
|
||
if (nargs != 1) lisp_error("random-seed!: expected 1 arg");
|
||
rng_seed((uint64_t)as_number_int(args[0]));
|
||
return VAL_VOID;
|
||
}
|
||
|
||
static Value builtin_random(Value *args, int nargs, Env *env) {
|
||
(void)args; (void)env;
|
||
if (nargs != 0) lisp_error("random: expected 0 args");
|
||
return make_double((double)(rng_next() >> 11) / (double)(1ULL << 53));
|
||
}
|
||
|
||
static Value builtin_random_int(Value *args, int nargs, Env *env) {
|
||
(void)env;
|
||
if (nargs != 1) lisp_error("random-int: expected 1 arg");
|
||
int64_t n = as_number_int(args[0]);
|
||
if (n <= 0) lisp_error("random-int: n must be positive, got %lld", (long long)n);
|
||
return VAL_INT((int64_t)(rng_next() % (uint64_t)n));
|
||
}
|
||
|
||
static Value builtin_random_state(Value *args, int nargs, Env *env) {
|
||
(void)args; (void)env;
|
||
if (nargs != 0) lisp_error("random-state: expected 0 args");
|
||
uint32_t halves[8];
|
||
rng_get_halves(halves);
|
||
Value list = VAL_NIL;
|
||
for (int i = 7; i >= 0; i--) {
|
||
list = cons(VAL_INT((int64_t)halves[i]), list);
|
||
}
|
||
return list;
|
||
}
|
||
|
||
static Value builtin_random_state_bang(Value *args, int nargs, Env *env) {
|
||
(void)env;
|
||
if (nargs != 1) lisp_error("random-state!: expected 1 arg (list of 8 ints)");
|
||
uint32_t halves[8];
|
||
Value lst = args[0];
|
||
for (int i = 0; i < 8; i++) {
|
||
if (!IS_PAIR(lst)) lisp_error("random-state!: list too short");
|
||
halves[i] = (uint32_t)as_number_int(CAR(lst));
|
||
lst = CDR(lst);
|
||
}
|
||
rng_set_halves(halves);
|
||
return VAL_VOID;
|
||
}
|
||
|
||
/* Opt-in kernel entropy seed. See docs/tickets/0002-os-entropy-seed.md. */
|
||
static Value builtin_random_seed_from_os(Value *args, int nargs, Env *env) {
|
||
(void)args; (void)env;
|
||
if (nargs != 0) lisp_error("random-seed-from-os!: expected 0 args");
|
||
int fd = open("/dev/urandom", O_RDONLY);
|
||
if (fd < 0) lisp_error("random-seed-from-os!: cannot open /dev/urandom");
|
||
uint64_t k = 0;
|
||
ssize_t n = read(fd, &k, sizeof k);
|
||
close(fd);
|
||
if (n != (ssize_t)sizeof k)
|
||
lisp_error("random-seed-from-os!: short read from /dev/urandom");
|
||
rng_seed(k);
|
||
return VAL_VOID;
|
||
}
|
||
|
||
void register_portal_builtins(Env *env) {
|
||
env_define(env, intern("portal-checkpoint!"), VAL_BUILTIN(builtin_portal_checkpoint));
|
||
env_define(env, intern("portal-save!"), VAL_BUILTIN(builtin_portal_checkpoint));
|
||
env_define(env, intern("random-seed!"), VAL_BUILTIN(builtin_random_seed_bang));
|
||
env_define(env, intern("random-seed-from-os!"), VAL_BUILTIN(builtin_random_seed_from_os));
|
||
env_define(env, intern("random"), VAL_BUILTIN(builtin_random));
|
||
env_define(env, intern("random-int"), VAL_BUILTIN(builtin_random_int));
|
||
env_define(env, intern("random-state"), VAL_BUILTIN(builtin_random_state));
|
||
env_define(env, intern("random-state!"), VAL_BUILTIN(builtin_random_state_bang));
|
||
/* Default seed = 0 so (random) without (random-seed!) is deterministic
|
||
* and non-zero. All three impls agree on this startup state. */
|
||
rng_seed(0);
|
||
}
|