[PATCH 2/3] Add garbage-collect-maybe function

[Spencer Baugh <sbaugh@catern.com>]

---
 src/alloc.c | 33 +++++++++++++++++++++++++++++++++
 src/lisp.h  |  1 +
 2 files changed, 34 insertions(+)

diff --git a/src/alloc.c b/src/alloc.c
index 8d31903089..c6c07d5dbe 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5961,6 +5961,21 @@ maybe_garbage_collect (void)
     garbage_collect ();
 }
 
+/* Like maybe_garbage_collect, but with the GC threshold halved, so
+   that we'll GC sooner than we would otherwise.
+   Returns true if we GC'd.  */
+bool
+maybe_garbage_collect_eagerly (EMACS_INT factor)
+{
+  bump_consing_until_gc (gc_cons_threshold, Vgc_cons_percentage);
+  EMACS_INT since_gc = gc_threshold - consing_until_gc;
+  if (factor >= 1 && since_gc > gc_threshold / factor) {
+    garbage_collect ();
+    return true;
+  } else
+    return false;
+}
+
 /* Subroutine of Fgarbage_collect that does most of the work.  */
 void
 garbage_collect (void)
@@ -6215,6 +6230,23 @@ 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 determined what "enough" means here:
+a FACTOR of N means to run the GC if more than 1/Nth of the allocations
+needed to triger automatic allocation took place.
+Returns t if we garbage collected, and nil otherwise.  */)
+  (Lisp_Object factor)
+{
+  CHECK_FIXNAT (factor);
+  EMACS_INT fact = XFIXNAT (factor);
+  if (maybe_garbage_collect_eagerly(fact))
+    return Qt;
+  else
+    return Qnil;
+}
+
 /* Mark Lisp objects in glyph matrix MATRIX.  Currently the
    only interesting objects referenced from glyphs are strings.  */
 
@@ -7564,6 +7596,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 76d74200ac..5ef47fa234 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3793,6 +3793,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;
-- 
2.28.0