russell@unturf.com
610c93e8c8
Full continuations: FullCont captures frames/stack/env with deep copy. VM trampoline via setjmp/longjmp. Multi-shot safe via deep_copy_env. Portal (new c/portal.c): serialize env + continuation to JSON, resume on another machine. portal-checkpoint! triggers mid-VM save. 83/83 C unit tests + 181/181 functional tests pass.
685 lines
25 KiB
C
685 lines
25 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 "uncommonlisp.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;
|
|
|
|
/* ═══════════════════════════════════════════════════════════════════════════
|
|
* 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\":\"uncommonlisp-portal-v1\",\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(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(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, "uncommonlisp-portal-v1") != 0) {
|
|
json_free(root);
|
|
return false;
|
|
}
|
|
|
|
/* 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;
|
|
}
|
|
|
|
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));
|
|
}
|