summaryrefslogtreecommitdiff
path: root/libguile/gc.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-03-22 15:49:31 +0100
committerAndy Wingo <wingo@pobox.com>2014-03-22 15:49:31 +0100
commitc2247b782a9234bb9aedee5204c30daf1d01a510 (patch)
treeb5d04cd1bc9d39161d098df22eed7b731d9a588f /libguile/gc.c
parent0463a927c4ba4e941a3e7d100c629adf7e64b7c2 (diff)
downloadguile-c2247b782a9234bb9aedee5204c30daf1d01a510.tar.gz
Out-of-memory situations raise exceptions instead of aborting
* libguile/gc.c (scm_oom_fn, scm_init_gc): Install an out-of-memory handler that raises an unwind-only out-of-memory exception. (scm_gc_warn_proc, scm_init_gc): Install a warning proc that tries to print to the current warning port, if the current warning port is a file port. (scm_gc_after_nonlocal_exit): New interface. Should be called after a nonlocal return to potentially collect memory; otherwise allocations could try to expand again when they should collect. * libguile/continuations.c (scm_i_make_continuation): * libguile/eval.c (eval): * libguile/throw.c (catch): * libguile/vm.c (scm_call_n): Call scm_gc_after_nonlocal_exit after nonlocal returns. * libguile/throw.c (abort_to_prompt, throw_without_pre_unwind): Rework to avoid allocating memory. (scm_report_out_of_memory): New interface. (scm_init_throw): Pre-allocate the arguments for stack-overflow and out-of-memory errors. * module/ice-9/boot-9.scm: Add an out-of-memory exception printer. * module/system/repl/error-handling.scm (call-with-error-handling): Add out-of-memory to the report-keys set. * libguile/gc-malloc.c (scm_realloc): Call scm_report_out_of_memory if realloc fails. * libguile/error.h: * libguile/error.c: * libguile/deprecated.h: * libguile/deprecated.c (scm_memory_error): Deprecate. * test-suite/standalone/Makefile.am: * test-suite/standalone/test-out-of-memory: New test case.
Diffstat (limited to 'libguile/gc.c')
-rw-r--r--libguile/gc.c64
1 files changed, 64 insertions, 0 deletions
diff --git a/libguile/gc.c b/libguile/gc.c
index 2bcdaffc8..eacd5e256 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -192,6 +192,68 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
#endif /* SCM_DEBUG_CELL_ACCESSES == 1 */
+
+
+
+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 ();
+ }
+}
+
+
/* Hooks. */
@@ -724,6 +786,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"