Improve stack-overflow heuristic on GNU/Linux

Problem reported by Steve Kemp (Bug#27585).
* src/eval.c (near_C_stack_top): Remove.  All uses replaced
by current_thread->stack_top.
(record_in_backtrace): Set current_thread->stack_top.
This is for when the Lisp interpreter calls itself.
* src/lread.c (read1): Set current_thread->stack_top.
This is for recursive s-expression reads.
* src/print.c (print_object): Set current_thread->stack_top.
This is for recursive s-expression printing.
* src/thread.c (mark_one_thread): Get stack top first.
* src/thread.h (struct thread_state.stack_top): Now void *, not char *.

7 files changed, 18 insertions, 17 deletions

diff --git a/src/eval.c b/src/eval.c
index 8f293c9d300..e5900382dee 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -213,13 +213,6 @@ backtrace_next (union specbinding *pdl)
   return pdl;
 }
 
-/* Return a pointer to somewhere near the top of the C stack.  */
-void *
-near_C_stack_top (void)
-{
-  return backtrace_args (backtrace_top ());
-}
-
 void
 init_eval_once (void)
 {
@@ -2090,7 +2083,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
   specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
   specpdl_ptr->bt.debug_on_exit = false;
   specpdl_ptr->bt.function = function;
-  specpdl_ptr->bt.args = args;
+  current_thread->stack_top = specpdl_ptr->bt.args = args;
   specpdl_ptr->bt.nargs = nargs;
   grow_specpdl ();
 
diff --git a/src/lisp.h b/src/lisp.h
index f5cb6c75706..1e8ef7a449a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3874,7 +3874,6 @@ extern Lisp_Object vformat_string (const char *, va_list)
   ATTRIBUTE_FORMAT_PRINTF (1, 0);
 extern void un_autoload (Lisp_Object);
 extern Lisp_Object call_debugger (Lisp_Object arg);
-extern void *near_C_stack_top (void);
 extern void init_eval_once (void);
 extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index fe5de382677..901e40b3489 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2676,6 +2676,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
   bool uninterned_symbol = false;
   bool multibyte;
   char stackbuf[MAX_ALLOCA];
+  current_thread->stack_top = stackbuf;
 
   *pch = 0;
 
diff --git a/src/print.c b/src/print.c
index b6ea3ff62a5..12edf015892 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1748,7 +1748,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
   char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
                 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
                      40))];
-
+  current_thread->stack_top = buf;
   maybe_quit ();
 
   /* Detect circularities and truncate them.  */
diff --git a/src/sysdep.c b/src/sysdep.c
index b52236769e0..db99f53299c 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1772,7 +1772,7 @@ stack_overflow (siginfo_t *siginfo)
   /* The known top and bottom of the stack.  The actual stack may
      extend a bit beyond these boundaries.  */
   char *bot = stack_bottom;
-  char *top = near_C_stack_top ();
+  char *top = current_thread->stack_top;
 
   /* Log base 2 of the stack heuristic ratio.  This ratio is the size
      of the known stack divided by the size of the guard area past the
diff --git a/src/thread.c b/src/thread.c
index e3787971a53..1f7ced386d3 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -595,14 +595,15 @@ thread_select (select_func *func, int max_fds, fd_set *rfds,
 static void
 mark_one_thread (struct thread_state *thread)
 {
-  struct handler *handler;
-  Lisp_Object tem;
+  /* Get the stack top now, in case mark_specpdl changes it.  */
+  void *stack_top = thread->stack_top;
 
   mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
 
-  mark_stack (thread->m_stack_bottom, thread->stack_top);
+  mark_stack (thread->m_stack_bottom, stack_top);
 
-  for (handler = thread->m_handlerlist; handler; handler = handler->next)
+  for (struct handler *handler = thread->m_handlerlist;
+       handler; handler = handler->next)
     {
       mark_object (handler->tag_or_ch);
       mark_object (handler->val);
@@ -610,6 +611,7 @@ mark_one_thread (struct thread_state *thread)
 
   if (thread->m_current_buffer)
     {
+      Lisp_Object tem;
       XSETBUFFER (tem, thread->m_current_buffer);
       mark_object (tem);
     }
diff --git a/src/thread.h b/src/thread.h
index 9e94de5c175..52b16f1ba83 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -62,8 +62,14 @@ struct thread_state
   char *m_stack_bottom;
 #define stack_bottom (current_thread->m_stack_bottom)
 
-  /* An address near the top of the stack.  */
-  char *stack_top;
+  /* The address of an object near the C stack top, used to determine
+     which words need to be scanned by the garbage collector.  This is
+     also used to detect heuristically whether segmentation violation
+     address indicates stack overflow, as opposed to some internal
+     error in Emacs.  If the C function F calls G which calls H which
+     calls ... F, then at least one of the functions in the chain
+     should set this to the address of a local variable.  */
+  void *stack_top;
 
   struct catchtag *m_catchlist;
 #define catchlist (current_thread->m_catchlist)