c: precise GC tracing for NaN-boxed Values
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
This commit is contained in:
parent
f398902cc4
commit
b841b30bc4
12 changed files with 300 additions and 74 deletions
|
|
@ -15,9 +15,12 @@ USE_GC ?= $(shell test -f /usr/include/gc.h && echo 1 || echo 0)
|
|||
ifeq ($(USE_GC),1)
|
||||
CFLAGS += -DUSE_BOEHM_GC
|
||||
LDFLAGS += -lgc
|
||||
GC_SRCS = gc.c
|
||||
else
|
||||
GC_SRCS =
|
||||
endif
|
||||
|
||||
SRCS = types.c bignum.c reader.c printer.c eval.c builtins.c vm.c jit.c portal.c
|
||||
SRCS = types.c bignum.c reader.c printer.c eval.c builtins.c vm.c jit.c portal.c $(GC_SRCS)
|
||||
OBJS = $(SRCS:.c=.o)
|
||||
|
||||
.PHONY: all clean test bench
|
||||
|
|
|
|||
|
|
@ -171,6 +171,14 @@ static void run_benchmark(Benchmark *b, const char *mode) {
|
|||
}
|
||||
|
||||
int main(void) {
|
||||
int stack_anchor;
|
||||
#ifdef USE_BOEHM_GC
|
||||
GC_INIT();
|
||||
lumbda_gc_init();
|
||||
lumbda_gc_set_stack_base(&stack_anchor);
|
||||
#else
|
||||
(void)stack_anchor;
|
||||
#endif
|
||||
init_symbols();
|
||||
|
||||
/* Set up root error context for prelude loading */
|
||||
|
|
|
|||
16
c/builtins.c
16
c/builtins.c
|
|
@ -574,8 +574,8 @@ static Value bi_map(Value *a, int n, Env *e) {
|
|||
if (ni < min_len) min_len = ni;
|
||||
}
|
||||
|
||||
Value *results = (Value *)ul_malloc(sizeof(Value) * min_len);
|
||||
Value *call_args = (Value *)ul_malloc(sizeof(Value) * nlists);
|
||||
Value *results = (Value *)ul_malloc_values(sizeof(Value) * min_len);
|
||||
Value *call_args = (Value *)ul_malloc_values(sizeof(Value) * nlists);
|
||||
for (int j = 0; j < min_len; j++) {
|
||||
for (int i = 0; i < nlists; i++) call_args[i] = items_arr[i][j];
|
||||
results[j] = call_proc(proc, call_args, nlists, e);
|
||||
|
|
@ -599,7 +599,7 @@ static Value bi_for_each(Value *a, int n, Env *e) {
|
|||
ni = value_to_list(lists[i], &items_arr[i]);
|
||||
if (ni < min_len) min_len = ni;
|
||||
}
|
||||
Value *call_args = (Value *)ul_malloc(sizeof(Value) * nlists);
|
||||
Value *call_args = (Value *)ul_malloc_values(sizeof(Value) * nlists);
|
||||
for (int j = 0; j < min_len; j++) {
|
||||
for (int i = 0; i < nlists; i++) call_args[i] = items_arr[i][j];
|
||||
call_proc(proc, call_args, nlists, e);
|
||||
|
|
@ -613,7 +613,7 @@ static Value bi_filter(Value *a, int n, Env *e) {
|
|||
CHECK_ARITY("filter", 2);
|
||||
Value proc = a[0];
|
||||
Value *items; int ni = value_to_list(a[1], &items);
|
||||
Value *results = (Value *)ul_malloc(sizeof(Value) * ni);
|
||||
Value *results = (Value *)ul_malloc_values(sizeof(Value) * ni);
|
||||
int nr = 0;
|
||||
for (int i = 0; i < ni; i++) {
|
||||
Value v = call_proc(proc, &items[i], 1, e);
|
||||
|
|
@ -715,7 +715,7 @@ static Value bi_apply(Value *a, int n, Env *e) {
|
|||
Value last = a[n - 1];
|
||||
Value *lst; int nlst = value_to_list(last, &lst);
|
||||
int total = npre + nlst;
|
||||
Value *all = (Value *)ul_malloc(sizeof(Value) * total);
|
||||
Value *all = (Value *)ul_malloc_values(sizeof(Value) * total);
|
||||
for (int i = 0; i < npre; i++) all[i] = a[i + 1];
|
||||
memcpy(all + npre, lst, sizeof(Value) * nlst);
|
||||
Value r = call_proc(proc, all, total, e);
|
||||
|
|
@ -2237,17 +2237,17 @@ static Value bi_string_split(Value *a, int n, Env *e) {
|
|||
Value result = VAL_NIL;
|
||||
Value *items = NULL;
|
||||
int nitems = 0, cap = 16;
|
||||
items = (Value *)ul_malloc(sizeof(Value) * cap);
|
||||
items = (Value *)ul_malloc_values(sizeof(Value) * cap);
|
||||
|
||||
const char *p = str;
|
||||
while (*p) {
|
||||
const char *found = strstr(p, sep);
|
||||
if (!found) {
|
||||
if (nitems >= cap) { cap *= 2; items = (Value *)ul_realloc(items, sizeof(Value) * cap); }
|
||||
if (nitems >= cap) { cap *= 2; items = (Value *)ul_realloc_values(items, sizeof(Value) * cap); }
|
||||
items[nitems++] = make_string(p, strlen(p), false);
|
||||
break;
|
||||
}
|
||||
if (nitems >= cap) { cap *= 2; items = (Value *)ul_realloc(items, sizeof(Value) * cap); }
|
||||
if (nitems >= cap) { cap *= 2; items = (Value *)ul_realloc_values(items, sizeof(Value) * cap); }
|
||||
items[nitems++] = make_string(p, found - p, false);
|
||||
p = found + seplen;
|
||||
}
|
||||
|
|
|
|||
48
c/eval.c
48
c/eval.c
|
|
@ -41,7 +41,7 @@ int value_to_list(Value v, Value **out) {
|
|||
while (IS_PAIR(cur)) { n++; cur = CDR(cur); }
|
||||
if (!IS_NIL(cur)) lisp_error("not a list");
|
||||
|
||||
*out = (Value *)ul_malloc(sizeof(Value) * n);
|
||||
*out = (Value *)ul_malloc_values(sizeof(Value) * n);
|
||||
cur = v;
|
||||
for (int i = 0; i < n; i++) {
|
||||
(*out)[i] = CAR(cur);
|
||||
|
|
@ -80,7 +80,7 @@ Formals parse_formals(Value f) {
|
|||
bool has_rest = !IS_NIL(cur);
|
||||
|
||||
result.nparams = n;
|
||||
result.params = (Value *)ul_malloc(sizeof(Value) * n);
|
||||
result.params = (Value *)ul_malloc_values(sizeof(Value) * n);
|
||||
cur = f;
|
||||
for (int i = 0; i < n; i++) {
|
||||
if (!IS_SYM(CAR(cur)))
|
||||
|
|
@ -113,7 +113,7 @@ ExprList body_with_env(Value *forms, int count, Env *env) {
|
|||
|
||||
/* We may need to splice begin forms */
|
||||
int cap = count + 64;
|
||||
Value *expanded = (Value *)ul_malloc(sizeof(Value) * cap);
|
||||
Value *expanded = (Value *)ul_malloc_values(sizeof(Value) * cap);
|
||||
memcpy(expanded, forms, sizeof(Value) * count);
|
||||
int n = count;
|
||||
|
||||
|
|
@ -133,7 +133,7 @@ ExprList body_with_env(Value *forms, int count, Env *env) {
|
|||
Value *spliced; int ns = value_to_list(CDR(f), &spliced);
|
||||
if (n + ns - 1 >= cap) {
|
||||
cap = (n + ns) * 2;
|
||||
expanded = (Value *)ul_realloc(expanded, sizeof(Value) * cap);
|
||||
expanded = (Value *)ul_realloc_values(expanded, sizeof(Value) * cap);
|
||||
}
|
||||
memmove(expanded + i + ns, expanded + i + 1, sizeof(Value) * (n - i - 1));
|
||||
memcpy(expanded + i, spliced, sizeof(Value) * ns);
|
||||
|
|
@ -211,7 +211,7 @@ Value qq_expand(Value tmpl, Env *env, int depth) {
|
|||
|
||||
/* Collect parts */
|
||||
int cap = 64;
|
||||
Value *parts = (Value *)ul_malloc(sizeof(Value) * cap);
|
||||
Value *parts = (Value *)ul_malloc_values(sizeof(Value) * cap);
|
||||
int nparts = 0;
|
||||
Value n = tmpl;
|
||||
|
||||
|
|
@ -222,17 +222,17 @@ Value qq_expand(Value tmpl, Env *env, int depth) {
|
|||
Value spliced = leval(CADR(item), env);
|
||||
Value *items; int ni = value_to_list(spliced, &items);
|
||||
for (int i = 0; i < ni; i++) {
|
||||
if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc(parts, sizeof(Value) * cap); }
|
||||
if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc_values(parts, sizeof(Value) * cap); }
|
||||
parts[nparts++] = items[i];
|
||||
}
|
||||
ul_free(items);
|
||||
} else {
|
||||
if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc(parts, sizeof(Value) * cap); }
|
||||
if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc_values(parts, sizeof(Value) * cap); }
|
||||
parts[nparts++] = cons(SYM_UNQUOTE_SPLICING,
|
||||
cons(qq_expand(CADR(item), env, depth - 1), VAL_NIL));
|
||||
}
|
||||
} else {
|
||||
if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc(parts, sizeof(Value) * cap); }
|
||||
if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc_values(parts, sizeof(Value) * cap); }
|
||||
parts[nparts++] = qq_expand(item, env, depth);
|
||||
}
|
||||
n = CDR(n);
|
||||
|
|
@ -339,7 +339,7 @@ static Value define_record_type(Value *a, int na, Env *env) {
|
|||
/* Capture field count and name symbol */
|
||||
const char *type_tag = sym_name(name);
|
||||
int nf = nfields;
|
||||
Value *field_syms = (Value *)ul_malloc(sizeof(Value) * nf);
|
||||
Value *field_syms = (Value *)ul_malloc_values(sizeof(Value) * nf);
|
||||
for (int i = 0; i < nf; i++) field_syms[i] = ctor_spec[i + 1];
|
||||
|
||||
/* Create a Proc that builds (list 'type-name f1 f2 ...) */
|
||||
|
|
@ -348,10 +348,10 @@ static Value define_record_type(Value *a, int na, Env *env) {
|
|||
/* Actually, let's just define a Proc that builds the list */
|
||||
ExprList body;
|
||||
body.count = 1;
|
||||
body.exprs = (Value *)ul_malloc(sizeof(Value));
|
||||
body.exprs = (Value *)ul_malloc_values(sizeof(Value));
|
||||
|
||||
/* Build: (list (quote name) f1 f2 ...) */
|
||||
Value *listargs = (Value *)ul_malloc(sizeof(Value) * (nf + 2));
|
||||
Value *listargs = (Value *)ul_malloc_values(sizeof(Value) * (nf + 2));
|
||||
listargs[0] = intern("list");
|
||||
listargs[1] = cons(SYM_QUOTE, cons(name, VAL_NIL));
|
||||
for (int i = 0; i < nf; i++) listargs[2 + i] = field_syms[i];
|
||||
|
|
@ -382,7 +382,7 @@ static Value define_record_type(Value *a, int na, Env *env) {
|
|||
Value arg_sym = intern("x");
|
||||
ExprList body;
|
||||
body.count = 1;
|
||||
body.exprs = (Value *)ul_malloc(sizeof(Value));
|
||||
body.exprs = (Value *)ul_malloc_values(sizeof(Value));
|
||||
/* Build: (and (pair? x) (symbol? (car x)) (eq? (car x) 'name)) */
|
||||
/* Simpler: use a special check that understands subtypes */
|
||||
/* We'll need a native predicate. Let's put the type name in an env binding. */
|
||||
|
|
@ -541,7 +541,7 @@ static bool sr_match(SyntaxTransformer *st, Value pat, Value form, Env *bindings
|
|||
ULVector *vec = AS_VECTOR(existing->val);
|
||||
if (vec->len >= vec->cap) {
|
||||
vec->cap *= 2;
|
||||
vec->data = (Value *)ul_realloc(vec->data, sizeof(Value) * vec->cap);
|
||||
vec->data = (Value *)ul_realloc_values(vec->data, sizeof(Value) * vec->cap);
|
||||
}
|
||||
vec->data[vec->len++] = bind->val;
|
||||
} else {
|
||||
|
|
@ -549,7 +549,7 @@ static bool sr_match(SyntaxTransformer *st, Value pat, Value form, Env *bindings
|
|||
Value vec = make_vector(0, VAL_NIL);
|
||||
ULVector *v = AS_VECTOR(vec);
|
||||
v->cap = n_ell > 0 ? (size_t)n_ell : 4;
|
||||
v->data = (Value *)ul_realloc(v->data, sizeof(Value) * v->cap);
|
||||
v->data = (Value *)ul_realloc_values(v->data, sizeof(Value) * v->cap);
|
||||
v->data[0] = bind->val;
|
||||
v->len = 1;
|
||||
env_define(bindings, bind->sym, vec);
|
||||
|
|
@ -615,7 +615,7 @@ static Value sr_expand(SyntaxTransformer *st, Value tmpl, Env *bindings) {
|
|||
if (n < 0) n = 0;
|
||||
|
||||
/* Expand each iteration */
|
||||
Value *expanded = (Value *)ul_malloc(sizeof(Value) * n);
|
||||
Value *expanded = (Value *)ul_malloc_values(sizeof(Value) * n);
|
||||
for (int i = 0; i < n; i++) {
|
||||
/* Create a sub-binding env where vector vars are replaced by their i-th element */
|
||||
Env *sb = make_env(NULL);
|
||||
|
|
@ -921,8 +921,8 @@ Value leval(Value expr, Env *env) {
|
|||
int nbody = na - 2;
|
||||
Value *body_arr = a + 2;
|
||||
|
||||
Value *bps = (Value *)ul_malloc(sizeof(Value) * nb);
|
||||
Value *bvs = (Value *)ul_malloc(sizeof(Value) * nb);
|
||||
Value *bps = (Value *)ul_malloc_values(sizeof(Value) * nb);
|
||||
Value *bvs = (Value *)ul_malloc_values(sizeof(Value) * nb);
|
||||
for (int i = 0; i < nb; i++) {
|
||||
Value *bp; int nbp = value_to_list(binds[i], &bp);
|
||||
bps[i] = bp[0];
|
||||
|
|
@ -1034,7 +1034,7 @@ Value leval(Value expr, Env *env) {
|
|||
Env *c = make_env(env);
|
||||
/* Parse variable specs: (var init step) */
|
||||
typedef struct { Value var; Value step; } DoSpec;
|
||||
DoSpec *specs = (DoSpec *)ul_malloc(sizeof(DoSpec) * nvc);
|
||||
DoSpec *specs = (DoSpec *)ul_malloc_values(sizeof(DoSpec) * nvc);
|
||||
for (int i = 0; i < nvc; i++) {
|
||||
Value *sp; int nsp = value_to_list(vcs[i], &sp);
|
||||
specs[i].var = sp[0];
|
||||
|
|
@ -1055,7 +1055,7 @@ Value leval(Value expr, Env *env) {
|
|||
break;
|
||||
}
|
||||
for (int i = 0; i < nbody; i++) leval(body_arr[i], c);
|
||||
Value *nvs = (Value *)ul_malloc(sizeof(Value) * nvc);
|
||||
Value *nvs = (Value *)ul_malloc_values(sizeof(Value) * nvc);
|
||||
for (int i = 0; i < nvc; i++) nvs[i] = leval(specs[i].step, c);
|
||||
for (int i = 0; i < nvc; i++) env_set(c, specs[i].var, nvs[i]);
|
||||
ul_free(nvs);
|
||||
|
|
@ -1110,7 +1110,7 @@ Value leval(Value expr, Env *env) {
|
|||
st->literals = (char **)ul_malloc(sizeof(char *) * nlits);
|
||||
for (int i = 0; i < nlits; i++) st->literals[i] = ul_strdup(sym_name(lits[i]));
|
||||
st->nrules = na - 1;
|
||||
st->rules = (SyntaxRule *)ul_malloc(sizeof(SyntaxRule) * st->nrules);
|
||||
st->rules = (SyntaxRule *)ul_malloc_values(sizeof(SyntaxRule) * st->nrules);
|
||||
for (int i = 0; i < st->nrules; i++) {
|
||||
Value *rl; int nrl = value_to_list(a[i + 1], &rl);
|
||||
st->rules[i].pattern = rl[0];
|
||||
|
|
@ -1210,13 +1210,13 @@ Value leval(Value expr, Env *env) {
|
|||
int npre = na - 2;
|
||||
Value *pre = NULL;
|
||||
if (npre > 0) {
|
||||
pre = (Value *)ul_malloc(sizeof(Value) * npre);
|
||||
pre = (Value *)ul_malloc_values(sizeof(Value) * npre);
|
||||
for (int i = 0; i < npre; i++) pre[i] = leval(a[i + 1], env);
|
||||
}
|
||||
Value last = leval(a[na - 1], env);
|
||||
Value *lst; int nlst = value_to_list(last, &lst);
|
||||
|
||||
Value *all_args = (Value *)ul_malloc(sizeof(Value) * (npre + nlst));
|
||||
Value *all_args = (Value *)ul_malloc_values(sizeof(Value) * (npre + nlst));
|
||||
if (pre) memcpy(all_args, pre, sizeof(Value) * npre);
|
||||
memcpy(all_args + npre, lst, sizeof(Value) * nlst);
|
||||
int total = npre + nlst;
|
||||
|
|
@ -1260,7 +1260,7 @@ Value leval(Value expr, Env *env) {
|
|||
Value *irr = NULL;
|
||||
int nirr = na - 1;
|
||||
if (nirr > 0) {
|
||||
irr = (Value *)ul_malloc(sizeof(Value) * nirr);
|
||||
irr = (Value *)ul_malloc_values(sizeof(Value) * nirr);
|
||||
for (int i = 0; i < nirr; i++) irr[i] = leval(a[i + 1], env);
|
||||
}
|
||||
Value obj = make_error_object(msg, irr, nirr);
|
||||
|
|
@ -1409,7 +1409,7 @@ Value leval(Value expr, Env *env) {
|
|||
|
||||
/* Save old values and set new */
|
||||
typedef struct { Value param; Value old_val; } PBind;
|
||||
PBind *pb = (PBind *)ul_malloc(sizeof(PBind) * nb);
|
||||
PBind *pb = (PBind *)ul_malloc_values(sizeof(PBind) * nb);
|
||||
for (int i = 0; i < nb; i++) {
|
||||
Value *bp; int nbp = value_to_list(binds[i], &bp);
|
||||
pb[i].param = leval(bp[0], env);
|
||||
|
|
|
|||
170
c/gc.c
Normal file
170
c/gc.c
Normal file
|
|
@ -0,0 +1,170 @@
|
|||
/*
|
||||
* gc.c — precise tracing for NaN-boxed Values under Boehm GC.
|
||||
*
|
||||
* Boehm's conservative scan treats every machine word as a maybe-pointer:
|
||||
* if its bit pattern looks like a heap address, the target stays alive.
|
||||
* Lumbda's Values are NaN-boxed — pointers live in the low 48 bits with
|
||||
* tag bits in the upper mantissa, so the raw word never looks like a
|
||||
* pointer to Boehm. Live Pairs, Strings, Procs, etc. get reclaimed mid
|
||||
* iteration unless we tell Boehm how to walk our Value-bearing buffers.
|
||||
*
|
||||
* We register a custom mark kind. Any allocation that carries Values goes
|
||||
* through lumbda_value_malloc — Boehm tracks the kind on the block & calls
|
||||
* our mark proc when it scans the block. Our proc walks 8-byte words,
|
||||
* decodes the tag, & pushes the underlying pointer for each Value whose
|
||||
* tag identifies a pointer-bearing type.
|
||||
*
|
||||
* Pure-byte allocations (strings, bignum limbs, symbol names) stay on the
|
||||
* normal GC_MALLOC path — Boehm scans them as plain pointers correctly.
|
||||
*/
|
||||
|
||||
#ifdef USE_BOEHM_GC
|
||||
|
||||
#include "lumbda.h"
|
||||
#include <gc.h>
|
||||
#include <gc/gc_mark.h>
|
||||
|
||||
int lumbda_value_kind = -1;
|
||||
static void *lumbda_value_free_list = NULL;
|
||||
|
||||
/* Stack root scanning: Boehm's conservative scan over the C stack sees
|
||||
* raw 8-byte words & accepts those that fall inside heap bounds. A
|
||||
* NaN-boxed Value living in a C local has its high bits set (QNAN
|
||||
* pattern) so the raw word does NOT look like a valid heap address &
|
||||
* Boehm skips it — the underlying object dies even though the C frame
|
||||
* still holds the Value. We add a second pass via push_other_roots:
|
||||
* walk the same stack range Boehm already tracks, decode any NaN-boxed
|
||||
* Value & push its low-48 payload as a root. main() captures the stack
|
||||
* base at process start; the current SP comes from setjmp inside the
|
||||
* callback. */
|
||||
static void *g_stack_base = NULL;
|
||||
static GC_push_other_roots_proc g_prev_push_other_roots = NULL;
|
||||
|
||||
static void lumbda_push_other_roots(void) {
|
||||
if (g_prev_push_other_roots) g_prev_push_other_roots();
|
||||
if (!g_stack_base) return;
|
||||
/* setjmp serves only to anchor an address (&snap) inside our own
|
||||
* frame — the actual stack walk runs from there up to g_stack_base,
|
||||
* so it covers every C frame above us at the moment GC fired. Lisp
|
||||
* Values held in caller-saved regs are spilled to memory by callers
|
||||
* around any GC-triggering call (cons → make_pair → ul_malloc_values),
|
||||
* so the stack walk catches them too. */
|
||||
jmp_buf snap;
|
||||
setjmp(snap);
|
||||
Value *sp = (Value *)&snap;
|
||||
Value *base = (Value *)g_stack_base;
|
||||
if (sp > base) { Value *t = sp; sp = base; base = t; }
|
||||
for (Value *p = sp; p < base; p++) {
|
||||
Value v = *p;
|
||||
if ((v & QNAN) != QNAN) continue;
|
||||
uint64_t tag = (v >> TAG_SHIFT) & 7ULL;
|
||||
if (tag == TAG_INT || tag == TAG_SPECIAL) continue;
|
||||
void *ptr = (void *)(uintptr_t)(v & PAYLOAD_MASK);
|
||||
if (!ptr) continue;
|
||||
/* GC_push_all_eager marks the location immediately rather than
|
||||
* deferring to the regular mark stack — safe to point at a
|
||||
* stack-local since the mark happens before we return. */
|
||||
GC_push_all_eager(&ptr, (char *)&ptr + sizeof(void *));
|
||||
}
|
||||
}
|
||||
|
||||
void lumbda_gc_set_stack_base(void *base) { g_stack_base = base; }
|
||||
|
||||
/*
|
||||
* Mark proc: scan a block of memory containing a mix of NaN-boxed Values
|
||||
* & plain pointer fields (struct headers, embedded raw pointers).
|
||||
*
|
||||
* `addr` points at the head of the block. `GC_size(addr)` gives the block
|
||||
* size in bytes. We treat the block as an array of 8-byte words & decode
|
||||
* each one in two passes:
|
||||
*
|
||||
* 1. NaN-boxed pointer Value: upper QNAN bits set, tag ∈
|
||||
* {PTR(0), SYM(2), BUILTIN(4), RATIONAL(5), BIGNUM(6)}. Extract the
|
||||
* low 48 bits as the pointer & push that.
|
||||
* 2. Plain raw pointer: anything else. Push the word as-is —
|
||||
* GC_MARK_AND_PUSH validates against heap bounds, so ints, enums,
|
||||
* fixnums, etc. fall outside & are silently skipped.
|
||||
*
|
||||
* Heap addresses on Linux user-space sit below 2^47, so bits 48..63 of a
|
||||
* plain pointer are zero — `(ptr & QNAN) == 0 != QNAN`, never confused
|
||||
* with a NaN-boxed Value. Inversely, a NaN-boxed pointer has bits 48..62
|
||||
* set & its low 48 hold the real address; treating the raw word as a
|
||||
* pointer in pass 2 would walk into nowhere (heap base + tag bits = bad
|
||||
* address that fails the heap-bounds check anyway).
|
||||
*
|
||||
* This makes the precise kind safe for ANY struct (header + Values +
|
||||
* raw pointers) — strictly a superset of what conservative NORMAL kind
|
||||
* would catch, plus precise NaN-box decoding.
|
||||
*/
|
||||
struct GC_ms_entry *
|
||||
mark_lumbda_value_block(GC_word *addr,
|
||||
struct GC_ms_entry *mark_stack_ptr,
|
||||
struct GC_ms_entry *mark_stack_limit,
|
||||
GC_word env) {
|
||||
(void)env;
|
||||
size_t bytes = GC_size((const void *)addr);
|
||||
size_t nwords = bytes / sizeof(Value);
|
||||
Value *p = (Value *)addr;
|
||||
for (size_t i = 0; i < nwords; i++) {
|
||||
Value v = p[i];
|
||||
if ((v & QNAN) == QNAN) {
|
||||
uint64_t tag = (v >> TAG_SHIFT) & 7ULL;
|
||||
if (tag == TAG_INT || tag == TAG_SPECIAL) continue;
|
||||
/* NaN-boxed pointer-bearing tag — decode low 48 bits. */
|
||||
void *ptr = (void *)(uintptr_t)(v & PAYLOAD_MASK);
|
||||
if (!ptr) continue;
|
||||
mark_stack_ptr = GC_MARK_AND_PUSH(ptr,
|
||||
mark_stack_ptr,
|
||||
mark_stack_limit,
|
||||
(void **)&p[i]);
|
||||
} else {
|
||||
/* Not NaN-boxed: treat as raw pointer (or non-pointer int that
|
||||
* the heap-bounds check inside GC_MARK_AND_PUSH will reject). */
|
||||
mark_stack_ptr = GC_MARK_AND_PUSH((void *)(uintptr_t)v,
|
||||
mark_stack_ptr,
|
||||
mark_stack_limit,
|
||||
(void **)&p[i]);
|
||||
}
|
||||
}
|
||||
return mark_stack_ptr;
|
||||
}
|
||||
|
||||
void lumbda_gc_init(void) {
|
||||
if (lumbda_value_kind != -1) return;
|
||||
int proc_idx = GC_new_proc(mark_lumbda_value_block);
|
||||
/* GC_new_kind(free_list, mark_descriptor, add_size_to_descriptor,
|
||||
* clear_new_objects)
|
||||
* - mark_descriptor: GC_MAKE_PROC(proc_idx, 0) — call our proc.
|
||||
* - add_size_to_descriptor: 0 — DS_PROC descriptors do not survive
|
||||
* the bdwgc per-object `descr += sz` adjustment; bytes would
|
||||
* overflow into proc_idx bits & dispatch through a NULL proc
|
||||
* slot. The proc derives size via GC_size(addr) instead.
|
||||
* - clear_new_objects: 1 — zero-init so we never decode garbage as
|
||||
* a stale pointer before the caller writes the first Value. */
|
||||
lumbda_value_kind = GC_new_kind(&lumbda_value_free_list,
|
||||
GC_MAKE_PROC(proc_idx, 0),
|
||||
0, 1);
|
||||
g_prev_push_other_roots = GC_get_push_other_roots();
|
||||
GC_set_push_other_roots(lumbda_push_other_roots);
|
||||
}
|
||||
|
||||
|
||||
void *lumbda_value_malloc(size_t sz) {
|
||||
if (lumbda_value_kind == -1) lumbda_gc_init();
|
||||
return GC_generic_malloc(sz, lumbda_value_kind);
|
||||
}
|
||||
|
||||
#else /* !USE_BOEHM_GC */
|
||||
|
||||
#include "lumbda.h"
|
||||
|
||||
int lumbda_value_kind = -1;
|
||||
|
||||
void lumbda_gc_init(void) { /* no-op */ }
|
||||
void lumbda_gc_set_stack_base(void *base) { (void)base; }
|
||||
|
||||
void *lumbda_value_malloc(size_t sz) {
|
||||
return malloc(sz);
|
||||
}
|
||||
|
||||
#endif
|
||||
15
c/lumbda.h
15
c/lumbda.h
|
|
@ -34,11 +34,20 @@
|
|||
#define ul_realloc(p,sz) GC_REALLOC(p,sz)
|
||||
#define ul_free(p) ((void)0)
|
||||
#define ul_strdup(s) GC_STRDUP(s)
|
||||
/* Precise-kind allocator for buffers that store NaN-boxed Values. Boehm's
|
||||
* conservative scan misses NaN-boxed pointers; our custom kind walks the
|
||||
* block, decodes each 8-byte word, & marks the underlying pointer. See
|
||||
* gc.c. GC_REALLOC preserves the object's kind, so the same call grows
|
||||
* Value buffers correctly. */
|
||||
#define ul_malloc_values(sz) lumbda_value_malloc(sz)
|
||||
#define ul_realloc_values(p,sz) GC_REALLOC(p,sz)
|
||||
#else
|
||||
/* Fallback: plain malloc (no collection — acceptable for batch scripts) */
|
||||
#define ul_malloc(sz) malloc(sz)
|
||||
#define ul_realloc(p,sz) realloc(p,sz)
|
||||
#define ul_free(p) free(p)
|
||||
#define ul_malloc_values(sz) malloc(sz)
|
||||
#define ul_realloc_values(p,sz) realloc(p,sz)
|
||||
static inline char *ul_strdup(const char *s) {
|
||||
size_t n = strlen(s) + 1;
|
||||
char *d = (char *)ul_malloc(n);
|
||||
|
|
@ -47,6 +56,12 @@ static inline char *ul_strdup(const char *s) {
|
|||
}
|
||||
#endif
|
||||
|
||||
/* Precise tracing for NaN-boxed Values under Boehm GC — implementation in gc.c. */
|
||||
extern int lumbda_value_kind;
|
||||
void lumbda_gc_init(void);
|
||||
void lumbda_gc_set_stack_base(void *base);
|
||||
void *lumbda_value_malloc(size_t sz);
|
||||
|
||||
/* ═══════════════════════════════════════════════════════════════════════════
|
||||
* NaN-boxed Value type
|
||||
*
|
||||
|
|
|
|||
26
c/main.c
26
c/main.c
|
|
@ -119,19 +119,29 @@ static void repl(Env *env) {
|
|||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int stack_anchor;
|
||||
#ifdef USE_BOEHM_GC
|
||||
/* GC_INIT registers stack base for conservative scan. Without it,
|
||||
/* GC_INIT registers our stack base for conservative scan. Without it,
|
||||
* roots can be missed on some Linux configs.
|
||||
*
|
||||
* GC_disable is a deliberate stopgap: lumbda Values are NaN-boxed
|
||||
* pointers that conservative Boehm cannot recognize as pointers,
|
||||
* so live targets get reclaimed (env binding symbol payloads,
|
||||
* SymbolEntry strings) and lookups fail with "undefined: <sym>".
|
||||
* Until tracing is precise, growing the heap is safer than wrong
|
||||
* results. Long-running workloads should run under ulimit -v.
|
||||
* lumbda_gc_init registers a custom mark kind for NaN-boxed Value
|
||||
* buffers (see gc.c). Boehm's conservative scan treats NaN-boxed
|
||||
* Values as plain bit patterns & misses the embedded pointers, so
|
||||
* any allocation that carries Values (Pair, Env bindings, Vector
|
||||
* data[], CodeObj instrs[], ValueStack data[], etc.) routes through
|
||||
* lumbda_value_malloc / ul_malloc_values which tags the block with
|
||||
* our kind. Our mark proc then walks the words & pushes each
|
||||
* pointer-bearing tag's payload onto Boehm's mark stack.
|
||||
*
|
||||
* lumbda_gc_set_stack_base hands gc.c the top-of-stack so its
|
||||
* push_other_roots callback can scan the same range for on-stack
|
||||
* NaN-boxed Values that Boehm's pure conservative scan misses.
|
||||
*/
|
||||
GC_INIT();
|
||||
GC_disable();
|
||||
lumbda_gc_init();
|
||||
lumbda_gc_set_stack_base(&stack_anchor);
|
||||
#else
|
||||
(void)stack_anchor;
|
||||
#endif
|
||||
init_symbols();
|
||||
Env *g = make_global_env();
|
||||
|
|
|
|||
|
|
@ -620,7 +620,7 @@ static Value json_to_value(JsonNode *n, Env *base_env) {
|
|||
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));
|
||||
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]));
|
||||
}
|
||||
|
|
@ -629,7 +629,7 @@ static Value json_to_value(JsonNode *n, Env *base_env) {
|
|||
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));
|
||||
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) {
|
||||
|
|
|
|||
|
|
@ -376,14 +376,14 @@ Value *read_all(const char *src, int *count, bool track_lines) {
|
|||
tokenize(src, &tl, track_lines);
|
||||
|
||||
int cap = 64;
|
||||
Value *exprs = (Value *)ul_malloc(sizeof(Value) * cap);
|
||||
Value *exprs = (Value *)ul_malloc_values(sizeof(Value) * cap);
|
||||
*count = 0;
|
||||
int pos = 0;
|
||||
|
||||
while (pos < tl.count) {
|
||||
if (*count >= cap) {
|
||||
cap *= 2;
|
||||
exprs = (Value *)ul_realloc(exprs, sizeof(Value) * cap);
|
||||
exprs = (Value *)ul_realloc_values(exprs, sizeof(Value) * cap);
|
||||
}
|
||||
exprs[*count] = parse_one(&tl, &pos);
|
||||
(*count)++;
|
||||
|
|
|
|||
8
c/test.c
8
c/test.c
|
|
@ -1135,6 +1135,14 @@ TEST(emit_stream_empty) {
|
|||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||||
|
||||
int main(void) {
|
||||
int stack_anchor;
|
||||
#ifdef USE_BOEHM_GC
|
||||
GC_INIT();
|
||||
lumbda_gc_init();
|
||||
lumbda_gc_set_stack_base(&stack_anchor);
|
||||
#else
|
||||
(void)stack_anchor;
|
||||
#endif
|
||||
init_symbols();
|
||||
|
||||
printf("Running lumbda C tests...\n\n");
|
||||
|
|
|
|||
45
c/types.c
45
c/types.c
|
|
@ -47,23 +47,33 @@ void lisp_error_with_obj(Value obj, const char *fmt, ...) {
|
|||
* Value stack
|
||||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||||
|
||||
/* Unused slots in s->data are zeroed so Boehm's conservative scan of
|
||||
* this GC_MALLOC region does not treat stale popped pointers as live
|
||||
* roots. Without this, popped Scheme values stay pinned for the
|
||||
* lifetime of the stack — every closure ever pushed leaks. */
|
||||
|
||||
void vs_init(ValueStack *s, int cap) {
|
||||
s->data = (Value *)ul_malloc(sizeof(Value) * cap);
|
||||
s->data = (Value *)ul_malloc_values(sizeof(Value) * cap);
|
||||
memset(s->data, 0, sizeof(Value) * cap);
|
||||
s->len = 0;
|
||||
s->cap = cap;
|
||||
}
|
||||
|
||||
void vs_push(ValueStack *s, Value v) {
|
||||
if (s->len >= s->cap) {
|
||||
int old_cap = s->cap;
|
||||
s->cap = s->cap * 2;
|
||||
s->data = (Value *)ul_realloc(s->data, sizeof(Value) * s->cap);
|
||||
s->data = (Value *)ul_realloc_values(s->data, sizeof(Value) * s->cap);
|
||||
memset(s->data + old_cap, 0, sizeof(Value) * (s->cap - old_cap));
|
||||
}
|
||||
s->data[s->len++] = v;
|
||||
}
|
||||
|
||||
Value vs_pop(ValueStack *s) {
|
||||
if (s->len <= 0) lisp_error("stack underflow");
|
||||
return s->data[--s->len];
|
||||
Value v = s->data[--s->len];
|
||||
s->data[s->len] = 0;
|
||||
return v;
|
||||
}
|
||||
|
||||
Value vs_peek(ValueStack *s) {
|
||||
|
|
@ -72,6 +82,7 @@ Value vs_peek(ValueStack *s) {
|
|||
}
|
||||
|
||||
void vs_clear(ValueStack *s) {
|
||||
if (s->len > 0) memset(s->data, 0, sizeof(Value) * s->len);
|
||||
s->len = 0;
|
||||
}
|
||||
|
||||
|
|
@ -96,7 +107,7 @@ Value intern(const char *name) {
|
|||
}
|
||||
/* New symbol */
|
||||
char *copy = ul_strdup(name);
|
||||
SymbolEntry *ne = (SymbolEntry *)ul_malloc(sizeof(SymbolEntry));
|
||||
SymbolEntry *ne = (SymbolEntry *)ul_malloc_values(sizeof(SymbolEntry));
|
||||
ne->name = copy;
|
||||
ne->value = VAL_SYM_RAW(copy);
|
||||
ne->next = g_symbols.buckets[h];
|
||||
|
|
@ -113,7 +124,7 @@ const char *sym_name(Value sym) {
|
|||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||||
|
||||
Pair *make_pair(Value car, Value cdr) {
|
||||
Pair *p = (Pair *)ul_malloc(sizeof(Pair));
|
||||
Pair *p = (Pair *)ul_malloc_values(sizeof(Pair));
|
||||
p->hdr.type = OBJ_PAIR;
|
||||
p->car = car;
|
||||
p->cdr = cdr;
|
||||
|
|
@ -153,7 +164,7 @@ Value make_vector(size_t len, Value fill) {
|
|||
v->hdr.type = OBJ_VECTOR;
|
||||
v->len = len;
|
||||
v->cap = len > 0 ? len : 4;
|
||||
v->data = (Value *)ul_malloc(sizeof(Value) * v->cap);
|
||||
v->data = (Value *)ul_malloc_values(sizeof(Value) * v->cap);
|
||||
for (size_t i = 0; i < len; i++) v->data[i] = fill;
|
||||
return VAL_PTR(v);
|
||||
}
|
||||
|
|
@ -163,7 +174,7 @@ Value make_vector_from(Value *items, size_t len) {
|
|||
v->hdr.type = OBJ_VECTOR;
|
||||
v->len = len;
|
||||
v->cap = len > 0 ? len : 4;
|
||||
v->data = (Value *)ul_malloc(sizeof(Value) * v->cap);
|
||||
v->data = (Value *)ul_malloc_values(sizeof(Value) * v->cap);
|
||||
memcpy(v->data, items, sizeof(Value) * len);
|
||||
return VAL_PTR(v);
|
||||
}
|
||||
|
|
@ -206,7 +217,7 @@ void ht_set(ULHashTable *ht, Value key, Value val) {
|
|||
if (values_equal(e->key, key)) { e->value = val; return; }
|
||||
e = e->next;
|
||||
}
|
||||
HTEntry *ne = (HTEntry *)ul_malloc(sizeof(HTEntry));
|
||||
HTEntry *ne = (HTEntry *)ul_malloc_values(sizeof(HTEntry));
|
||||
ne->key = key;
|
||||
ne->value = val;
|
||||
ne->next = ht->buckets[h];
|
||||
|
|
@ -502,7 +513,7 @@ void env_define(Env *e, Value sym, Value val) {
|
|||
b = b->next;
|
||||
}
|
||||
/* New binding */
|
||||
EnvBinding *nb = (EnvBinding *)ul_malloc(sizeof(EnvBinding));
|
||||
EnvBinding *nb = (EnvBinding *)ul_malloc_values(sizeof(EnvBinding));
|
||||
nb->sym = sym;
|
||||
nb->val = val;
|
||||
nb->next = e->buckets[h];
|
||||
|
|
@ -609,7 +620,7 @@ VMFrame *deep_copy_frames(VMFrame *frames, int nframes) {
|
|||
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);
|
||||
copy[i].stack = (Value *)ul_malloc_values(sizeof(Value) * copy[i].stack_cap);
|
||||
memcpy(copy[i].stack, frames[i].stack, sizeof(Value) * frames[i].stack_len);
|
||||
}
|
||||
return copy;
|
||||
|
|
@ -621,7 +632,7 @@ FullCont *make_full_cont(VMFrame *frames, int nframes, Value *stack, int stack_l
|
|||
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));
|
||||
c->stack = (Value *)ul_malloc_values(sizeof(Value) * (stack_len > 0 ? stack_len : 4));
|
||||
memcpy(c->stack, stack, sizeof(Value) * stack_len);
|
||||
c->stack_len = stack_len;
|
||||
c->ip = ip;
|
||||
|
|
@ -646,7 +657,7 @@ Env *deep_copy_env(Env *env) {
|
|||
EnvBinding *src = env->buckets[i];
|
||||
EnvBinding **dst = &ne->buckets[i];
|
||||
while (src) {
|
||||
EnvBinding *nb = (EnvBinding *)ul_malloc(sizeof(EnvBinding));
|
||||
EnvBinding *nb = (EnvBinding *)ul_malloc_values(sizeof(EnvBinding));
|
||||
nb->sym = src->sym;
|
||||
nb->val = src->val;
|
||||
nb->next = NULL;
|
||||
|
|
@ -666,13 +677,13 @@ Env *deep_copy_env(Env *env) {
|
|||
|
||||
Proc *make_proc(Value *params, int nparams, Value rest,
|
||||
ExprList body, Env *env, const char *name) {
|
||||
Proc *p = (Proc *)ul_malloc(sizeof(Proc));
|
||||
Proc *p = (Proc *)ul_malloc_values(sizeof(Proc));
|
||||
p->hdr.type = OBJ_PROC;
|
||||
p->params = (Value *)ul_malloc(sizeof(Value) * nparams);
|
||||
p->params = (Value *)ul_malloc_values(sizeof(Value) * nparams);
|
||||
memcpy(p->params, params, sizeof(Value) * nparams);
|
||||
p->nparams = nparams;
|
||||
p->rest = rest;
|
||||
p->body.exprs = (Value *)ul_malloc(sizeof(Value) * body.count);
|
||||
p->body.exprs = (Value *)ul_malloc_values(sizeof(Value) * body.count);
|
||||
memcpy(p->body.exprs, body.exprs, sizeof(Value) * body.count);
|
||||
p->body.count = body.count;
|
||||
p->env = env;
|
||||
|
|
@ -687,7 +698,7 @@ Proc *make_proc(Value *params, int nparams, Value rest,
|
|||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||||
|
||||
Value make_macro(Value transformer) {
|
||||
ULMacro *m = (ULMacro *)ul_malloc(sizeof(ULMacro));
|
||||
ULMacro *m = (ULMacro *)ul_malloc_values(sizeof(ULMacro));
|
||||
m->hdr.type = OBJ_MACRO;
|
||||
m->transformer = transformer;
|
||||
return VAL_PTR(m);
|
||||
|
|
@ -703,7 +714,7 @@ Value make_error_object(const char *msg, Value *irritants, int nirr) {
|
|||
e->message = ul_strdup(msg);
|
||||
e->nirritants = nirr;
|
||||
if (nirr > 0) {
|
||||
e->irritants = (Value *)ul_malloc(sizeof(Value) * nirr);
|
||||
e->irritants = (Value *)ul_malloc_values(sizeof(Value) * nirr);
|
||||
memcpy(e->irritants, irritants, sizeof(Value) * nirr);
|
||||
} else {
|
||||
e->irritants = NULL;
|
||||
|
|
|
|||
25
c/vm.c
25
c/vm.c
|
|
@ -12,7 +12,8 @@ CodeObj *make_code(const char *name) {
|
|||
c->hdr.type = OBJ_CODE;
|
||||
c->cap = 64;
|
||||
c->count = 0;
|
||||
c->instrs = (Instruction *)ul_malloc(sizeof(Instruction) * c->cap);
|
||||
/* Instruction carries a Value `arg` — buffer needs precise tracing. */
|
||||
c->instrs = (Instruction *)ul_malloc_values(sizeof(Instruction) * c->cap);
|
||||
c->source_map = (int *)ul_malloc(sizeof(int) * c->cap);
|
||||
c->name = name ? ul_strdup(name) : NULL;
|
||||
c->self_name = NULL;
|
||||
|
|
@ -24,7 +25,7 @@ CodeObj *make_code(const char *name) {
|
|||
int code_emit(CodeObj *c, Opcode op, Value arg) {
|
||||
if (c->count >= c->cap) {
|
||||
c->cap *= 2;
|
||||
c->instrs = (Instruction *)ul_realloc(c->instrs, sizeof(Instruction) * c->cap);
|
||||
c->instrs = (Instruction *)ul_realloc_values(c->instrs, sizeof(Instruction) * c->cap);
|
||||
c->source_map = (int *)ul_realloc(c->source_map, sizeof(int) * c->cap);
|
||||
}
|
||||
int idx = c->count;
|
||||
|
|
@ -91,7 +92,7 @@ CodeObj *bc_lambda(Value *body, int nbody, Value *params, int nparams,
|
|||
CodeObj *inner = make_code(name);
|
||||
if (self_name) {
|
||||
inner->self_name = ul_strdup(self_name);
|
||||
inner->self_params = (Value *)ul_malloc(sizeof(Value) * self_nparams);
|
||||
inner->self_params = (Value *)ul_malloc_values(sizeof(Value) * self_nparams);
|
||||
memcpy(inner->self_params, self_params, sizeof(Value) * self_nparams);
|
||||
inner->self_nparams = self_nparams;
|
||||
}
|
||||
|
|
@ -100,7 +101,7 @@ CodeObj *bc_lambda(Value *body, int nbody, Value *params, int nparams,
|
|||
int i = 0;
|
||||
Value *def_names = NULL;
|
||||
int ndef = 0;
|
||||
Value *expanded = (Value *)ul_malloc(sizeof(Value) * (nbody + 64));
|
||||
Value *expanded = (Value *)ul_malloc_values(sizeof(Value) * (nbody + 64));
|
||||
memcpy(expanded, body, sizeof(Value) * nbody);
|
||||
int n = nbody;
|
||||
|
||||
|
|
@ -110,7 +111,7 @@ CodeObj *bc_lambda(Value *body, int nbody, Value *params, int nparams,
|
|||
Value *a; int na = value_to_list(CDR(f), &a);
|
||||
Value nm = IS_PAIR(a[0]) ? CAR(a[0]) : a[0];
|
||||
if (IS_SYM(nm)) {
|
||||
def_names = (Value *)ul_realloc(def_names, sizeof(Value) * (ndef + 1));
|
||||
def_names = (Value *)ul_realloc_values(def_names, sizeof(Value) * (ndef + 1));
|
||||
def_names[ndef++] = nm;
|
||||
}
|
||||
ul_free(a);
|
||||
|
|
@ -300,7 +301,7 @@ void bc_compile(Value expr, CodeObj *code, Env *env, bool tail) {
|
|||
AS_VECTOR(closure_info)->data[2] = f.rest;
|
||||
/* Store params in the vector too */
|
||||
Value params_vec = make_vector_from(f.params, f.nparams);
|
||||
AS_VECTOR(closure_info)->data = (Value *)ul_realloc(AS_VECTOR(closure_info)->data, sizeof(Value) * 4);
|
||||
AS_VECTOR(closure_info)->data = (Value *)ul_realloc_values(AS_VECTOR(closure_info)->data, sizeof(Value) * 4);
|
||||
AS_VECTOR(closure_info)->len = 4;
|
||||
AS_VECTOR(closure_info)->cap = 4;
|
||||
AS_VECTOR(closure_info)->data[3] = params_vec;
|
||||
|
|
@ -347,7 +348,7 @@ void bc_compile(Value expr, CodeObj *code, Env *env, bool tail) {
|
|||
/* Named let */
|
||||
Value name = a[0];
|
||||
Value *binds; int nb = value_to_list(a[1], &binds);
|
||||
Value *bps = (Value *)ul_malloc(sizeof(Value) * nb);
|
||||
Value *bps = (Value *)ul_malloc_values(sizeof(Value) * nb);
|
||||
for (int i = 0; i < nb; i++) {
|
||||
Value *bp; int nbp = value_to_list(binds[i], &bp);
|
||||
bps[i] = bp[0];
|
||||
|
|
@ -437,7 +438,7 @@ void bc_compile(Value expr, CodeObj *code, Env *env, bool tail) {
|
|||
|
||||
/* Initialize vars */
|
||||
typedef struct { Value var; Value step; } DoSpec;
|
||||
DoSpec *specs = (DoSpec *)ul_malloc(sizeof(DoSpec) * nvc);
|
||||
DoSpec *specs = (DoSpec *)ul_malloc_values(sizeof(DoSpec) * nvc);
|
||||
for (int i = 0; i < nvc; i++) {
|
||||
Value *sp; int nsp = value_to_list(vcs[i], &sp);
|
||||
specs[i].var = sp[0];
|
||||
|
|
@ -635,10 +636,10 @@ CompiledProc *compile_proc(Proc *p, Env *env) {
|
|||
CodeObj *code = bc_lambda(p->body.exprs, p->body.count,
|
||||
p->params, p->nparams, p->rest, env,
|
||||
p->name, NULL, NULL, 0);
|
||||
CompiledProc *cp = (CompiledProc *)ul_malloc(sizeof(CompiledProc));
|
||||
CompiledProc *cp = (CompiledProc *)ul_malloc_values(sizeof(CompiledProc));
|
||||
cp->hdr.type = OBJ_COMPILED_PROC;
|
||||
cp->code = code;
|
||||
cp->params = (Value *)ul_malloc(sizeof(Value) * p->nparams);
|
||||
cp->params = (Value *)ul_malloc_values(sizeof(Value) * p->nparams);
|
||||
memcpy(cp->params, p->params, sizeof(Value) * p->nparams);
|
||||
cp->nparams = p->nparams;
|
||||
cp->rest = p->rest;
|
||||
|
|
@ -715,7 +716,7 @@ Value vm_exec(CodeObj *code, Env *env) {
|
|||
ul_free(stack.data);
|
||||
stack.len = c->stack_len;
|
||||
stack.cap = c->stack_len + 16;
|
||||
stack.data = (Value *)ul_malloc(sizeof(Value) * stack.cap);
|
||||
stack.data = (Value *)ul_malloc_values(sizeof(Value) * stack.cap);
|
||||
memcpy(stack.data, c->stack, sizeof(Value) * c->stack_len);
|
||||
vs_push(&stack, val);
|
||||
|
||||
|
|
@ -876,7 +877,7 @@ Value vm_exec(CodeObj *code, Env *env) {
|
|||
Value rest = info->data[2];
|
||||
ULVector *params_vec = AS_VECTOR(info->data[3]);
|
||||
|
||||
CompiledProc *cp = (CompiledProc *)ul_malloc(sizeof(CompiledProc));
|
||||
CompiledProc *cp = (CompiledProc *)ul_malloc_values(sizeof(CompiledProc));
|
||||
cp->hdr.type = OBJ_COMPILED_PROC;
|
||||
cp->code = inner;
|
||||
cp->params = params_vec->data;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue