diff options
author | Andy Wingo <wingo@pobox.com> | 2014-03-22 15:49:31 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-03-22 15:49:31 +0100 |
commit | c2247b782a9234bb9aedee5204c30daf1d01a510 (patch) | |
tree | b5d04cd1bc9d39161d098df22eed7b731d9a588f /libguile/gc.c | |
parent | 0463a927c4ba4e941a3e7d100c629adf7e64b7c2 (diff) | |
download | guile-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.c | 64 |
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" |