engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

C: add deep_copy_env, VM frame stack for continuations

Browse source 
asm: fix builtin dispatch, improve apply_proc_raw

C changes: deep_copy_env() for multi-shot continuations,
explicit frame stack in VM for compiled code call/cc support.

asm changes: improved builtin implementations, fixed dispatch paths.

All tests pass: asm 75, C 76+114 functional.
This commit is contained in:
russell@unturf.com 2026-04-15 19:57:17 -04:00
parent b038266173
commit 30d7279be2
5 changed files with 219 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

75
asm/uncommonlisp.s
View file

@ -2164,7 +2164,8 @@ eval_list:
movq %rbx, %rax
shrq $3, %rax # index
# Jump table
# Jump table — shared entry point for apply_proc_raw dispatch
.app_builtin_dispatch:
cmpq $BI_ADD, %rax
je bi_add
cmpq $BI_SUB, %rax
@ -2762,28 +2763,27 @@ apply_proc_raw:
cmpq $VAL_NIL, %rsi
je .apr_eval_body
# Extract param name and rest params
movq %rcx, %rax
andq $-8, %rax
movq (%rax), %rdi # param name (symbol)
movq 8(%rax), %rcx # rest params
# Extract arg value and rest args
movq %rsi, %rax
andq $-8, %rax
movq (%rax), %rsi # arg value
pushq %rcx
pushq %rsi
pushq %rdx
movq %rsi, %rsi # value
movq 8(%rax), %r8 # rest args (cdr)
movq (%rax), %rsi # arg value (car)
pushq %r8 # save rest args
pushq %rcx # save rest params
pushq %rdx # save body
movq %rbp, %rdx # env
call env_define
movq %rax, %rbp
popq %rdx
popq %rsi
popq %rcx
# Advance arg list
# Need to re-fetch rest of args — we clobbered %rsi
# Actually we saved it wrong. Let me redo.
# This binding loop is getting complex. Use simpler approach.
popq %rdx # restore body
popq %rcx # restore rest params
popq %rsi # restore rest args
jmp .apr_bind
.apr_eval_body:
@ -2823,33 +2823,11 @@ apply_proc_raw:
ret
.apr_bi_dispatch:
# Dispatch builtin by index — reuse main dispatch table
# Dispatch builtin by index — jump to main dispatch table
# RET_VAL pops %r12,%rbp,%rbx — matching our pushes in apply_proc_raw
movq %rbx, %rax
shrq $3, %rax
# We need to jump into the builtin implementations
# But they use RET_VAL which pops %r12,%rbp,%rbx — which we pushed
# So it should work if we fall through to the existing dispatch
cmpq $BI_ADD, %rax
je bi_add
cmpq $BI_SUB, %rax
je bi_sub
cmpq $BI_MUL, %rax
je bi_mul
cmpq $BI_EQ, %rax
je bi_eq
cmpq $BI_LT, %rax
je bi_lt
cmpq $BI_GT, %rax
je bi_gt
cmpq $BI_CONS, %rax
je bi_cons
# ... for full dispatch, jump to the main dispatch
# Shortcut: just compute the address and jump
movq $VAL_VOID, %rax
popq %rbp
popq %r12
popq %rbx
ret
jmp .app_builtin_dispatch
# ── New builtins ─────────────────────────────────────────────
@ -2922,17 +2900,14 @@ bi_append:
jmp .bapp_copy
.bapp_link:
# set last cdr to lst2
popq %rbx
popq %rsi
movq %rcx, %rax # head
pushq %rax
movq %rbx, %rax # find actual tail - but we already have it
popq %rax
# We need to find the last pair of the copy and set its cdr
# Actually %rbx was the last pair before we popped it. Redo.
# Simpler: just use the Scheme approach — recurse
# For now: fall through to simple version
movq %rcx, %rax
# %rbx = last pair (tagged), %rcx = head (tagged)
# stack: [rbx_saved, rsi=lst2]
movq %rbx, %rax
andq $-8, %rax
popq %rbx # restore saved rbx
popq %rsi # lst2
movq %rsi, 8(%rax) # set last pair's cdr to lst2
movq %rcx, %rax # return head
RET_VAL
.bapp_done_rsi:
movq %rsi, %rax
@ -3457,8 +3432,10 @@ bi_integerp:
bi_expt:
GETARG %rax
sarq $3, %rax
pushq %rax # save untagged base
GETARG %rcx
sarq $3, %rcx
popq %rax # restore untagged base
# base^exp by repeated multiplication
movq $1, %rdx
.bexpt_loop:

22
c/eval.c
View file

@ -285,6 +285,17 @@ Value call_proc(Value proc, Value *args, int nargs, Env *env) {
Env *c = env_child(cp->env, cp->params, cp->nparams, cp->rest, args, nargs);
return vm_exec(cp->code, c);
}
if (IS_CONTINUATION(proc)) {
/* Invoke the continuation via the VM trampoline */
FullCont *cont = AS_CONTINUATION(proc);
Value val = (nargs > 0) ? args[0] : VAL_VOID;
if (!g_cont_trampoline || !g_cont_trampoline->active) {
lisp_error("continuation invoked outside VM execution");
}
g_cont_invoked = cont;
g_cont_invoked_val = val;
longjmp(g_cont_trampoline->jmp, 1);
}
lisp_error("not callable: %s", show(proc, false));
return VAL_NIL;
}
@ -1593,6 +1604,17 @@ Value leval(Value expr, Env *env) {
return result;
}
if (IS_CONTINUATION(proc)) {
Value val = (nargs > 0) ? args[0] : VAL_VOID;
ul_free(args);
if (!g_cont_trampoline || !g_cont_trampoline->active) {
lisp_error("continuation invoked outside VM execution");
}
g_cont_invoked = AS_CONTINUATION(proc);
g_cont_invoked_val = val;
longjmp(g_cont_trampoline->jmp, 1);
}
char *s = show(proc, false);
lisp_error("not callable: %s", s);

41
c/types.c
View file

@ -528,6 +528,47 @@ Env *env_child(Env *parent, Value *params, int nparams, Value rest_param,
return c;
}
/* ═══════════════════════════════════════════════════════════════════════════
* Full continuation support
* ═══════════════════════════════════════════════════════════════════════════ */
__thread ContTrampoline *g_cont_trampoline = NULL;
__thread FullCont *g_cont_invoked = NULL;
__thread Value g_cont_invoked_val = 0;
VMFrame *deep_copy_frames(VMFrame *frames, int nframes) {
if (nframes == 0) return NULL;
VMFrame *copy = (VMFrame *)ul_malloc(sizeof(VMFrame) * nframes);
for (int i = 0; i < nframes; i++) {
copy[i].instrs = frames[i].instrs;
copy[i].ip = frames[i].ip;
copy[i].n_instrs = frames[i].n_instrs;
copy[i].env = deep_copy_env(frames[i].env);
copy[i].stack_len = frames[i].stack_len;
copy[i].stack_cap = frames[i].stack_cap;
copy[i].stack = (Value *)ul_malloc(sizeof(Value) * copy[i].stack_cap);
memcpy(copy[i].stack, frames[i].stack, sizeof(Value) * frames[i].stack_len);
}
return copy;
}
FullCont *make_full_cont(VMFrame *frames, int nframes, Value *stack, int stack_len,
int ip, Instruction *instrs, int n_instrs, Env *env, void *vm_id) {
FullCont *c = (FullCont *)ul_malloc(sizeof(FullCont));
c->hdr.type = OBJ_CONTINUATION;
c->frames = deep_copy_frames(frames, nframes);
c->nframes = nframes;
c->stack = (Value *)ul_malloc(sizeof(Value) * (stack_len > 0 ? stack_len : 4));
memcpy(c->stack, stack, sizeof(Value) * stack_len);
c->stack_len = stack_len;
c->ip = ip;
c->instrs = instrs;
c->n_instrs = n_instrs;
c->env = deep_copy_env(env);
c->vm_id = vm_id;
return c;
}
/* Deep copy env chain (for multi-shot continuations) */
Env *deep_copy_env(Env *env) {
if (!env) return NULL;

27
c/uncommonlisp.h
View file

@ -313,6 +313,7 @@ void env_define(Env *e, Value sym, Value val);
Value env_lookup(Env *e, Value sym);
bool env_set(Env *e, Value sym, Value val);
Env *env_child(Env *parent, Value *params, int nparams, Value rest_param, Value *args, int nargs);
Env *deep_copy_env(Env *env);
/* ── Procedure ───────────────────────────────────────────────────────────── */
@ -495,6 +496,24 @@ typedef struct FullCont {
#define IS_CONTINUATION(v) (IS_PTR(v) && obj_type(v) == OBJ_CONTINUATION)
#define AS_CONTINUATION(v) ((FullCont *)GET_PTR(v))
/* Continuation invocation signaling — used by full continuations in the VM.
* When a FullCont is invoked (as a callable), it sets these thread-locals
* and longjmps to the VM's trampoline. Similar to Python's _ContInvoked. */
typedef struct {
jmp_buf jmp;
bool active;
} ContTrampoline;
extern __thread ContTrampoline *g_cont_trampoline;
extern __thread FullCont *g_cont_invoked;
extern __thread Value g_cont_invoked_val;
FullCont *make_full_cont(VMFrame *frames, int nframes, Value *stack, int stack_len,
int ip, Instruction *instrs, int n_instrs, Env *env, void *vm_id);
/* Deep-copy a VMFrame array for multi-shot continuations */
VMFrame *deep_copy_frames(VMFrame *frames, int nframes);
/* ── Syntax Transformer ──────────────────────────────────────────────────── */
typedef struct SyntaxRule {
@ -645,6 +664,14 @@ CodeObj *bc_lambda(Value *body, int nbody, Value *params, int nparams,
Value rest, Env *env, const char *name,
const char *self_name, Value *self_params, int self_nparams);
/* ═══════════════════════════════════════════════════════════════════════════
* Function declarations — portal.c
* ═══════════════════════════════════════════════════════════════════════════ */
void portal_save(Env *env, const char *path, FullCont *continuation);
bool portal_resume(const char *path, Env *base_env, Env **out_env, FullCont **out_cont);
void register_portal_builtins(Env *env);
/* ═══════════════════════════════════════════════════════════════════════════
* Commonly used interned symbols — cached for fast comparison
* ═══════════════════════════════════════════════════════════════════════════ */

108
c/vm.c
View file

@ -651,6 +651,28 @@ CompiledProc *compile_proc(Proc *p, Env *env) {
* VM execution
* ═══════════════════════════════════════════════════════════════════════════ */
/* Invoke a FullCont — signals the VM trampoline via longjmp */
static Value invoke_continuation(FullCont *cont, Value val) {
if (!g_cont_trampoline || !g_cont_trampoline->active) {
lisp_error("continuation invoked outside VM execution");
}
g_cont_invoked = cont;
g_cont_invoked_val = val;
longjmp(g_cont_trampoline->jmp, 1);
return VAL_VOID; /* unreachable */
}
/* Builtin wrapper for calling a continuation as a function */
static Value cont_call_builtin(Value *args, int nargs, Env *env) {
(void)env;
/* The continuation value is stored as the first arg; we passed it differently.
* Actually, we need to find the continuation. The trick: we use the eval.c
* call path which checks IS_CONTINUATION. So this path is only for when
* continuations end up in the generic builtin slot (which won't happen). */
lisp_error("continuation called through wrong path");
return VAL_VOID;
}
Value vm_exec(CodeObj *code, Env *env) {
CodeObj *cur_code = code;
Instruction *instrs = code->instrs;
@ -665,6 +687,45 @@ Value vm_exec(CodeObj *code, Env *env) {
int frame_count = 0;
VMFrame *frames = (VMFrame *)ul_malloc(sizeof(VMFrame) * frame_cap);
/* Unique ID for this VM invocation (used to match continuations) */
int vm_id_storage;
void *vm_id = &vm_id_storage;
/* Set up trampoline for continuation invocation */
ContTrampoline trampoline;
trampoline.active = true;
ContTrampoline *prev_trampoline = g_cont_trampoline;
g_cont_trampoline = &trampoline;
if (setjmp(trampoline.jmp) != 0) {
/* A continuation was invoked — resume it */
FullCont *c = g_cont_invoked;
Value val = g_cont_invoked_val;
g_cont_invoked = NULL;
/* Deep-copy the continuation state for multi-shot safety */
frame_count = c->nframes;
if (frame_count > frame_cap) {
frame_cap = frame_count * 2;
}
ul_free(frames);
frames = deep_copy_frames(c->frames, c->nframes);
frame_cap = frame_count > 0 ? frame_count * 2 : 32;
ul_free(stack.data);
stack.len = c->stack_len;
stack.cap = c->stack_len + 16;
stack.data = (Value *)ul_malloc(sizeof(Value) * stack.cap);
memcpy(stack.data, c->stack, sizeof(Value) * c->stack_len);
vs_push(&stack, val);
ip = c->ip;
instrs = c->instrs;
n_instrs = c->n_instrs;
env = deep_copy_env(c->env);
/* Fall through to main loop */
}
while (ip < n_instrs) {
Instruction *instr = &instrs[ip++];
Opcode op = instr->op;
@ -714,6 +775,11 @@ Value vm_exec(CodeObj *code, Env *env) {
stack.len -= nargs;
Value func = vs_pop(&stack);
if (IS_CONTINUATION(func)) {
Value val = nargs > 0 ? args_arr[0] : VAL_VOID;
invoke_continuation(AS_CONTINUATION(func), val);
break; /* unreachable */
}
if (IS_COMPILED_PROC(func)) {
CompiledProc *cp = AS_COMPILED_PROC(func);
/* Push frame */
@ -747,6 +813,11 @@ Value vm_exec(CodeObj *code, Env *env) {
stack.len -= nargs;
Value func = vs_pop(&stack);
if (IS_CONTINUATION(func)) {
Value val = nargs > 0 ? args_arr[0] : VAL_VOID;
invoke_continuation(AS_CONTINUATION(func), val);
break; /* unreachable */
}
if (IS_COMPILED_PROC(func)) {
CompiledProc *cp = AS_COMPILED_PROC(func);
env = env_child(cp->env, cp->params, cp->nparams, cp->rest, args_arr, nargs);
@ -757,7 +828,7 @@ Value vm_exec(CodeObj *code, Env *env) {
}
if (IS_PROC(func) || IS_BUILTIN(func)) {
Value ret = call_proc(func, args_arr, nargs, env);
if (frame_count == 0) { ul_free(frames); ul_free(stack.data); return ret; }
if (frame_count == 0) { ul_free(frames); ul_free(stack.data); g_cont_trampoline = prev_trampoline; return ret; }
VMFrame *f = &frames[--frame_count];
instrs = f->instrs; ip = f->ip; n_instrs = f->n_instrs;
env = f->env;
@ -771,7 +842,7 @@ Value vm_exec(CodeObj *code, Env *env) {
}
case OP_RETURN: {
Value ret = stack.len > 0 ? vs_pop(&stack) : VAL_VOID;
if (frame_count == 0) { ul_free(frames); ul_free(stack.data); return ret; }
if (frame_count == 0) { ul_free(frames); ul_free(stack.data); g_cont_trampoline = prev_trampoline; return ret; }
VMFrame *f = &frames[--frame_count];
instrs = f->instrs; ip = f->ip; n_instrs = f->n_instrs;
env = f->env;
@ -812,11 +883,37 @@ Value vm_exec(CodeObj *code, Env *env) {
vs_push(&stack, leval(arg, env));
break;
case OP_CALL_CC:
/* Simplified call/cc — just call with a dummy kont */
/* Full call/cc — capture current VM state as a FullCont */
{
Value proc = vs_pop(&stack);
Value kont_args[1] = {VAL_VOID}; /* Simplified */
vs_push(&stack, call_proc(proc, kont_args, 1, env));
FullCont *cont = make_full_cont(frames, frame_count,
stack.data, stack.len, ip, instrs, n_instrs, env, vm_id);
Value cont_val = VAL_PTR(cont);
if (IS_COMPILED_PROC(proc)) {
/* Push frame and enter compiled proc with continuation as arg */
CompiledProc *cp = AS_COMPILED_PROC(proc);
if (frame_count >= frame_cap) {
frame_cap *= 2;
frames = (VMFrame *)ul_realloc(frames, sizeof(VMFrame) * frame_cap);
}
VMFrame *f = &frames[frame_count++];
f->instrs = instrs; f->ip = ip; f->n_instrs = n_instrs;
f->env = env;
f->stack = stack.data; f->stack_len = stack.len; f->stack_cap = stack.cap;
Value kargs[1] = {cont_val};
env = env_child(cp->env, cp->params, cp->nparams, cp->rest, kargs, 1);
cur_code = cp->code;
instrs = cp->code->instrs; ip = 0; n_instrs = cp->code->count;
vs_init(&stack, 64);
continue;
}
if (IS_PROC(proc) || IS_BUILTIN(proc)) {
Value kargs[1] = {cont_val};
vs_push(&stack, call_proc(proc, kargs, 1, env));
} else {
lisp_error("call/cc: not callable");
}
}
break;
@ -867,5 +964,6 @@ Value vm_exec(CodeObj *code, Env *env) {
Value ret = stack.len > 0 ? stack.data[stack.len - 1] : VAL_VOID;
ul_free(stack.data);
ul_free(frames);
g_cont_trampoline = prev_trampoline;
return ret;
}