Prevent stack overflow in sexp_mark_one (issue #601)

Replace explicit recursion by heap allocations
in sexp_mark_one code.
This prevents crashes caused by stack overflow.
In particular, fixes issue #601.

As an optimization, allocate a fixed sized stack buffer first,
which should be enough for "normal" uses.
When that stack overflows, switch to heap.

Also, store "ranges" on the stack, instead of the actual sexp's,
using the fact that sexp's of a single parent are continous in memory.

This patch doesn't remove recursion on the context saves
because it didn't seem like they overflow in practice.
But changing that is simple having the stack interface.

gc.c

@@ -225,7 +225,35 @@ int sexp_valid_object_p (sexp ctx, sexp x) {
 #define sexp_gc_pass_ctx(x)
 #endif
 
-void sexp_mark_one (sexp_gc_pass_ctx(sexp ctx) sexp* types, sexp x) {
+static void sexp_mark_stack_push (sexp ctx, sexp *start, sexp *end) {
+  struct sexp_mark_stack_ptr_t *stack = sexp_context_mark_stack(ctx);
+  struct sexp_mark_stack_ptr_t **ptr = &sexp_context_mark_stack_ptr(ctx);
+  struct sexp_mark_stack_ptr_t *old = *ptr;
+
+  if (old == NULL) {
+    *ptr = stack;
+  } else if (old >= stack && old + 1 < stack + SEXP_MARK_STACK_COUNT) {
+    (*ptr)++;
+  } else {
+    *ptr = malloc(sizeof(**ptr));
+  }
+
+  (*ptr)->start = start;
+  (*ptr)->end = end;
+  (*ptr)->prev = old;
+}
+
+static void sexp_mark_stack_pop (sexp ctx) {
+  struct sexp_mark_stack_ptr_t *stack = sexp_context_mark_stack(ctx);
+  struct sexp_mark_stack_ptr_t *old = sexp_context_mark_stack_ptr(ctx);
+
+  sexp_context_mark_stack_ptr(ctx) = old->prev;
+  if (!(old >= stack && old < stack + SEXP_MARK_STACK_COUNT)) {
+    free(old);
+  }
+}
+
+static void sexp_mark_one (sexp ctx, sexp* types, sexp x) {
   sexp_sint_t len;
   sexp t, *p, *q;
   struct sexp_gc_var_t *saves;
@@ -235,7 +263,7 @@ void sexp_mark_one (sexp_gc_pass_ctx(sexp ctx) sexp* types, sexp x) {
   sexp_markedp(x) = 1;
   if (sexp_contextp(x)) {
     for (saves=sexp_context_saves(x); saves; saves=saves->next)
-      if (saves->var) sexp_mark_one(sexp_gc_pass_ctx(ctx) types, *(saves->var));
+      if (saves->var) sexp_mark_one(ctx, types, *(saves->var));
   }
   t = types[sexp_pointer_tag(x)];
   len = sexp_type_num_slots_of_object(t, x) - 1;
@@ -246,15 +274,31 @@ void sexp_mark_one (sexp_gc_pass_ctx(sexp ctx) sexp* types, sexp x) {
       q--;                      /* skip trailing immediates */
     while (p < q && *q == q[-1])
       q--;                      /* skip trailing duplicates */
-    while (p < q)
+    if (p < q) {
-      sexp_mark_one(sexp_gc_pass_ctx(ctx) types, *p++);
+      sexp_mark_stack_push(ctx, p, q);
-    x = *p;
+    }
+    x = *q;
     goto loop;
   }
 }
 
+static void sexp_mark_one_start (sexp ctx, sexp* types, sexp x) {
+  struct sexp_mark_stack_ptr_t **ptr = &sexp_context_mark_stack_ptr(ctx);
+  sexp *p, *q;
+  sexp_mark_one(ctx, types, x);
+
+  while (*ptr) {
+    p = (*ptr)->start;
+    q = (*ptr)->end;
+    sexp_mark_stack_pop(ctx);
+    while (p < q) {
+      sexp_mark_one(ctx, types, *p++);
+    }
+  }
+}
+
 void sexp_mark (sexp ctx, sexp x) {
-  sexp_mark_one(sexp_gc_pass_ctx(ctx) sexp_vector_data(sexp_global(ctx, SEXP_G_TYPES)), x);
+  sexp_mark_one_start(ctx, sexp_vector_data(sexp_global(ctx, SEXP_G_TYPES)), x);
 }
 
 #if SEXP_USE_CONSERVATIVE_GC

include/chibi/features.h

@@ -278,6 +278,10 @@
 #define SEXP_GROW_HEAP_FACTOR 2  /* 1.6180339887498948482 */
 #endif
 
+/* size of per-context stack that is used during gc cycles
+ * increase if you can affort extra unused memory */
+#define SEXP_MARK_STACK_COUNT 1024
+
 /* the default number of opcodes to run each thread for */
 #ifndef SEXP_DEFAULT_QUANTUM
 #define SEXP_DEFAULT_QUANTUM 500

include/chibi/sexp.h

@@ -393,6 +393,11 @@ struct sexp_core_form_struct {
   sexp name;
 };
 
+struct sexp_mark_stack_ptr_t {
+  sexp *start, *end;
+  struct sexp_mark_stack_ptr_t *prev; /* TODO: remove for allocations on stack */
+};
+
 struct sexp_struct {
   sexp_tag_t tag;
   char markedp;
@@ -538,6 +543,8 @@ struct sexp_struct {
     } stack;
     struct {
       sexp_heap heap;
+      struct sexp_mark_stack_ptr_t mark_stack[SEXP_MARK_STACK_COUNT];
+      struct sexp_mark_stack_ptr_t *mark_stack_ptr;
       struct sexp_gc_var_t *saves;
 #if SEXP_USE_GREEN_THREADS
       sexp_sint_t refuel;
@@ -1305,6 +1312,8 @@ enum sexp_uniform_vector_type {
 #define sexp_context_stack(x)    (sexp_field(x, context, SEXP_CONTEXT, stack))
 #define sexp_context_parent(x)   (sexp_field(x, context, SEXP_CONTEXT, parent))
 #define sexp_context_child(x)    (sexp_field(x, context, SEXP_CONTEXT, child))
+#define sexp_context_mark_stack(x)     (sexp_field(x, context, SEXP_CONTEXT, mark_stack))
+#define sexp_context_mark_stack_ptr(x) (sexp_field(x, context, SEXP_CONTEXT, mark_stack_ptr))
 #define sexp_context_saves(x)    (sexp_field(x, context, SEXP_CONTEXT, saves))
 #define sexp_context_tailp(x)    (sexp_field(x, context, SEXP_CONTEXT, tailp))
 #define sexp_context_tracep(x)   (sexp_field(x, context, SEXP_CONTEXT, tracep))

sexp.c

@@ -611,6 +611,7 @@ sexp sexp_bootstrap_context (sexp_uint_t size, sexp_uint_t max_size) {
   heap = sexp_make_heap(size, max_size, 0);
   if (!heap) return 0;
   sexp_pointer_tag(&dummy_ctx) = SEXP_CONTEXT;
+  sexp_context_mark_stack_ptr(&dummy_ctx) = NULL;
   sexp_context_saves(&dummy_ctx) = NULL;
   sexp_context_heap(&dummy_ctx) = heap;
   ctx = sexp_alloc_type(&dummy_ctx, context, SEXP_CONTEXT);
@@ -653,6 +654,7 @@ sexp sexp_make_context (sexp ctx, size_t size, size_t max_size) {
   if (!res || sexp_exceptionp(res)) return res;
   sexp_context_parent(res) = ctx;
   sexp_context_name(res) = sexp_context_specific(res) = SEXP_FALSE;
+  sexp_context_mark_stack_ptr(res) = NULL;
   sexp_context_saves(res) = NULL;
   sexp_context_params(res) = SEXP_NULL;
   sexp_context_last_fp(res) = 0;