From 5013c0fdcb7bf58f26ecdd05557923815d717598 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 24 Jun 2012 14:36:45 -0700 Subject: [PATCH] moving pair-source and pair-source-set! into the core --- lib/chibi/ast.c | 1 - lib/chibi/ast.sld | 1 - opcodes.c | 22 +++++++++++++++------- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index a3520681..37aedeec 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -418,7 +418,6 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char sexp_define_type_predicate(ctx, env, "type?", SEXP_TYPE); sexp_define_type_predicate(ctx, env, "context?", SEXP_CONTEXT); sexp_define_type_predicate(ctx, env, "exception?", SEXP_EXCEPTION); - sexp_define_accessors(ctx, env, SEXP_PAIR, 2, "pair-source", "pair-source-set!"); sexp_define_accessors(ctx, env, SEXP_SYNCLO, 0, "syntactic-closure-env", NULL); sexp_define_accessors(ctx, env, SEXP_SYNCLO, 1, "syntactic-closure-vars", NULL); sexp_define_accessors(ctx, env, SEXP_SYNCLO, 2, "syntactic-closure-expr", NULL); diff --git a/lib/chibi/ast.sld b/lib/chibi/ast.sld index 2124e9a8..0e524ec3 100644 --- a/lib/chibi/ast.sld +++ b/lib/chibi/ast.sld @@ -28,7 +28,6 @@ macro-procedure macro-env macro-source procedure-code procedure-vars procedure-name procedure-name-set! bytecode-name bytecode-literals bytecode-source - pair-source pair-source-set! port-line port-line-set! environment-parent type-name type-cpl type-parent type-slots type-num-slots type-printer diff --git a/opcodes.c b/opcodes.c index 85236e7e..d6b6e848 100644 --- a/opcodes.c +++ b/opcodes.c @@ -2,12 +2,24 @@ #include "chibi/eval.h" #define _I(n) sexp_make_fixnum(n) -#define _OP(c,o,n,m,rt,a1,a2,a3,i,s,d,f) {c, o, n, m, i, (sexp)s, d, NULL, NULL, rt, a1, a2, a3, NULL, NULL, SEXP_FALSE, f} + +#define _OP(c,o,n,m,rt,a1,a2,a3,i,s,d,f) \ + {c, o, n, m, i, (sexp)s, d, NULL, NULL, rt, a1, a2, a3, NULL, NULL, SEXP_FALSE, f} + +#define _GETTER(name, type, index) \ + {SEXP_OPC_GETTER, SEXP_OP_SLOT_REF, 1, 0, 0, (sexp)name, _I(type), _I(index), NULL, _I(SEXP_OBJECT), _I(type), NULL, NULL, NULL, NULL, SEXP_FALSE, NULL} +#define _SETTER(name, type, index) \ + {SEXP_OPC_SETTER, SEXP_OP_SLOT_SET, 2, 0, 0, (sexp)name, _I(type), _I(index), NULL, SEXP_VOID, _I(type), _I(SEXP_OBJECT), NULL, NULL, NULL, SEXP_FALSE, NULL} + +#define _PARAM(n, t) \ + _OP(SEXP_OPC_PARAMETER, SEXP_OP_PARAMETER_REF, 0, 1, t, t, SEXP_FALSE, SEXP_FALSE, 0, n, SEXP_FALSE, 0) + #if SEXP_USE_IMAGE_LOADING #define _FN(o,n,m,rt,a1,a2,a3,s,d,f) {SEXP_OPC_FOREIGN, o, n, m, 0, (sexp)s, d, (sexp)#f, NULL, rt, a1, a2, a3, NULL, NULL, SEXP_FALSE, (sexp_proc1)f} #else #define _FN(o,n,m,rt,a1,a2,a3,s,d,f) _OP(SEXP_OPC_FOREIGN, o, n, m, rt, a1, a2, a3, 0, s, d, (sexp_proc1)f) #endif + #define _FN0(rt, s, d, f) _FN(SEXP_OP_FCALL0, 0, 0, rt, SEXP_FALSE, SEXP_FALSE, SEXP_FALSE, s, d, f) #define _FN1(rt, a1, s, d, f) _FN(SEXP_OP_FCALL1, 1, 0, rt, a1, SEXP_FALSE, SEXP_FALSE, s, d, f) #define _FN1OPT(rt, a1, s, d, f) _FN(SEXP_OP_FCALL1, 0, 1, rt, a1, SEXP_FALSE, SEXP_FALSE, s, d, f) @@ -19,7 +31,6 @@ #define _FN3OPT(rt, a1, a2, a3, s, d, f) _FN(SEXP_OP_FCALL3, 2, 1, rt, a1, a2, a3, s, d, f) #define _FN4(rt, a1, a2, a3, s, d, f) _FN(SEXP_OP_FCALL4, 4, 0, rt, a1, a2, a3, s, d, f) #define _FN5(rt, a1, a2, a3, s, d, f) _FN(SEXP_OP_FCALLN, 5, 0, rt, a1, a2, a3, s, d, f) -#define _PARAM(n, t) _OP(SEXP_OPC_PARAMETER, SEXP_OP_PARAMETER_REF, 0, 1, t, t, SEXP_FALSE, SEXP_FALSE, 0, n, SEXP_FALSE, 0) static struct sexp_opcode_struct opcodes[] = { _PARAM("current-input-port", _I(SEXP_IPORT)), @@ -32,6 +43,8 @@ _OP(SEXP_OPC_GETTER, SEXP_OP_CAR, 1, 0, _I(SEXP_OBJECT), _I(SEXP_PAIR), SEXP_FAL _OP(SEXP_OPC_SETTER, SEXP_OP_SET_CAR, 2, 0, SEXP_VOID, _I(SEXP_PAIR), _I(SEXP_OBJECT), SEXP_FALSE, 0, "set-car!", 0, NULL), _OP(SEXP_OPC_GETTER, SEXP_OP_CDR, 1, 0, _I(SEXP_OBJECT), _I(SEXP_PAIR), SEXP_FALSE, SEXP_FALSE, 0, "cdr", 0, NULL), _OP(SEXP_OPC_SETTER, SEXP_OP_SET_CDR, 2, 0, SEXP_VOID, _I(SEXP_PAIR), _I(SEXP_OBJECT), SEXP_FALSE, 0, "set-cdr!", 0, NULL), +_GETTER("pair-source", SEXP_PAIR, 2), +_SETTER("pair-source-set!", SEXP_PAIR, 2), _OP(SEXP_OPC_GETTER, SEXP_OP_VECTOR_REF, 2, 0, _I(SEXP_OBJECT), _I(SEXP_VECTOR), _I(SEXP_FIXNUM), SEXP_FALSE, 0,"vector-ref", 0, NULL), _OP(SEXP_OPC_SETTER, SEXP_OP_VECTOR_SET, 3, 0, SEXP_VOID, _I(SEXP_VECTOR), _I(SEXP_FIXNUM), _I(SEXP_OBJECT), 0,"vector-set!", 0, NULL), _OP(SEXP_OPC_GETTER, SEXP_OP_VECTOR_LENGTH, 1, 0, _I(SEXP_FIXNUM), _I(SEXP_VECTOR), SEXP_FALSE, SEXP_FALSE, 0,"vector-length", 0, NULL), @@ -250,8 +263,3 @@ _OP(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), }; struct sexp_opcode_struct* sexp_primitive_opcodes = opcodes; - -#undef _I -#undef _OP -#undef _FN -#undef _PARAM