Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-06-10 12:55:09 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding bounds checking for slot-ref/set!.

Browse source
This commit is contained in:
Alex Shinn 2014-12-14 15:16:12 +09:00
parent b6f381151a
commit ba11e996e6
2 changed files with 7 additions and 1 deletions

2
tools/chibi-ffi
View file

@ -1509,6 +1509,8 @@
(if (pair? (struct-fields type))
(let ((len (make-integer (length (struct-fields type)))))
(cat " sexp_type_slots(" (type-id-name name) ") = SEXP_NULL;\n"
" sexp_type_field_len_base(" (type-id-name name) ")"
" = " (length (struct-fields type)) ";\n"
(lambda ()
(do ((ls (reverse (struct-fields type)) (cdr ls)))
((not (pair? ls)))

6
vm.c
View file

@ -1537,6 +1537,8 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
if (sexp_car(tmp1) == _ARG3) { _ARG3 = sexp_make_fixnum(i); break; }
if (! sexp_fixnump(_ARG3))
sexp_raise("slotn-ref: not an integer", sexp_list1(ctx, _ARG3));
if (sexp_unbox_fixnum(_ARG3) < 0 || sexp_unbox_fixnum(_ARG3) >= sexp_type_field_len_base(_ARG1))
sexp_raise("slotn-ref: slot out of bounds", sexp_list2(ctx, _ARG3, sexp_make_fixnum(sexp_type_field_len_base(_ARG1))));
if (sexp_vectorp(sexp_type_getters(_ARG1))) {
tmp1 = sexp_vector_ref(sexp_type_getters(_ARG1), _ARG3);
if (sexp_opcodep(tmp1))
@ -1561,12 +1563,14 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
if (sexp_car(tmp1) == _ARG3) { _ARG3 = sexp_make_fixnum(i); break; }
if (! sexp_fixnump(_ARG3))
sexp_raise("slotn-set!: not an integer", sexp_list1(ctx, _ARG3));
if (sexp_unbox_fixnum(_ARG3) < 0 || sexp_unbox_fixnum(_ARG3) >= sexp_type_field_len_base(_ARG1))
sexp_raise("slotn-set!: slot out of bounds", sexp_list2(ctx, _ARG3, sexp_make_fixnum(sexp_type_field_len_base(_ARG1))));
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));
sexp_raise("slotn-set!: no setter defined", sexp_list1(ctx, _ARG3));
} else
sexp_slot_set(_ARG2, sexp_unbox_fixnum(_ARG3), _ARG4);
top-=4;