From f5ad576ee0aa6c2b3975b0ca131aea4444c7e336 Mon Sep 17 00:00:00 2001 From: Pip Cet 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