Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-03 11:16:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

slot-ref/slot-set! respect FFI getters and setters.

Browse source
This commit is contained in:
Alex Shinn 2014-12-13 16:11:19 +09:00
parent b7265fcc49
commit b6f381151a
1 changed files with 18 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
vm.c
View file

@ -1537,9 +1537,17 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
if (sexp_car(tmp1) == _ARG3) { _ARG3 = sexp_make_fixnum(i); break; } if (sexp_car(tmp1) == _ARG3) { _ARG3 = sexp_make_fixnum(i); break; }
if (! sexp_fixnump(_ARG3)) if (! sexp_fixnump(_ARG3))
sexp_raise("slotn-ref: not an integer", sexp_list1(ctx, _ARG3)); sexp_raise("slotn-ref: not an integer", sexp_list1(ctx, _ARG3));
_ARG3 = sexp_slot_ref(_ARG2, sexp_unbox_fixnum(_ARG3)); if (sexp_vectorp(sexp_type_getters(_ARG1))) {
tmp1 = sexp_vector_ref(sexp_type_getters(_ARG1), _ARG3);
if (sexp_opcodep(tmp1))
_ARG3 = ((sexp_proc2)sexp_opcode_func(tmp1))(ctx, tmp1, 1, _ARG2);
else
sexp_raise("slotn-ref: no getter defined", sexp_list1(ctx, _ARG3));
} else
_ARG3 = sexp_slot_ref(_ARG2, sexp_unbox_fixnum(_ARG3));
top-=2; top-=2;
if (!_ARG1) _ARG1 = SEXP_VOID; if (!_ARG1) _ARG1 = SEXP_VOID;
else sexp_check_exception();
break; break;
case SEXP_OP_SLOTN_SET: case SEXP_OP_SLOTN_SET:
if (! sexp_typep(_ARG1)) if (! sexp_typep(_ARG1))
@ -1553,8 +1561,16 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
if (sexp_car(tmp1) == _ARG3) { _ARG3 = sexp_make_fixnum(i); break; } if (sexp_car(tmp1) == _ARG3) { _ARG3 = sexp_make_fixnum(i); break; }
if (! sexp_fixnump(_ARG3)) if (! sexp_fixnump(_ARG3))
sexp_raise("slotn-set!: not an integer", sexp_list1(ctx, _ARG3)); sexp_raise("slotn-set!: not an integer", sexp_list1(ctx, _ARG3));
sexp_slot_set(_ARG2, sexp_unbox_fixnum(_ARG3), _ARG4); if (sexp_vectorp(sexp_type_setters(_ARG1))) {
tmp1 = sexp_vector_ref(sexp_type_setters(_ARG1), _ARG3);
if (sexp_opcodep(tmp1))
_ARG4 = ((sexp_proc3)sexp_opcode_func(tmp1))(ctx, tmp1, 2, _ARG2, _ARG4);
else
sexp_raise("slotn-ref: no setter defined", sexp_list1(ctx, _ARG3));
} else
sexp_slot_set(_ARG2, sexp_unbox_fixnum(_ARG3), _ARG4);
top-=4; top-=4;
sexp_check_exception();
break; break;
case SEXP_OP_CAR: case SEXP_OP_CAR:
if (! sexp_pairp(_ARG1)) if (! sexp_pairp(_ARG1))