Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 06:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

switching to data-driven sexp_mark

Browse source
This commit is contained in:
Alex Shinn 2009-06-15 17:34:26 +09:00
parent d374a7e185
commit c725c48f74
6 changed files with 56 additions and 299 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
Makefile
View file

@ -14,9 +14,6 @@ LDFLAGS=-lm
# -Oz for smaller size on darwin
CFLAGS=-Wall -g -save-temps
#GC_OBJ=./gc/gc.a
GC_OBJ=
./gc/gc.a: ./gc/alloc.c
cd gc && make
@ -29,7 +26,7 @@ eval.o: eval.c debug.c opcodes.c eval.h sexp.h config.h defaults.h Makefile
main.o: main.c eval.c debug.c opcodes.c eval.h sexp.h config.h defaults.h Makefile
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
chibi-scheme: main.o sexp.o $(GC_OBJ)
chibi-scheme: main.o sexp.o
gcc $(CFLAGS) $(LDFLAGS) -o $@ $^
clean:

2
VERSION
View file

@ -1 +1 @@
0.1
0.2

273
gc.c
View file

@ -15,38 +15,6 @@ static sexp sexp_free_list;
static sexp* stack_base;
sexp_uint_t sexp_allocated_bytes0 (sexp x) {
switch (sexp_pointer_tag(x)) {
case SEXP_PAIR: return sexp_sizeof(pair);
case SEXP_SYMBOL: return sexp_sizeof(symbol);
case SEXP_STRING: return sexp_sizeof(string)+sexp_string_length(x)+1;
case SEXP_VECTOR:
return sexp_sizeof(vector)+(sexp_vector_length(x)*sizeof(sexp));
case SEXP_STACK:
return sexp_sizeof(stack)+(sexp_stack_length(x)*sizeof(sexp));
case SEXP_FLONUM: return sexp_sizeof(flonum);
case SEXP_BIGNUM: return sexp_sizeof(bignum);
case SEXP_IPORT:
case SEXP_OPORT: return sexp_sizeof(port);
case SEXP_EXCEPTION: return sexp_sizeof(exception);
case SEXP_PROCEDURE: return sexp_sizeof(procedure);
case SEXP_MACRO: return sexp_sizeof(macro);
case SEXP_SYNCLO: return sexp_sizeof(synclo);
case SEXP_ENV: return sexp_sizeof(env);
case SEXP_BYTECODE: return sexp_sizeof(bytecode)+sexp_bytecode_length(x);
case SEXP_CORE: return sexp_sizeof(core);
case SEXP_OPCODE: return sexp_sizeof(opcode);
case SEXP_LAMBDA: return sexp_sizeof(lambda);
case SEXP_CND: return sexp_sizeof(cnd);
case SEXP_REF: return sexp_sizeof(ref);
case SEXP_SET: return sexp_sizeof(set);
case SEXP_SEQ: return sexp_sizeof(seq);
case SEXP_LIT: return sexp_sizeof(lit);
case SEXP_CONTEXT: return sexp_sizeof(context);
default: return sexp_align(1, 4);
}
}
sexp_uint_t sexp_allocated_bytes (sexp x) {
sexp_uint_t res, *len_ptr;
sexp t;
@ -55,247 +23,34 @@ sexp_uint_t sexp_allocated_bytes (sexp x) {
t = &(sexp_types[sexp_pointer_tag(x)]);
len_ptr = (sexp_uint_t*) (((char*)x) + sexp_type_size_off(t));
res = sexp_type_size_base(t) + len_ptr[0] * sexp_type_size_scale(t);
if (res != sexp_allocated_bytes0(x)) {
fprintf(stderr, "allocated bytes differ for tag %d @ %p: switch: %lu, data: %lu\n", sexp_pointer_tag(x), x, sexp_allocated_bytes0(x), res);
if (! res)
res = sexp_align(1, 4);
/* exit(1); */
}
return res;
}
void sexp_mark (sexp x) {
sexp *data;
sexp_sint_t i;
sexp_uint_t *len_ptr;
sexp_sint_t i, len;
sexp t, *p;
struct sexp_gc_var_t *saves;
loop:
if (((char*)x < sexp_heap) || ((char*)x >= sexp_heap_end)) {
if (x && sexp_pointerp(x) && (sexp_pointer_tag(x) != SEXP_OPCODE)
&& (sexp_pointer_tag(x) != SEXP_CORE))
fprintf(stderr, "--------------- outside heap: %p (%x) ------------------\n", x, sexp_pointer_tag(x));
return;
}
if ((! x) || (! sexp_pointerp(x)) || sexp_gc_mark(x))
return;
sexp_gc_mark(x) = 1;
/* fprintf(stderr, "----------------- marking %p (%x) --------------------\n", */
/* x, sexp_pointer_tag(x)); */
switch (sexp_pointer_tag(x)) {
case SEXP_PAIR:
sexp_mark(sexp_car(x));
x = sexp_cdr(x);
goto loop;
case SEXP_STACK:
data = sexp_stack_data(x);
if (! sexp_stack_top(x)) break;
for (i=sexp_stack_top(x)-1; i>0; i--)
sexp_mark(data[i]);
x = data[0];
goto loop;
case SEXP_VECTOR:
data = sexp_vector_data(x);
if (! sexp_vector_length(x)) break;
for (i=sexp_vector_length(x)-1; i>0; i--)
sexp_mark(data[i]);
x = data[0];
goto loop;
case SEXP_SYMBOL:
x = sexp_symbol_string(x);
goto loop;
case SEXP_BYTECODE:
sexp_mark(sexp_bytecode_name(x));
x = sexp_bytecode_literals(x);
goto loop;
case SEXP_ENV:
sexp_mark(sexp_env_lambda(x));
sexp_mark(sexp_env_bindings(x));
x = sexp_env_parent(x);
if (x) goto loop; else break;
case SEXP_PROCEDURE:
sexp_mark(sexp_procedure_code(x));
x = sexp_procedure_vars(x);
goto loop;
case SEXP_MACRO:
sexp_mark(sexp_macro_proc(x));
x = sexp_macro_env(x);
goto loop;
case SEXP_SYNCLO:
sexp_mark(sexp_synclo_free_vars(x));
sexp_mark(sexp_synclo_expr(x));
x = sexp_synclo_env(x);
goto loop;
case SEXP_OPCODE:
if (sexp_opcode_proc(x)) sexp_mark(sexp_opcode_proc(x));
if (sexp_opcode_default(x)) sexp_mark(sexp_opcode_default(x));
break;
case SEXP_IPORT:
case SEXP_OPORT:
x = sexp_port_cookie(x);
if (x) goto loop; else break;
case SEXP_LAMBDA:
sexp_mark(sexp_lambda_name(x));
sexp_mark(sexp_lambda_params(x));
sexp_mark(sexp_lambda_locals(x));
sexp_mark(sexp_lambda_defs(x));
sexp_mark(sexp_lambda_flags(x));
sexp_mark(sexp_lambda_fv(x));
sexp_mark(sexp_lambda_sv(x));
x = sexp_lambda_body(x);
goto loop;
case SEXP_CND:
sexp_mark(sexp_cnd_test(x));
sexp_mark(sexp_cnd_fail(x));
x = sexp_cnd_pass(x);
goto loop;
case SEXP_SET:
sexp_mark(sexp_set_var(x));
x = sexp_set_value(x);
goto loop;
case SEXP_REF:
sexp_mark(sexp_ref_name(x));
x = sexp_ref_cell(x);
goto loop;
case SEXP_SEQ:
x = sexp_seq_ls(x);
goto loop;
case SEXP_LIT:
x = sexp_lit_value(x);
goto loop;
case SEXP_CONTEXT:
sexp_mark(sexp_context_env(x));
sexp_mark(sexp_context_bc(x));
sexp_mark(sexp_context_fv(x));
sexp_mark(sexp_context_lambda(x));
sexp_mark(sexp_context_parent(x));
if (sexp_contextp(x))
for (saves=sexp_context_saves(x); saves; saves=saves->next)
if (saves->var) sexp_mark(*(saves->var));
x = sexp_context_stack(x);
t = &(sexp_types[sexp_pointer_tag(x)]);
p = (sexp*) (((char*)x) + sexp_type_field_base(t));
len_ptr = (sexp_uint_t*) (((char*)x) + sexp_type_field_len_off(t));
len = sexp_type_field_len_base(t)
+ len_ptr[0]*sexp_type_field_len_scale(t) - 1;
if (len >= 0) {
for (i=0; i<len; i++)
sexp_mark(p[i]);
x = p[len];
goto loop;
}
}
#define sexp_valid_objectp(x) ((! x) || sexp_pointerp(x) || sexp_nullp(x) || sexp_isymbolp(x) || sexp_integerp(x) || (x == SEXP_NULL) || (x == SEXP_FALSE) || (x == SEXP_TRUE) || (x == SEXP_EOF) || (x == SEXP_VOID) || (x == SEXP_UNDEF) || (x == SEXP_CLOSE) || (x == SEXP_RAWDOT) || (sexp_charp(x) && (sexp_unbox_character(x) <= 256)) || (x == SEXP_TRUE) || (x == SEXP_FALSE))
#define sexp_verify_one(x, p, t) \
do { \
if (((char*)x < sexp_heap) || ((char*)x >= sexp_heap_end)) { \
if (x && sexp_pointerp(x)) { \
fprintf(stderr, "outside heap: %p (%x) from: %p %s\n", x, sexp_pointer_tag(x), p, t); \
return; \
} \
} else if (! sexp_valid_objectp(x)) { \
fprintf(stderr, "bad object: %p from: %p %s\n", x, p, t); \
} \
} while (0)
void sexp_verify (sexp x) {
sexp *data;
sexp_sint_t i;
struct sexp_gc_var_t *saves;
sexp_verify_one(x, x, "x");
if ((! x) || (! sexp_pointerp(x)))
return;
switch (sexp_pointer_tag(x)) {
case SEXP_PAIR:
sexp_verify_one(sexp_car(x), x, "car");
sexp_verify_one(sexp_cdr(x), x, "car");
break;
case SEXP_STACK:
data = sexp_stack_data(x);
if (! sexp_stack_top(x)) break;
for (i=sexp_stack_top(x)-1; i>=0; i--)
sexp_verify_one(data[i], x, "stack");
break;
case SEXP_VECTOR:
data = sexp_vector_data(x);
if (! sexp_vector_length(x)) break;
for (i=sexp_vector_length(x)-1; i>=0; i--)
sexp_verify_one(data[i], x, "vector");
break;
case SEXP_SYMBOL:
sexp_verify_one(sexp_symbol_string(x), x, "symbol_string");
break;
case SEXP_BYTECODE:
sexp_verify_one(sexp_bytecode_literals(x), x, "bytecode_literals");
break;
case SEXP_ENV:
sexp_verify_one(sexp_env_lambda(x), x, "env_lambda");
sexp_verify_one(sexp_env_bindings(x), x, "env_bindings");
sexp_verify_one(sexp_env_parent(x), x, "env_parent");
break;
case SEXP_PROCEDURE:
sexp_verify_one(sexp_procedure_code(x), x, "procedure_code");
sexp_verify_one(sexp_procedure_vars(x), x, "procedure_vars");
break;
case SEXP_MACRO:
sexp_verify_one(sexp_macro_proc(x), x, "macro_proc");
sexp_verify_one(sexp_macro_env(x), x, "macro_env");
break;
case SEXP_SYNCLO:
sexp_verify_one(sexp_synclo_free_vars(x), x, "synclo_free_vars");
sexp_verify_one(sexp_synclo_expr(x), x, "synclo_expr");
sexp_verify_one(sexp_synclo_env(x), x, "synclo_env");
break;
case SEXP_OPCODE:
if (sexp_opcode_proc(x))
sexp_verify_one(sexp_opcode_proc(x), x, "opcode_proc");
if (sexp_opcode_default(x))
sexp_verify_one(sexp_opcode_default(x), x, "opcode_default");
break;
case SEXP_IPORT:
case SEXP_OPORT:
sexp_verify_one(sexp_port_cookie(x), x, "port_cookie");
break;
case SEXP_LAMBDA:
sexp_verify_one(sexp_lambda_name(x), x, "lambda_name");
sexp_verify_one(sexp_lambda_params(x), x, "lambda_params");
sexp_verify_one(sexp_lambda_locals(x), x, "lambda_locals");
sexp_verify_one(sexp_lambda_defs(x), x, "lambda_defs");
sexp_verify_one(sexp_lambda_flags(x), x, "lambda_flags");
sexp_verify_one(sexp_lambda_body(x), x, "lambda_body");
sexp_verify_one(sexp_lambda_fv(x), x, "lambda_fv");
sexp_verify_one(sexp_lambda_sv(x), x, "lambda_sv");
sexp_verify_one(sexp_lambda_body(x), x, "lambda_body");
break;
case SEXP_CND:
sexp_verify_one(sexp_cnd_test(x), x, "cnd_test");
sexp_verify_one(sexp_cnd_fail(x), x, "cnd_fail");
sexp_verify_one(sexp_cnd_pass(x), x, "cnd_pass");
break;
case SEXP_SET:
sexp_verify_one(sexp_set_var(x), x, "set_var");
sexp_verify_one(sexp_set_value(x), x, "set_value");
break;
case SEXP_REF:
sexp_verify_one(sexp_ref_name(x), x, "ref_name");
sexp_verify_one(sexp_ref_cell(x), x, "ref_cell");
break;
case SEXP_SEQ:
sexp_verify_one(sexp_seq_ls(x), x, "seq_ls");
break;
case SEXP_LIT:
sexp_verify_one(sexp_lit_value(x), x, "lit_value");
break;
case SEXP_CONTEXT:
sexp_verify_one(sexp_context_env(x), x, "context_env");
sexp_verify_one(sexp_context_bc(x), x, "context_bc");
sexp_verify_one(sexp_context_fv(x), x, "context_fv");
sexp_verify_one(sexp_context_lambda(x), x, "context_lambda");
sexp_verify_one(sexp_context_parent(x), x, "context_parent");
for (saves=sexp_context_saves(x); saves; saves=saves->next)
if (saves->var) sexp_verify_one(*(saves->var), x, "context_saves");
sexp_verify_one(sexp_context_stack(x), x, "context_stack");
break;
case SEXP_STRING:
case SEXP_FLONUM:
case SEXP_CORE:
break;
default:
fprintf(stderr, "verify: unknown type: %d\n", sexp_pointer_tag(x));
}
}
#define _adjust(x) if (x && (sexp_pointerp(x)) && (start <= (char*)x) && (((char*)x) <= end)) x = (sexp) (((char*)x)+offset)
void sexp_adjust_pointers (sexp x, char* start, char* end, size_t offset) {
@ -607,8 +362,6 @@ void validate_heap (sexp ctx) {
fprintf(stderr, "bare object found at %p\n", p);
} else if (sexp_pointer_tag(p) > SEXP_CONTEXT) {
fprintf(stderr, "bad type at %p: %d\n", p, sexp_pointer_tag(p));
} else {
sexp_verify(p);
}
p = (sexp) (((char*)p)+size);
}

2
opcodes.c
View file

@ -1,7 +1,7 @@
#define _OP(c,o,n,m,t,u,i,s,f,d) \
{.tag=SEXP_OPCODE, \
.value={.opcode={c, o, n, m, t, u, i, s, f, d, NULL}}}
.value={.opcode={c, o, n, m, t, u, i, s, d, f, NULL}}}
#define _FN(o,n,m,t,u,s,f,d) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, f, (sexp)d)
#define _FN0(s, f, d) _FN(OP_FCALL0, 0, 0, 0, 0, s, f, d)
#define _FN1(t, s, f, d) _FN(OP_FCALL1, 1, 0, t, 0, s, f, d)

63
sexp.c
View file

@ -53,38 +53,43 @@ sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
return res;
}
#define _TYPE(t,fb,flb,flo,fls,sb,so,sc,n) \
{.tag=SEXP_TYPE, .value={.type={t,fb,flb,flo,fls,sb,so,sc,n}}}
static struct sexp_struct sexp_types[] = {
{.tag=SEXP_TYPE, .value={.type={SEXP_OBJECT, 0, 0, 0, 0, 0, 0, 0, "object"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_TYPE, 0, 0, 0, 0, sexp_sizeof(type), 0, 0, "type"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_FIXNUM, 0, 0, 0, 0, 0, 0, 0, "fixnum"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, "char"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_BOOLEAN, 0, 0, 0, 0, 0, 0, 0, "boolean"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_PAIR, 0, 0, 0, 0, sexp_sizeof(pair), 0, 0, "pair"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_SYMBOL, 0, 0, 0, 0, sexp_sizeof(symbol), 0, 0, "symbol"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_STRING, 0, 0, 0, 0, sexp_sizeof(string)+1, offsetof(struct sexp_struct, value.string.length), 1, "string"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_VECTOR, 0, 0, 0, 0, sexp_sizeof(vector), offsetof(struct sexp_struct, value.vector.length), 4, "vector"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_FLONUM, 0, 0, 0, 0, sexp_sizeof(flonum), 0, 0, "flonum"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_BIGNUM, 0, 0, 0, 0, sexp_sizeof(bignum), offsetof(struct sexp_struct, value.bignum.length), 4, "bignum"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_IPORT, 0, 0, 0, 0, sexp_sizeof(port), 0, 0, "input-port"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_OPORT, 0, 0, 0, 0, sexp_sizeof(port), 0, 0, "output-port"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_EXCEPTION, 0, 0, 0, 0, sexp_sizeof(exception), 0, 0, "exception"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_PROCEDURE, 0, 0, 0, 0, sexp_sizeof(procedure), 0, 0, "procedure"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_MACRO, 0, 0, 0, 0, sexp_sizeof(macro), 0, 0, "macro"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_SYNCLO, 0, 0, 0, 0, sexp_sizeof(synclo), 0, 0, "syntactic-closure"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_ENV, 0, 0, 0, 0, sexp_sizeof(env), 0, 0, "environment"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_BYTECODE, 0, 0, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, "bytecode"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_CORE, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, "core-form"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_OPCODE, 0, 0, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_LAMBDA, 0, 0, 0, 0, sexp_sizeof(lambda), 0, 0, "lambda"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_CND, 0, 0, 0, 0, sexp_sizeof(cnd), 0, 0, "conditoinal"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_REF, 0, 0, 0, 0, sexp_sizeof(ref), 0, 0, "reference"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_SET, 0, 0, 0, 0, sexp_sizeof(set), 0, 0, "set!"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_SEQ, 0, 0, 0, 0, sexp_sizeof(seq), 0, 0, "sequence"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_LIT, 0, 0, 0, 0, sexp_sizeof(lit), 0, 0, "literal"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_STACK, 0, 0, 0, 0, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), 4, "stack"}}},
{.tag=SEXP_TYPE, .value={.type={SEXP_CONTEXT, 0, 0, 0, 0, sexp_sizeof(context), 0, 0, "context"}}},
_TYPE(SEXP_OBJECT, 0, 0, 0, 0, 0, 0, 0, "object"),
_TYPE(SEXP_TYPE, 0, 0, 0, 0, sexp_sizeof(type), 0, 0, "type"),
_TYPE(SEXP_FIXNUM, 0, 0, 0, 0, 0, 0, 0, "fixnum"),
_TYPE(SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, "char"),
_TYPE(SEXP_BOOLEAN, 0, 0, 0, 0, 0, 0, 0, "boolean"),
_TYPE(SEXP_PAIR, sexp_offsetof(pair, car), 2, 0, 0, sexp_sizeof(pair), 0, 0, "pair"),
_TYPE(SEXP_SYMBOL, sexp_offsetof(symbol, string), 1, 0, 0, sexp_sizeof(symbol), 0, 0, "symbol"),
_TYPE(SEXP_STRING, 0, 0, 0, 0, sexp_sizeof(string)+1, sexp_offsetof(string, length), 1, "string"),
_TYPE(SEXP_VECTOR, sexp_offsetof(vector, data), 0, sexp_offsetof(vector, length), 1, sexp_sizeof(vector), sexp_offsetof(vector, length), 4, "vector"),
_TYPE(SEXP_FLONUM, 0, 0, 0, 0, sexp_sizeof(flonum), 0, 0, "flonum"),
_TYPE(SEXP_BIGNUM, 0, 0, 0, 0, sexp_sizeof(bignum), sexp_offsetof(bignum, length), 4, "bignum"),
_TYPE(SEXP_IPORT, sexp_offsetof(port, cookie), 1, 0, 0, sexp_sizeof(port), 0, 0, "input-port"),
_TYPE(SEXP_OPORT, sexp_offsetof(port, cookie), 1, 0, 0, sexp_sizeof(port), 0, 0, "output-port"),
_TYPE(SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 0, 0, sexp_sizeof(exception), 0, 0, "exception"),
_TYPE(SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 0, 0, sexp_sizeof(procedure), 0, 0, "procedure"),
_TYPE(SEXP_MACRO, sexp_offsetof(macro, proc), 2, 0, 0, sexp_sizeof(macro), 0, 0, "macro"),
_TYPE(SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 0, 0, sexp_sizeof(synclo), 0, 0, "syntactic-closure"),
_TYPE(SEXP_ENV, sexp_offsetof(env, parent), 3, 0, 0, sexp_sizeof(env), 0, 0, "environment"),
_TYPE(SEXP_BYTECODE, sexp_offsetof(bytecode, name), 2, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, "bytecode"),
_TYPE(SEXP_CORE, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, "core-form"),
_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, dflt), 2, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode"),
_TYPE(SEXP_LAMBDA, sexp_offsetof(lambda, name), 8, 0, 0, sexp_sizeof(lambda), 0, 0, "lambda"),
_TYPE(SEXP_CND, sexp_offsetof(cnd, test), 3, 0, 0, sexp_sizeof(cnd), 0, 0, "conditoinal"),
_TYPE(SEXP_REF, sexp_offsetof(ref, name), 2, 0, 0, sexp_sizeof(ref), 0, 0, "reference"),
_TYPE(SEXP_SET, sexp_offsetof(set, var), 2, 0, 0, sexp_sizeof(set), 0, 0, "set!"),
_TYPE(SEXP_SEQ, sexp_offsetof(seq, ls), 1, 0, 0, sexp_sizeof(seq), 0, 0, "sequence"),
_TYPE(SEXP_LIT, sexp_offsetof(lit, value), 1, 0, 0, sexp_sizeof(lit), 0, 0, "literal"),
_TYPE(SEXP_STACK, sexp_offsetof(stack, data), 0, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), 4, "stack"),
_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 6, 0, 0, sexp_sizeof(context), 0, 0, "context"),
};
#undef _TYPE
#if ! USE_BOEHM
#if USE_MALLOC
void sexp_deep_free (sexp ctx, sexp obj) {

10
sexp.h
View file

@ -102,8 +102,8 @@ struct sexp_struct {
double flonum;
struct {
sexp_tag_t tag;
sexp_sint_t field_base, field_len_base, field_len_off, field_len_scale;
sexp_sint_t size_base, size_off, size_scale;
short field_base, field_len_base, field_len_off, field_len_scale;
short size_base, size_off, size_scale;
char *name;
} type;
struct {
@ -159,7 +159,7 @@ struct sexp_struct {
unsigned char op_class, code, num_args, flags,
arg1_type, arg2_type, inverse;
char *name;
sexp dflt, data, proc;
sexp data, dflt, proc;
} opcode;
struct {
char code;
@ -167,7 +167,7 @@ struct sexp_struct {
} core;
/* ast types */
struct {
sexp name, params, locals, defs, flags, body, fv, sv;
sexp name, params, locals, defs, flags, fv, sv, body;
} lambda;
struct {
sexp test, pass, fail;
@ -275,6 +275,8 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
#define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \
+ sizeof(((sexp)0)->value.x))
#define sexp_offsetof(type, f) (offsetof(struct sexp_struct, value.type.f))
#define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag)
/***************************** predicates *****************************/