master 39915c7: * src/alloc.c (Fgarbage_collect_maybe): New function

[Stefan Monnier]

branch: master
commit 39915c708435cefd1c3eaddeec54d3b365d36515
Author: Spencer Baugh <sbaugh@catern.com>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * src/alloc.c (Fgarbage_collect_maybe): New function
---
 etc/NEWS    |  2 ++
 src/alloc.c | 25 +++++++++++++++++++++++++
 src/lisp.h  |  1 +
 3 files changed, 28 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 7f18f12..525ed8b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1828,6 +1828,8 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
 
 * Lisp Changes in Emacs 28.1
 
+** New function `garbage-collect-maybe` to trigger GC early
+
 ---
 ** 'defvar' detects the error of defining a variable currently lexically bound.
 Such mixes are always signs that the outer lexical binding was an
diff --git a/src/alloc.c b/src/alloc.c
index 34f822e..5d2d5bc 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6209,6 +6209,30 @@ For further details, see Info node `(elisp)Garbage 
Collection'.  */)
   return CALLMANY (Flist, total);
 }
 
+DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe,
+Sgarbage_collect_maybe, 1, 1, "",
+       doc: /* Call `garbage-collect' if enough allocation happened.
+FACTOR determines what "enough" means here:
+If FACTOR is a positive number N, it means to run GC if more than
+1/Nth of the allocations needed to trigger automatic allocation took
+place.
+Therefore, as N gets higher, this is more likely to perform a GC.
+Returns non-nil if GC happened, and nil otherwise.  */)
+  (Lisp_Object factor)
+{
+  CHECK_FIXNAT (factor);
+  EMACS_INT fact = XFIXNAT (factor);
+
+  EMACS_INT since_gc = gc_threshold - consing_until_gc;
+  if (fact >= 1 && since_gc > gc_threshold / fact)
+    {
+      garbage_collect ();
+      return Qt;
+    }
+  else
+    return Qnil;
+}
+
 /* Mark Lisp objects in glyph matrix MATRIX.  Currently the
    only interesting objects referenced from glyphs are strings.  */
 
@@ -7553,6 +7577,7 @@ N should be nonnegative.  */);
   defsubr (&Smake_finalizer);
   defsubr (&Spurecopy);
   defsubr (&Sgarbage_collect);
+  defsubr (&Sgarbage_collect_maybe);
   defsubr (&Smemory_info);
   defsubr (&Smemory_use_counts);
 #ifdef GNU_LINUX
diff --git a/src/lisp.h b/src/lisp.h
index 9901f80..416c9b0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3798,6 +3798,7 @@ flush_stack_call_func (void (*func) (void *arg), void 
*arg)
 
 extern void garbage_collect (void);
 extern void maybe_garbage_collect (void);
+extern bool maybe_garbage_collect_eagerly (EMACS_INT factor);
 extern const char *pending_malloc_warning;
 extern Lisp_Object zero_vector;
 extern EMACS_INT consing_until_gc;