New: stack overflow protection.

* configure: detect getrlimit, producing HAVE_RLIMIT in
config.h.

* eval.c (do_eval, do_expand): Call gc_stack_check inline
function to check stack pointer against limit.

* gc.c (gc_stack_bottom): Static becomes extern, so inline
function in gc.h can refer to it.
(gc_stack_limit): New global variable.
(gc_init): If we have rlimit, then probe RLIMIT_STACK.
If the stack is sufficiently large, then enable the stack
overflow protection, which kicks in when the stack pointer
appears to be within a certain percentage of the limit.
(set_stack_limit, get_stack_limit): New static functions.
(gc_late_init): Register set-stack-limit and get-stack-limit
intrinsics.
(gc_stack_overflow): New function.

* gc.h (gc_stack_bottom, gc_stack_limit, gc_stack_overflow):
Declared.
(gc_stack_check): New inline function.

* lib.c (stack_overflow_s): New symbol variable.
(obj_print_impl): Call gc_stack_check to protect recursive
printing againts overflow.

* lib.h (stack_overflow_s): Declared.

* unwind.c (uw_init): Register stack-overflow symbol as a an
exception symbol subtyped from error.
(uw_unwind_to_exit_point): When dealing with an unhandled
exception, turn off the stack limit, so we can print the
messages without triggering it in a loop.

* vm.c (vm_execute_closure, vm_funcall_common): Insert
gc_stack_check to the top of the execution of every VM
function.

* txr.1: Documented.

* share/txr/stdlib/doc-syms.tl: Updated.

1 files changed, 43 insertions, 1 deletions

diff --git a/gc.c b/gc.c
index 974cefde..4b7c0a8c 100644
--- a/gc.c
+++ b/gc.c
@@ -36,6 +36,9 @@
 #if HAVE_VALGRIND
 #include <valgrind/memcheck.h>
 #endif
+#if HAVE_RLIMIT
+#include <sys/resource.h>
+#endif
 #include "lib.h"
 #include "stream.h"
 #include "hash.h"
@@ -84,7 +87,9 @@ int opt_gc_debug;
 #if HAVE_VALGRIND
 int opt_vg_debug;
 #endif
-static val *gc_stack_bottom;
+
+val *gc_stack_bottom;
+val *gc_stack_limit;
 
 static val *prot_stack[PROT_STACK_SIZE];
 static val **prot_stack_limit = prot_stack + PROT_STACK_SIZE;
@@ -888,6 +893,15 @@ int gc_inprogress(void)
 void gc_init(val *stack_bottom)
 {
   gc_stack_bottom = stack_bottom;
+#if HAVE_RLIMIT
+  struct rlimit rl;
+  if (getrlimit(RLIMIT_STACK, &rl) == 0) {
+    if (rl.rlim_cur > 512 * 1024) {
+      rlim_t lim = (rl.rlim_cur - rl.rlim_cur / 16) / sizeof (val);
+      gc_stack_limit = gc_stack_bottom - lim;
+    }
+  }
+#endif
 }
 
 void gc_mark(val obj)
@@ -970,6 +984,27 @@ static val gc_set_delta(val delta)
   return nil;
 }
 
+static val set_stack_limit(val limit)
+{
+  val self = lit("set-stack-limit");
+  val *gsl = gc_stack_limit;
+
+  if (limit == nil || limit == zero) {
+    gc_stack_limit = 0;
+  } else {
+    ucnum lim = c_unum(limit, self);
+    gc_stack_limit = gc_stack_bottom - lim / sizeof (val);
+  }
+
+  return if2(gsl, num((gc_stack_bottom - gsl) * sizeof (val)));
+}
+
+static val get_stack_limit(void)
+{
+  val *gsl = gc_stack_limit;
+  return if2(gsl, num((gc_stack_bottom - gsl) * sizeof (val)));
+}
+
 static val gc_wrap(val full)
 {
   if (gc_enabled) {
@@ -1051,6 +1086,8 @@ void gc_late_init(void)
   reg_fun(intern(lit("finalize"), user_package), func_n3o(gc_finalize, 2));
   reg_fun(intern(lit("call-finalizers"), user_package),
           func_n1(gc_call_finalizers));
+  reg_fun(intern(lit("set-stack-limit"), user_package), func_n1(set_stack_limit));
+  reg_fun(intern(lit("get-stack-limit"), user_package), func_n0(get_stack_limit));
 }
 
 /*
@@ -1161,3 +1198,8 @@ void gc_free_all(void)
     }
   }
 }
+
+void gc_stack_overflow(void)
+{
+  uw_throwf(stack_overflow_s, lit("computation exceeded stack limit"), nao);
+}