diff --git a/eval.c b/eval.c index 644ee22b..b91623e5 100644 --- a/eval.c +++ b/eval.c @@ -899,9 +899,9 @@ static void generate_opcode_app (sexp ctx, sexp app) { /* maybe push the default for an optional argument */ if ((num_args == sexp_opcode_num_args(op)) && sexp_opcode_variadic_p(op) - && sexp_opcode_default(op) + && sexp_opcode_data(op) && (sexp_opcode_class(op) != OPC_PARAMETER)) { - emit_push(ctx, sexp_opcode_default(op)); + emit_push(ctx, sexp_opcode_data(op)); if (sexp_opcode_opt_param_p(op)) emit(ctx, OP_CDR); sexp_context_depth(ctx)++; @@ -945,14 +945,16 @@ static void generate_opcode_app (sexp ctx, sexp app) { emit(ctx, sexp_opcode_code(op)); break; case OPC_FOREIGN: + emit(ctx, sexp_opcode_code(op)); + emit_word(ctx, (sexp_uint_t)op); + break; case OPC_TYPE_PREDICATE: - /* push the funtion pointer for foreign calls */ emit(ctx, sexp_opcode_code(op)); if (sexp_opcode_data(op)) emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op)); break; case OPC_PARAMETER: - emit_push(ctx, sexp_opcode_default(op)); + emit_push(ctx, sexp_opcode_data(op)); emit(ctx, ((num_args == 0) ? OP_CDR : OP_SET_CDR)); break; default: @@ -1396,47 +1398,47 @@ sexp sexp_vm (sexp ctx, sexp proc) { break; case OP_FCALL0: sexp_context_top(ctx) = top; - _PUSH(((sexp_proc1)_UWORD0)(ctx)); + _PUSH(((sexp_proc1)sexp_opcode_func(_WORD0))(ctx)); ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL1: sexp_context_top(ctx) = top; - _ARG1 = ((sexp_proc2)_UWORD0)(ctx, _ARG1); + _ARG1 = ((sexp_proc2)sexp_opcode_func(_WORD0))(ctx, _ARG1); ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL2: sexp_context_top(ctx) = top; - _ARG2 = ((sexp_proc3)_UWORD0)(ctx, _ARG1, _ARG2); + _ARG2 = ((sexp_proc3)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2); top--; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL3: sexp_context_top(ctx) = top; - _ARG3 =((sexp_proc4)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3); + _ARG3 = ((sexp_proc4)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3); top -= 2; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL4: sexp_context_top(ctx) = top; - _ARG4 =((sexp_proc5)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4); + _ARG4 = ((sexp_proc5)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4); top -= 3; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL5: sexp_context_top(ctx) = top; - _ARG5 =((sexp_proc6)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5); + _ARG5 = ((sexp_proc6)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5); top -= 4; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL6: sexp_context_top(ctx) = top; - _ARG6 =((sexp_proc7)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6); + _ARG6 = ((sexp_proc7)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6); top -= 5; ip += sizeof(sexp); sexp_check_exception(); @@ -1516,7 +1518,6 @@ sexp sexp_vm (sexp ctx, sexp proc) { sexp_raise("string-set!: not a string", sexp_list1(ctx, _ARG1)); else if (sexp_immutablep(_ARG1)) sexp_raise("string-set!: immutable string", sexp_list1(ctx, _ARG1)); - fprintf(stderr, "string-set! %p (immutable: %d)\n", _ARG1, sexp_immutablep(_ARG1)); sexp_string_set(_ARG1, _ARG2, _ARG3); _ARG3 = SEXP_VOID; top-=2; @@ -1560,8 +1561,8 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG1 = sexp_make_boolean(sexp_charp(_ARG1)); break; case OP_TYPEP: _ARG1 = sexp_make_boolean(sexp_pointerp(_ARG1) - && (sexp_pointer_tag(_ARG1) - == _UWORD0)); + && (sexp_make_integer(sexp_pointer_tag(_ARG1)) + == _WORD0)); ip += sizeof(sexp); break; case OP_CAR: @@ -2185,10 +2186,10 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) { e = sexp_make_null_env(ctx, version); for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) { op = sexp_copy_opcode(ctx, &opcodes[i]); - if (sexp_opcode_opt_param_p(op) && sexp_opcode_default(op)) { - sym = sexp_intern(ctx, (char*)sexp_opcode_default(op)); + if (sexp_opcode_opt_param_p(op) && sexp_opcode_data(op)) { + sym = sexp_intern(ctx, (char*)sexp_opcode_data(op)); cell = env_cell_create(ctx, e, sym, SEXP_VOID); - sexp_opcode_default(op) = cell; + sexp_opcode_data(op) = cell; } env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op); } @@ -2211,7 +2212,7 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) { emit(ctx2, OP_LOCAL_REF); emit_word(ctx2, 0); emit(ctx2, OP_FCALL2); - emit_word(ctx2, (sexp_uint_t)sexp_opcode_data(sexp_cdr(perr_cell))); + emit_word(ctx2, (sexp_uint_t)sexp_cdr(perr_cell)); } emit_push(ctx2, SEXP_VOID); emit(ctx2, OP_DONE); diff --git a/gc.c b/gc.c index 8f9f718a..7b4262de 100644 --- a/gc.c +++ b/gc.c @@ -151,6 +151,7 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) { sexp sexp_gc (sexp ctx, size_t *sum_freed) { sexp res; int i; + fprintf(stderr, "*********************** gc **********************\n"); sexp_mark(continuation_resumer); sexp_mark(final_resumer); for (i=0; ivalue.opcode.arg2_type) #define sexp_opcode_inverse(x) ((x)->value.opcode.inverse) #define sexp_opcode_name(x) ((x)->value.opcode.name) -#define sexp_opcode_default(x) ((x)->value.opcode.dflt) #define sexp_opcode_data(x) ((x)->value.opcode.data) #define sexp_opcode_proc(x) ((x)->value.opcode.proc) +#define sexp_opcode_func(x) ((x)->value.opcode.func) #define sexp_opcode_variadic_p(x) (sexp_opcode_flags(x) & 1) #define sexp_opcode_opt_param_p(x) (sexp_opcode_flags(x) & 2) diff --git a/opcodes.c b/opcodes.c index e2a9476a..68f1627d 100644 --- a/opcodes.c +++ b/opcodes.c @@ -1,8 +1,8 @@ -#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, 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 _OP(c,o,n,m,t,u,i,s,d,f) \ + {.tag=SEXP_OPCODE, \ + .value={.opcode={c, o, n, m, t, u, i, s, d, NULL, f}}} +#define _FN(o,n,m,t,u,s,f,p) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, f, (sexp_proc0)p) #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) #define _FN2(t, u, s, f, d) _FN(OP_FCALL2, 2, 0, t, u, s, f, d) @@ -45,19 +45,19 @@ _OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL), _OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL), _OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL), _OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL), -_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", 0, NULL), -_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", 0, NULL), -_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", 0, NULL), -_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", 0, NULL), -_OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", 0, NULL), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", 0, (sexp)SEXP_PAIR), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", 0, (sexp)SEXP_STRING), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", 0, (sexp)SEXP_VECTOR), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", 0, (sexp)SEXP_FLONUM), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", 0, (sexp)SEXP_PROCEDURE), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", 0, (sexp)SEXP_OPCODE), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", 0, (sexp)SEXP_IPORT), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", 0, (sexp)SEXP_OPORT), +_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, 0), +_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0), +_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0), +_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0), +_OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_integer(SEXP_PAIR), 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_integer(SEXP_STRING), 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_integer(SEXP_VECTOR), 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_integer(SEXP_FLONUM), 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_integer(SEXP_PROCEDURE), 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_integer(SEXP_OPCODE), 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_integer(SEXP_IPORT), 0), +_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_integer(SEXP_OPORT), 0), _OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL), _OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL), _OP(OPC_GENERIC, OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL), diff --git a/opt/bignum.c b/opt/bignum.c index fe13f45a..245c15e5 100644 --- a/opt/bignum.c +++ b/opt/bignum.c @@ -418,7 +418,7 @@ enum sexp_number_types { SEXP_NUM_NOT = 0, SEXP_NUM_FIX, SEXP_NUM_FLO, - SEXP_NUM_BIG, + SEXP_NUM_BIG }; enum sexp_number_combs { @@ -437,7 +437,7 @@ enum sexp_number_combs { SEXP_NUM_BIG_NOT, SEXP_NUM_BIG_FIX, SEXP_NUM_BIG_FLO, - SEXP_NUM_BIG_BIG, + SEXP_NUM_BIG_BIG }; int sexp_number_type_lookup[SEXP_NUM_TYPES] = diff --git a/sexp.c b/sexp.c index 9be46d26..4c4342a4 100644 --- a/sexp.c +++ b/sexp.c @@ -84,7 +84,7 @@ static struct sexp_struct sexp_type_specs[] = { _DEF_TYPE(SEXP_ENV, sexp_offsetof(env, parent), 3, 0, 0, sexp_sizeof(env), 0, 0, "environment"), _DEF_TYPE(SEXP_BYTECODE, sexp_offsetof(bytecode, name), 2, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, "bytecode"), _DEF_TYPE(SEXP_CORE, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, "core-form"), - _DEF_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, dflt), 2, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode"), + _DEF_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, data), 2, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode"), _DEF_TYPE(SEXP_LAMBDA, sexp_offsetof(lambda, name), 8, 0, 0, sexp_sizeof(lambda), 0, 0, "lambda"), _DEF_TYPE(SEXP_CND, sexp_offsetof(cnd, test), 3, 0, 0, sexp_sizeof(cnd), 0, 0, "conditoinal"), _DEF_TYPE(SEXP_REF, sexp_offsetof(ref, name), 2, 0, 0, sexp_sizeof(ref), 0, 0, "reference"),