From 8dedc36609c3233504d10bd8a7d9d69a0af2d558 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sat, 3 Jan 2015 23:43:02 -0500
Subject: [PATCH] For FFI setters/getters, don't set the type field length
 which has different assumptions. Check the existence and length of the
 corresponding vector instead.

---
 tools/chibi-ffi |  2 --
 vm.c            | 18 ++++++++++++------
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/tools/chibi-ffi b/tools/chibi-ffi
index c513616c..bb146df1 100755
--- a/tools/chibi-ffi
+++ b/tools/chibi-ffi
@@ -1591,8 +1591,6 @@
       (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)))
diff --git a/vm.c b/vm.c
index 08fa331e..31fa1b88 100644
--- a/vm.c
+++ b/vm.c
@@ -1537,16 +1537,19 @@ 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))) {
+      if (sexp_unbox_fixnum(_ARG3) < 0 || sexp_unbox_fixnum(_ARG3) >= sexp_vector_length(sexp_type_getters(_ARG1)))
+        sexp_raise("slotn-ref: slot out of bounds", sexp_list2(ctx, _ARG3, sexp_make_fixnum(sexp_type_field_len_base(_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
+    } else {
+      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))));
       _ARG3 = sexp_slot_ref(_ARG2, sexp_unbox_fixnum(_ARG3));
+    }
     top-=2;
     if (!_ARG1) _ARG1 = SEXP_VOID;
     else sexp_check_exception();
@@ -1563,16 +1566,19 @@ 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))) {
+      if (sexp_unbox_fixnum(_ARG3) < 0 || sexp_unbox_fixnum(_ARG3) >= sexp_vector_length(sexp_type_setters(_ARG1)))
+        sexp_raise("slotn-set!: slot out of bounds", sexp_list2(ctx, _ARG3, sexp_make_fixnum(sexp_type_field_len_base(_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-set!: no setter defined", sexp_list1(ctx, _ARG3));
-    } else
+    } else {
+      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))));
       sexp_slot_set(_ARG2, sexp_unbox_fixnum(_ARG3), _ARG4);
+    }
     top-=4;
     sexp_check_exception();
     break;