unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Pip Cet <pipcet@gmail.com>
To: 46988@debbugs.gnu.org
Subject: bug#46988: 28.0.50; Documenting and verifying assumptions about C code not calling quit or GCing
Date: Sun, 7 Mar 2021 14:06:01 +0000	[thread overview]
Message-ID: <CAOqdjBc4_rzuCZzM6ZTrc7FeanYDj=bVByuxs7tfub=AdeaDGw@mail.gmail.com> (raw)
In-Reply-To: <CAOqdjBfU7p2=CQPGSwbvOz7u8YkCvA=NOwWXyPStoYN0bREegA@mail.gmail.com>

[-- Attachment #1: Type: text/plain, Size: 542 bytes --]

On Sun, Mar 7, 2021 at 1:48 PM Pip Cet <pipcet@gmail.com> wrote:
> Proof-of-concept patch for a runtime check will be attached once this
> has a bug number.

Patch attached. It assumes the standard stack growth direction, and
that __builtin_frame_address (0) is available and works. Uses GCC's
__attribute__ ((cleanup (...))).

My point here is that the technical implementation isn't the problem,
the question is whether we're disciplined enough to run with checking
enabled and react to bug reports about the fatal error being thrown.

Pip

[-- Attachment #2: 0001-Runtime-check-that-some-functions-don-t-GC-bug-46988.patch --]
[-- Type: text/x-patch, Size: 10752 bytes --]

From f5ad576ee0aa6c2b3975b0ca131aea4444c7e336 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Sun, 7 Mar 2021 13:59:32 +0000
Subject: [PATCH] Runtime check that some functions don't GC (bug#46988)

* src/alloc.c (mark_object): Mark as DONT_ALLOW_GC ().
(global_dont_allow_gc): New variable.
* src/eval.c (push_handler): Require an sp argument. All callers
changed.
(push_handler_nosignal): Require an sp argument. All callers changed.
Save sp argument in handler structure.
(unwind_to_catch): Handle dont_allow_gc stack.
(Fthrow): Mark as DONT_ALLOW_GC ().
* src/lisp.h (struct handler): Add sp field, for custom stack
unwinding.
(struct dont_allow_gc): New struct.
(dont_allow_gc_init): New function.
(dont_allow_gc_destroy): New function.
(DONT_ALLOW_GC): New macro.
(maybe_gc): Check whether GC is allowed, throw a fatal error if not.
---
 src/alloc.c        |  3 +++
 src/bytecode.c     |  3 ++-
 src/emacs-module.c |  2 +-
 src/eval.c         | 35 ++++++++++++++++++++++++-----------
 src/lisp.h         | 33 +++++++++++++++++++++++++++++++--
 src/thread.c       |  2 +-
 6 files changed, 62 insertions(+), 16 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index e72fc4c4332de..5fe62ef953117 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6565,6 +6565,7 @@ mark_objects (Lisp_Object *obj, ptrdiff_t n)
 void
 mark_object (Lisp_Object arg)
 {
+  DONT_ALLOW_GC ();
   register Lisp_Object obj;
   void *po;
 #if GC_CHECK_MARKED_OBJECTS
@@ -7668,3 +7669,5 @@ syms_of_alloc (void)
   enum defined_HAVE_X_WINDOWS defined_HAVE_X_WINDOWS;
 } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
 #endif	/* __GNUC__ */
+
+struct dont_allow_gc *global_dont_allow_gc;
diff --git a/src/bytecode.c b/src/bytecode.c
index 4fd41acab856a..5a85fe81ae6da 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -776,7 +776,8 @@ #define DEFINE(name, value) LABEL (name) ,
 	  type = CONDITION_CASE;
 	pushhandler:
 	  {
-	    struct handler *c = push_handler (POP, type);
+	    struct handler *c = push_handler (POP, type,
+					      __builtin_frame_address (0));
 	    c->bytecode_dest = FETCH2;
 	    c->bytecode_top = top;
 
diff --git a/src/emacs-module.c b/src/emacs-module.c
index f8fb54c072823..63fe495b91a17 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -272,7 +272,7 @@ #define MODULE_HANDLE_NONLOCAL_EXIT(retval)                             \
   if (module_non_local_exit_check (env) != emacs_funcall_exit_return)	\
     return retval;							\
   struct handler *internal_handler =                                    \
-    push_handler_nosignal (Qt, CATCHER_ALL);                            \
+    push_handler_nosignal (Qt, CATCHER_ALL, __builtin_frame_address (0)); \
   if (!internal_handler)                                                \
     {									\
       module_out_of_memory (env);					\
diff --git a/src/eval.c b/src/eval.c
index ddaa8edd81706..b3964b51a1ed1 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -243,7 +243,7 @@ init_eval (void)
        which would otherwise leak every time we unwind back to top-level.   */
     handlerlist_sentinel = xzalloc (sizeof (struct handler));
     handlerlist = handlerlist_sentinel->nextfree = handlerlist_sentinel;
-    struct handler *c = push_handler (Qunbound, CATCHER);
+    struct handler *c = push_handler (Qunbound, CATCHER, __builtin_frame_address (0));
     eassert (c == handlerlist_sentinel);
     handlerlist_sentinel->nextfree = NULL;
     handlerlist_sentinel->next = NULL;
@@ -1178,7 +1178,7 @@ internal_catch (Lisp_Object tag,
 		Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
 {
   /* This structure is made part of the chain `catchlist'.  */
-  struct handler *c = push_handler (tag, CATCHER);
+  struct handler *c = push_handler (tag, CATCHER, __builtin_frame_address (0));
 
   if (EQ (tag, Qexit))
     minibuffer_quit_level = 0;
@@ -1258,6 +1258,9 @@ unwind_to_catch (struct handler *catch, enum nonlocal_exit type,
 
   lisp_eval_depth = catch->f_lisp_eval_depth;
 
+  void *sp = catch->sp;
+  while (global_dont_allow_gc && (void *)global_dont_allow_gc < sp)
+    global_dont_allow_gc = global_dont_allow_gc->prev;
   sys_longjmp (catch->jmp, 1);
 }
 
@@ -1267,6 +1270,7 @@ DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
        attributes: noreturn)
   (register Lisp_Object tag, Lisp_Object value)
 {
+  DONT_ALLOW_GC ();
   struct handler *c;
 
   if (!NILP (tag))
@@ -1376,7 +1380,8 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
       Lisp_Object condition = CONSP (clause) ? XCAR (clause) : Qnil;
       if (!CONSP (condition))
 	condition = list1 (condition);
-      struct handler *c = push_handler (condition, CONDITION_CASE);
+      struct handler *c = push_handler (condition, CONDITION_CASE,
+					__builtin_frame_address (0));
       if (sys_setjmp (c->jmp))
 	{
 	  Lisp_Object val = handlerlist->val;
@@ -1426,7 +1431,8 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
 internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
 			 Lisp_Object (*hfun) (Lisp_Object))
 {
-  struct handler *c = push_handler (handlers, CONDITION_CASE);
+  struct handler *c = push_handler (handlers, CONDITION_CASE,
+				    __builtin_frame_address (0));
   if (sys_setjmp (c->jmp))
     {
       Lisp_Object val = handlerlist->val;
@@ -1450,7 +1456,8 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
 			   Lisp_Object handlers,
 			   Lisp_Object (*hfun) (Lisp_Object))
 {
-  struct handler *c = push_handler (handlers, CONDITION_CASE);
+  struct handler *c = push_handler (handlers, CONDITION_CASE,
+				    __builtin_frame_address (0));
   if (sys_setjmp (c->jmp))
     {
       Lisp_Object val = handlerlist->val;
@@ -1477,7 +1484,8 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
 			   Lisp_Object handlers,
 			   Lisp_Object (*hfun) (Lisp_Object))
 {
-  struct handler *c = push_handler (handlers, CONDITION_CASE);
+  struct handler *c = push_handler (handlers, CONDITION_CASE,
+				    __builtin_frame_address (0));
   if (sys_setjmp (c->jmp))
     {
       Lisp_Object val = handlerlist->val;
@@ -1506,7 +1514,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
 						ptrdiff_t nargs,
 						Lisp_Object *args))
 {
-  struct handler *c = push_handler (handlers, CONDITION_CASE);
+  struct handler *c = push_handler (handlers, CONDITION_CASE,
+				    __builtin_frame_address (0));
   if (sys_setjmp (c->jmp))
     {
       Lisp_Object val = handlerlist->val;
@@ -1533,7 +1542,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
 internal_catch_all (Lisp_Object (*function) (void *), void *argument,
                     Lisp_Object (*handler) (enum nonlocal_exit, Lisp_Object))
 {
-  struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL);
+  struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL,
+					     __builtin_frame_address (0));
   if (c == NULL)
     return Qcatch_all_memory_full;
 
@@ -1555,16 +1565,18 @@ internal_catch_all (Lisp_Object (*function) (void *), void *argument,
 }
 
 struct handler *
-push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
+push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype,
+	      void *sp)
 {
-  struct handler *c = push_handler_nosignal (tag_ch_val, handlertype);
+  struct handler *c = push_handler_nosignal (tag_ch_val, handlertype, sp);
   if (!c)
     memory_full (sizeof *c);
   return c;
 }
 
 struct handler *
-push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
+push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype,
+		       void *sp)
 {
   struct handler *CACHEABLE c = handlerlist->nextfree;
   if (!c)
@@ -1585,6 +1597,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
   c->pdlcount = SPECPDL_INDEX ();
   c->poll_suppress_count = poll_suppress_count;
   c->interrupt_input_blocked = interrupt_input_blocked;
+  c->sp = sp;
   handlerlist = c;
   return c;
 }
diff --git a/src/lisp.h b/src/lisp.h
index b95f389b89024..9d94376b5b897 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3259,6 +3259,7 @@ SPECPDL_INDEX (void)
   ptrdiff_t pdlcount;
   int poll_suppress_count;
   int interrupt_input_blocked;
+  void *sp;
 };
 
 extern Lisp_Object memory_signal_data;
@@ -4143,8 +4144,9 @@ xsignal (Lisp_Object error_symbol, Lisp_Object data)
     (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
      Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
 extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object));
-extern struct handler *push_handler (Lisp_Object, enum handlertype);
-extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
+extern struct handler *push_handler (Lisp_Object, enum handlertype, void *);
+extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype,
+					      void *);
 extern void specbind (Lisp_Object, Lisp_Object);
 extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
 extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t);
@@ -5050,9 +5052,36 @@ #define FOR_EACH_ALIST_VALUE(head_var, list_var, value_var)		\
 
 /* Check whether it's time for GC, and run it if so.  */
 
+/* Do not wrap into do { } while (0). */
+
+struct dont_allow_gc;
+struct dont_allow_gc
+{
+  struct dont_allow_gc *prev;
+};
+
+extern struct dont_allow_gc *global_dont_allow_gc;
+
+INLINE void
+dont_allow_gc_init (struct dont_allow_gc *dag)
+{
+  dag->prev = global_dont_allow_gc;
+  global_dont_allow_gc = dag;
+}
+
+INLINE void
+dont_allow_gc_destroy (struct dont_allow_gc *dag)
+{
+  global_dont_allow_gc = dag->prev;
+}
+
+#define DONT_ALLOW_GC() struct dont_allow_gc __attribute__ ((cleanup (dont_allow_gc_destroy))) dont_allow_gc; dont_allow_gc_init (&dont_allow_gc)
+
 INLINE void
 maybe_gc (void)
 {
+  if (global_dont_allow_gc)
+    fatal ("GC disallowed");
   if (consing_until_gc < 0)
     maybe_garbage_collect ();
 }
diff --git a/src/thread.c b/src/thread.c
index f74f611148647..6f5deb4101032 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -748,7 +748,7 @@ run_thread (void *state)
      which would otherwise leak every time we unwind back to top-level.   */
   handlerlist_sentinel = xzalloc (sizeof (struct handler));
   handlerlist = handlerlist_sentinel->nextfree = handlerlist_sentinel;
-  struct handler *c = push_handler (Qunbound, CATCHER);
+  struct handler *c = push_handler (Qunbound, CATCHER, __builtin_frame_address (0));
   eassert (c == handlerlist_sentinel);
   handlerlist_sentinel->nextfree = NULL;
   handlerlist_sentinel->next = NULL;
-- 
2.30.1


  reply	other threads:[~2021-03-07 14:06 UTC|newest]

Thread overview: 14+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-03-07 13:47 bug#46988: 28.0.50; Documenting and verifying assumptions about C code not calling quit or GCing Pip Cet
2021-03-07 14:06 ` Pip Cet [this message]
2021-03-08 19:42   ` Lars Ingebrigtsen
2021-03-08 19:57     ` Pip Cet
2021-03-09 14:05       ` Lars Ingebrigtsen
2021-03-10 18:28   ` Matt Armstrong
2021-03-10 19:09     ` Pip Cet
2021-03-11 23:17       ` Matt Armstrong
2022-06-20  1:41   ` Lars Ingebrigtsen
2022-06-20 11:47     ` Eli Zaretskii
2022-06-23 15:56       ` Pip Cet
2022-06-23 16:08         ` Eli Zaretskii
2022-06-23 16:20           ` Mattias Engdegård
2022-06-23 16:35             ` Eli Zaretskii

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='CAOqdjBc4_rzuCZzM6ZTrc7FeanYDj=bVByuxs7tfub=AdeaDGw@mail.gmail.com' \
    --to=pipcet@gmail.com \
    --cc=46988@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).