From c725c48f74bb9cccffebe70994f6991cf01ce07c Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 15 Jun 2009 17:34:26 +0900 Subject: [PATCH] switching to data-driven sexp_mark --- Makefile | 5 +- VERSION | 2 +- gc.c | 273 +++--------------------------------------------------- opcodes.c | 2 +- sexp.c | 63 +++++++------ sexp.h | 10 +- 6 files changed, 56 insertions(+), 299 deletions(-) diff --git a/Makefile b/Makefile index 32b994e6..cc7450df 100644 --- a/Makefile +++ b/Makefile @@ -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: diff --git a/VERSION b/VERSION index 49d59571..3b04cfb6 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.1 +0.2 diff --git a/gc.c b/gc.c index 66a3730c..3ab32086 100644 --- a/gc.c +++ b/gc.c @@ -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= 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); } diff --git a/opcodes.c b/opcodes.c index 0aee670c..33371854 100644 --- a/opcodes.c +++ b/opcodes.c @@ -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) diff --git a/sexp.c b/sexp.c index 72f5e503..cc4244d9 100644 --- a/sexp.c +++ b/sexp.c @@ -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) { diff --git a/sexp.h b/sexp.h index fc25b43e..620f860c 100644 --- a/sexp.h +++ b/sexp.h @@ -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 *****************************/