Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-14 08:27:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

replacing SEXP_OPC_ACCESSOR with separate getter & setter opcode classes

Browse source
This commit is contained in:
Alex Shinn 2010-03-16 15:19:46 +09:00
parent 9604d91440
commit 9897107d53
3 changed files with 29 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
eval.c
View file

@ -986,7 +986,8 @@ static void generate_opcode_app (sexp ctx, sexp app) {
emit_word(ctx, (sexp_uint_t)op);
break;
case SEXP_OPC_TYPE_PREDICATE:
case SEXP_OPC_ACCESSOR:
case SEXP_OPC_GETTER:
case SEXP_OPC_SETTER:
case SEXP_OPC_CONSTRUCTOR:
emit(ctx, sexp_opcode_code(op));
if ((sexp_opcode_class(op) != SEXP_OPC_CONSTRUCTOR)
@ -2421,22 +2422,26 @@ sexp sexp_make_constructor (sexp ctx, sexp name, sexp type) {
sexp_make_fixnum(type_size), NULL);
}
sexp sexp_make_accessor (sexp ctx, sexp name, sexp type, sexp index, sexp code) {
if (! sexp_fixnump(type))
return sexp_type_exception(ctx, "make-accessor: bad type", type);
sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index) {
if ((! sexp_fixnump(type)) || (sexp_unbox_fixnum(type) < 0))
return sexp_type_exception(ctx, "make-getter: bad type", type);
if ((! sexp_fixnump(index)) || (sexp_unbox_fixnum(index) < 0))
return sexp_type_exception(ctx, "make-accessor: bad index", index);
return sexp_type_exception(ctx, "make-getter: bad index", index);
return
sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_ACCESSOR), code,
sexp_make_fixnum(sexp_unbox_fixnum(code)==SEXP_OP_SLOT_REF?1:2),
SEXP_ZERO, type, SEXP_ZERO, SEXP_ZERO, type, index, NULL);
sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_GETTER),
sexp_make_fixnum(SEXP_OP_SLOT_REF), SEXP_ONE, SEXP_ZERO,
type, SEXP_ZERO, SEXP_ZERO, type, index, NULL);
}
sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index) {
return sexp_make_accessor(ctx, name, type, index, sexp_make_fixnum(SEXP_OP_SLOT_REF));
}
sexp sexp_make_setter (sexp ctx, sexp name, sexp type, sexp index) {
return sexp_make_accessor(ctx, name, type, index, sexp_make_fixnum(SEXP_OP_SLOT_SET));
if ((! sexp_fixnump(type)) || (sexp_unbox_fixnum(type) < 0))
return sexp_type_exception(ctx, "make-setter: bad type", type);
if ((! sexp_fixnump(index)) || (sexp_unbox_fixnum(index) < 0))
return sexp_type_exception(ctx, "make-setter: bad index", index);
return
sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_SETTER),
sexp_make_fixnum(SEXP_OP_SLOT_SET), SEXP_TWO, SEXP_ZERO,
type, SEXP_ZERO, SEXP_ZERO, type, index, NULL);
}
#endif

3
include/chibi/eval.h
View file

@ -40,7 +40,8 @@ enum sexp_opcode_classes {
SEXP_OPC_ARITHMETIC_CMP,
SEXP_OPC_IO,
SEXP_OPC_CONSTRUCTOR,
SEXP_OPC_ACCESSOR,
SEXP_OPC_GETTER,
SEXP_OPC_SETTER,
SEXP_OPC_PARAMETER,
SEXP_OPC_FOREIGN,
SEXP_OPC_NUM_OP_CLASSES

20
opcodes.c
View file

@ -17,16 +17,16 @@
#define _PARAM(n, a, t) _OP(SEXP_OPC_PARAMETER, SEXP_OP_NOOP, 0, 3, t, 0, 0, n, a, 0)
static struct sexp_struct opcodes[] = {
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL),
_OP(SEXP_OPC_GETTER, SEXP_OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL),
_OP(SEXP_OPC_SETTER, SEXP_OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL),
_OP(SEXP_OPC_GETTER, SEXP_OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL),
_OP(SEXP_OPC_SETTER, SEXP_OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL),
_OP(SEXP_OPC_GETTER, SEXP_OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL),
_OP(SEXP_OPC_SETTER, SEXP_OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL),
_OP(SEXP_OPC_GETTER, SEXP_OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL),
_OP(SEXP_OPC_GETTER, SEXP_OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL),
_OP(SEXP_OPC_SETTER, SEXP_OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL),
_OP(SEXP_OPC_GETTER, SEXP_OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL),