Handle C stack overflow caused by too nested Lisp evaluation.

* configure.ac: Check for sigaltstack and related sigaction
support.  Unconditionally check for sigsetjmp and siglongjmp.
(HAVE_STACK_OVERFLOW_HANDLING): Define if we can support it.
* src/lisp.h (toplevel) [HAVE_STACK_OVERFLOW_HANDLING]: Declare
siglongjmp point to transfer control from SIGSEGV handler.
* src/keyboard.c (return_to_command_loop, recover_top_level_message)
[HAVE_STACK_OVERFLOW_HANDLING]: New variables.
(regular_top_level_message): New variable.
(command_loop) [HAVE_STACK_OVERFLOW_HANDLING]: Handle non-local
exit from SIGSEGV handler and adjust message displayed by Vtop_level
if appropriate.
(syms_of_keyboard): DEFVAR Vtop_level_message and initialize
new variables described above.
* src/sysdep.c [HAVE_SYS_RESOURCE_H]: Include sys/resource.h as such.
(stack_grows_down, sigsegv_stack, handle_sigsegv)
[HAVE_STACK_OVERFLOW_HANDLING]: New variables and function.
(init_sigsegv): New function.
(init_signals): Use it.
* lisp/startup.el (normal-top-level): Use top-level-message.

8 files changed, 179 insertions, 19 deletions

diff --git a/ChangeLog b/ChangeLog
index de9f3a0bef4..67fc0b87bcb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2014-08-26  Dmitry Antipov  <dmantipov@yandex.ru>
+
+        Detect features needed to handle C stack overflows.
+        * configure.ac: Check for sigaltstack and related sigaction
+        support.  Unconditionally check for sigsetjmp and siglongjmp.
+        (HAVE_STACK_OVERFLOW_HANDLING): Define if we can support it.
+
 2014-08-25  Ken Brown  <kbrown@cornell.edu>
 
         * configure.ac (G_SLICE_ALWAYS_MALLOC): Remove obsolete macro.
diff --git a/configure.ac b/configure.ac
index 967f0195d0f..d6476d2e1c7 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3728,6 +3728,22 @@ if test "$emacs_cv_have_timerfd" = yes; then
     [Define to 1 if timerfd functions are supported as in GNU/Linux.])
 fi
 
+# Alternate stack for signal handlers.
+AC_CACHE_CHECK([whether signals can be handled on alternate stack],
+               [emacs_cv_alternate_stack],
+  [AC_COMPILE_IFELSE(
+     [AC_LANG_PROGRAM([[#include <signal.h>
+                      ]],
+                      [[stack_t ss;
+                        struct sigaction sa;
+                        ss.ss_sp = malloc (SIGSTKSZ);
+                        ss.ss_size = SIGSTKSZ;
+                        sa.sa_flags = SA_SIGINFO | SA_ONSTACK;
+                        sigaltstack (&ss, 0);
+                        sigaction (SIGSEGV, &sa, 0);]])],
+     [emacs_cv_alternate_stack=yes],
+     [emacs_cv_alternate_stack=no])])
+
 # Do we have res_init, for detecting changes in /etc/resolv.conf?
 # On Darwin, res_init appears not to be useful: see bug#562 and
 # http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html
@@ -4447,22 +4463,31 @@ AC_CACHE_CHECK([for _setjmp], [emacs_cv_func__setjmp],
      [emacs_cv_func__setjmp=no])])
 if test $emacs_cv_func__setjmp = yes; then
   AC_DEFINE([HAVE__SETJMP], 1, [Define to 1 if _setjmp and _longjmp work.])
-else
-  AC_CACHE_CHECK([for sigsetjmp], [emacs_cv_func_sigsetjmp],
-    [AC_LINK_IFELSE(
-       [AC_LANG_PROGRAM(
-         [[#include <setjmp.h>
-         ]],
-         [[sigjmp_buf j;
-           if (! sigsetjmp (j, 1))
-             siglongjmp (j, 1);]])],
-       [emacs_cv_func_sigsetjmp=yes],
-       [emacs_cv_func_sigsetjmp=no])])
-  if test $emacs_cv_func_sigsetjmp = yes; then
-    AC_DEFINE([HAVE_SIGSETJMP], 1,
-      [Define to 1 if sigsetjmp and siglongjmp work.
-       The value of this symbol is irrelevant if HAVE__SETJMP is defined.])
-  fi
+fi
+
+# We need to preserve signal mask to handle C stack overflows.
+AC_CACHE_CHECK([for sigsetjmp], [emacs_cv_func_sigsetjmp],
+  [AC_LINK_IFELSE(
+     [AC_LANG_PROGRAM(
+       [[#include <setjmp.h>
+       ]],
+       [[sigjmp_buf j;
+         if (! sigsetjmp (j, 1))
+           siglongjmp (j, 1);]])],
+     [emacs_cv_func_sigsetjmp=yes],
+     [emacs_cv_func_sigsetjmp=no])])
+if test $emacs_cv_func_sigsetjmp = yes; then
+  AC_DEFINE([HAVE_SIGSETJMP], 1,
+    [Define to 1 if sigsetjmp and siglongjmp work.])
+fi
+
+# We need all of these features to handle C stack overflows.
+if test "$ac_cv_header_sys_resource_h" = "yes" -a \
+        "$ac_cv_func_getrlimit" = "yes" -a \
+        "$emacs_cv_func_sigsetjmp" = "yes" -a \
+        "$emacs_cv_alternate_stack" = yes; then
+  AC_DEFINE([HAVE_STACK_OVERFLOW_HANDLING], 1,
+    [Define to 1 if C stack overflow can be handled in some cases.])
 fi
 
 case $opsys in
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 65a59f4da6d..12d283e7120 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2014-08-26  Dmitry Antipov  <dmantipov@yandex.ru>
+
+        * startup.el (normal-top-level): Use top-level-message.
+
 2014-08-25  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
         * net/shr.el (shr-copy-url): Encode copied URL to avoid getting
diff --git a/lisp/startup.el b/lisp/startup.el
index 144d732272f..1d5ae250505 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -497,7 +497,7 @@ It sets `command-line-processed', processes the command-line,
 reads the initialization files, etc.
 It is the default value of the variable `top-level'."
   (if command-line-processed
-      (message "Back to top level.")
+      (message top-level-message)
     (setq command-line-processed t)
 
     ;; Look in each dir in load-path for a subdirs.el file.  If we
diff --git a/src/ChangeLog b/src/ChangeLog
index 391d2e52100..f618ba02448 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,22 @@
+2014-08-26  Dmitry Antipov  <dmantipov@yandex.ru>
+
+        Handle C stack overflow caused by too nested Lisp evaluation.
+        * lisp.h (toplevel) [HAVE_STACK_OVERFLOW_HANDLING]: Declare
+        siglongjmp point to transfer control from SIGSEGV handler.
+        * keyboard.c (return_to_command_loop, recover_top_level_message)
+        [HAVE_STACK_OVERFLOW_HANDLING]: New variables.
+        (regular_top_level_message): New variable.
+        (command_loop) [HAVE_STACK_OVERFLOW_HANDLING]: Handle non-local
+        exit from SIGSEGV handler and adjust message displayed by Vtop_level
+        if appropriate.
+        (syms_of_keyboard): DEFVAR Vtop_level_message and initialize
+        new variables described above.
+        * sysdep.c [HAVE_SYS_RESOURCE_H]: Include sys/resource.h as such.
+        (stack_grows_down, sigsegv_stack, handle_sigsegv)
+        [HAVE_STACK_OVERFLOW_HANDLING]: New variables and function.
+        (init_sigsegv): New function.
+        (init_signals): Use it.
+
 2014-08-25  Ken Brown  <kbrown@cornell.edu>
 
         * emacs.c (main): Remove use of obsolete macro
diff --git a/src/keyboard.c b/src/keyboard.c
index 9b0b19ada2f..ed00b38a7db 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -133,6 +133,19 @@ static ptrdiff_t this_single_command_key_start;
 static ptrdiff_t before_command_key_count;
 static ptrdiff_t before_command_echo_length;
 
+#ifdef HAVE_STACK_OVERFLOW_HANDLING
+
+/* For longjmp to recover from C stack overflow.  */
+sigjmp_buf return_to_command_loop;
+
+/* Message displayed by Vtop_level when recovering from C stack overflow.  */
+static Lisp_Object recover_top_level_message;
+
+#endif /* HAVE_STACK_OVERFLOW_HANDLING */
+
+/* Message normally displayed by Vtop_level.  */
+static Lisp_Object regular_top_level_message;
+
 /* For longjmp to where kbd input is being done.  */
 
 static sys_jmp_buf getcjmp;
@@ -1134,6 +1147,17 @@ static Lisp_Object top_level_1 (Lisp_Object);
 Lisp_Object
 command_loop (void)
 {
+#ifdef HAVE_STACK_OVERFLOW_HANDLING  
+  /* At least on GNU/Linux, saving signal mask is important here.  */
+  if (sigsetjmp (return_to_command_loop, 1) != 0)
+    {
+      /* Comes here from handle_sigsegv, see sysdep.c.  */
+      init_eval ();
+      Vtop_level_message = recover_top_level_message;
+    }
+  else
+    Vtop_level_message = regular_top_level_message;
+#endif /* HAVE_STACK_OVERFLOW_HANDLING */
   if (command_loop_level > 0 || minibuf_level > 0)
     {
       Lisp_Object val;
@@ -11000,6 +11024,15 @@ syms_of_keyboard (void)
   Vlispy_mouse_stem = build_pure_c_string ("mouse");
   staticpro (&Vlispy_mouse_stem);
 
+  regular_top_level_message = build_pure_c_string ("Back to top level");
+#ifdef HAVE_STACK_OVERFLOW_HANDLING
+  recover_top_level_message
+    = build_pure_c_string ("Re-entering top level after C stack overflow");
+#endif  
+  DEFVAR_LISP ("top-level-message", Vtop_level_message,
+               doc: /* Message displayed by `normal-top-level'.  */);
+  Vtop_level_message = regular_top_level_message;
+
   /* Tool-bars.  */
   DEFSYM (QCimage, ":image");
   DEFSYM (Qhelp_echo, "help-echo");
diff --git a/src/lisp.h b/src/lisp.h
index 1e2a8b6535f..012e5fad18d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4093,6 +4093,9 @@ extern Lisp_Object Qdisabled, QCfilter;
 extern Lisp_Object Qup, Qdown;
 extern Lisp_Object last_undo_boundary;
 extern bool input_pending;
+#ifdef HAVE_STACK_OVERFLOW_HANDLING
+extern sigjmp_buf return_to_command_loop;
+#endif
 extern Lisp_Object menu_bar_items (Lisp_Object);
 extern Lisp_Object tool_bar_items (Lisp_Object, int *);
 extern void discard_mouse_events (void);
diff --git a/src/sysdep.c b/src/sysdep.c
index 25bec264f46..f32bd5d1bb6 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -46,7 +46,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 # include <sys/user.h>
 # undef frame
 
-# include <sys/resource.h>
 # include <math.h>
 #endif
 
@@ -72,6 +71,9 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "msdos.h"
 #endif
 
+#ifdef HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
+#endif
 #include <sys/param.h>
 #include <sys/file.h>
 #include <fcntl.h>
@@ -1716,6 +1718,72 @@ handle_arith_signal (int sig)
   xsignal0 (Qarith_error);
 }
 
+#ifdef HAVE_STACK_OVERFLOW_HANDLING
+
+/* True if stack grows down as expected on most OS/ABI variants.  */
+
+static bool stack_grows_down;
+
+/* Alternate stack used by SIGSEGV handler below.  */
+
+static unsigned char sigsegv_stack[SIGSTKSZ];
+
+/* Attempt to recover from SIGSEGV caused by C stack overflow.  */
+
+static void
+handle_sigsegv (int sig, siginfo_t *siginfo, void *arg)
+{
+  /* Hard GC error may lead to stack overflow caused by
+     too nested calls to mark_object.  No way to survive.  */
+  if (!gc_in_progress)
+    {
+      struct rlimit rlim;
+
+      if (!getrlimit (RLIMIT_STACK, &rlim))
+        {
+          enum { STACK_EXTRA = 16 * 1024 };
+          char *fault_addr = (char *) siginfo->si_addr;
+          unsigned long used = (stack_grows_down
+                                ? stack_bottom - fault_addr
+                                : fault_addr - stack_bottom);
+
+          if (used + STACK_EXTRA > rlim.rlim_cur)
+            /* Most likely this is it.  */
+            siglongjmp (return_to_command_loop, 1);
+        }
+    }
+}
+
+static bool
+init_sigsegv (void)
+{
+  struct sigaction sa;
+  stack_t ss;
+
+  stack_grows_down = ((char *) &ss < stack_bottom);
+
+  ss.ss_sp = sigsegv_stack;
+  ss.ss_size = sizeof (sigsegv_stack);
+  ss.ss_flags = 0;
+  if (sigaltstack (&ss, NULL) < 0)
+    return 0;
+
+  sigfillset (&sa.sa_mask);
+  sa.sa_sigaction = handle_sigsegv;
+  sa.sa_flags = SA_SIGINFO | SA_ONSTACK | emacs_sigaction_flags ();
+  return sigaction (SIGSEGV, &sa, NULL) < 0 ? 0 : 1;
+}
+
+#else /* not HAVE_STACK_OVERFLOW_HANDLING */
+
+static bool
+init_sigsegv (void)
+{
+  return 0;
+}
+
+#endif /* HAVE_STACK_OVERFLOW_HANDLING */
+
 static void
 deliver_arith_signal (int sig)
 {
@@ -1982,7 +2050,8 @@ init_signals (bool dumping)
 #ifdef SIGBUS
   sigaction (SIGBUS, &thread_fatal_action, 0);
 #endif
-  sigaction (SIGSEGV, &thread_fatal_action, 0);
+  if (!init_sigsegv ())
+    sigaction (SIGSEGV, &thread_fatal_action, 0);
 #ifdef SIGSYS
   sigaction (SIGSYS, &thread_fatal_action, 0);
 #endif