elisp @@ macro

[bpt/guile.git] / libguile / gc.c

diff --git a/libguile/gc.c b/libguile/gc.c
index 2bcdaff..13823c0 100644 (file)
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -66,9 +66,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 #include "libguile/debug-malloc.h"
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 
 /* Size in bytes of the initial heap.  This should be about the size of
    result of 'guile -c "(display (assq-ref (gc-stats)
@@ -192,6 +190,68 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
 
 #endif  /* SCM_DEBUG_CELL_ACCESSES == 1 */
 
+
+\f
+
+static int needs_gc_after_nonlocal_exit = 0;
+
+/* Arrange to throw an exception on failed allocations.  */
+static void*
+scm_oom_fn (size_t nbytes)
+{
+  needs_gc_after_nonlocal_exit = 1;
+  scm_report_out_of_memory ();
+  return NULL;
+}
+
+/* Called within GC -- cannot allocate GC memory.  */
+static void
+scm_gc_warn_proc (char *fmt, GC_word arg)
+{
+  SCM port;
+  FILE *stream = NULL;
+
+  port = scm_current_warning_port ();
+  if (!SCM_OPPORTP (port))
+    return;
+
+  if (SCM_FPORTP (port))
+    {
+      int fd;
+      scm_force_output (port);
+      if (!SCM_OPPORTP (port))
+        return;
+      fd = dup (SCM_FPORT_FDES (port));
+      if (fd == -1)
+        perror ("Failed to dup warning port fd");
+      else
+        {
+          stream = fdopen (fd, "a");
+          if (!stream)
+            {
+              perror ("Failed to open stream for warning port");
+              close (fd);
+            }
+        }
+    }
+
+  fprintf (stream ? stream : stderr, fmt, arg);
+
+  if (stream)
+    fclose (stream);
+}
+
+void
+scm_gc_after_nonlocal_exit (void)
+{
+  if (needs_gc_after_nonlocal_exit)
+    {
+      needs_gc_after_nonlocal_exit = 0;
+      GC_gcollect_and_unmap ();
+    }
+}
+
+
 \f
 
 /* Hooks.  */
@@ -540,6 +600,14 @@ scm_storage_prehistory ()
   GC_set_free_space_divisor (free_space_divisor);
   GC_set_finalize_on_demand (1);
 
+#if (GC_VERSION_MAJOR == 7 && GC_VERSION_MINOR == 4    \
+     && GC_VERSION_MICRO == 0)
+  /* BDW-GC 7.4.0 has a bug making it loop indefinitely when using more
+     than one marker thread: <https://github.com/ivmai/bdwgc/pull/30>.
+     Work around it by asking for one marker thread.  */
+  setenv ("GC_MARKERS", "1", 1);
+#endif
+
   GC_INIT ();
 
   GC_expand_hp (DEFAULT_INITIAL_HEAP_SIZE);
@@ -724,6 +792,8 @@ scm_init_gc ()
   scm_c_hook_add (&scm_before_gc_c_hook, start_gc_timer, NULL, 0);
   scm_c_hook_add (&scm_after_gc_c_hook, accumulate_gc_timer, NULL, 0);
 
+  GC_set_oom_fn (scm_oom_fn);
+  GC_set_warn_proc (scm_gc_warn_proc);
   GC_set_start_callback (run_before_gc_c_hook);
 
 #include "libguile/gc.x"