mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +02:00
Code Activity

Out-of-memory situations raise exceptions instead of aborting

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2014-03-22 15:49:31 +01:00
parent 0463a927c4
commit c2247b782a
16 changed files with 251 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

87
libguile/throw.c
View file

@ -22,6 +22,7 @@
# include <config.h>
#endif
#include <alloca.h>
#include <stdio.h>
#include <unistdio.h>
#include "libguile/_scm.h"
@ -119,6 +120,8 @@ catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
{
/* A non-local return. */
scm_gc_after_nonlocal_exit ();
/* FIXME: We know where the args will be on the stack; we could
avoid consing them. */
SCM args = scm_i_prompt_pop_abort_args_x (vp);
@ -168,11 +171,39 @@ default_exception_handler (SCM k, SCM args)
abort ();
}
/* A version of scm_abort_to_prompt_star that avoids the need to cons
"tag" to "args", because we might be out of memory. */
static void
abort_to_prompt (SCM prompt_tag, SCM tag, SCM args)
{
SCM *argv;
size_t i;
long n;
n = scm_ilength (args) + 1;
argv = alloca (sizeof (SCM)*n);
argv[0] = tag;
for (i = 1; i < n; i++, args = scm_cdr (args))
argv[i] = scm_car (args);
scm_c_abort (scm_the_vm (), prompt_tag, n, argv, NULL);
/* Oh, what, you're still here? The abort must have been reinstated. Actually,
that's quite impossible, given that we're already in C-land here, so...
abort! */
abort ();
}
static SCM
throw_without_pre_unwind (SCM tag, SCM args)
{
SCM eh;
/* This function is not only the boot implementation of "throw", it is
also called in response to resource allocation failures such as
stack-overflow or out-of-memory. For that reason we need to be
careful to avoid allocating memory. */
for (eh = scm_fluid_ref (exception_handler_fluid);
scm_is_true (eh);
eh = scm_c_vector_ref (eh, 0))
@ -185,17 +216,20 @@ throw_without_pre_unwind (SCM tag, SCM args)
if (scm_is_true (scm_c_vector_ref (eh, 3)))
{
char *key_chars;
const char *key_chars;
if (scm_i_is_narrow_symbol (tag))
key_chars = scm_i_symbol_chars (tag);
else
key_chars = "(wide symbol)";
key_chars = scm_to_locale_string (scm_symbol_to_string (tag));
fprintf (stderr, "Warning: Unwind-only `%s' exception; "
"skipping pre-unwind handler.\n", key_chars);
free (key_chars);
}
prompt_tag = scm_c_vector_ref (eh, 2);
if (scm_is_true (prompt_tag))
scm_abort_to_prompt_star (prompt_tag, scm_cons (tag, args));
abort_to_prompt (prompt_tag, tag, args);
}
default_exception_handler (tag, args);
@ -571,22 +605,31 @@ scm_ithrow (SCM key, SCM args, int no_return SCM_UNUSED)
}
SCM_SYMBOL (scm_stack_overflow_key, "stack-overflow");
SCM_SYMBOL (scm_out_of_memory_key, "out-of-memory");
static SCM stack_overflow_args = SCM_BOOL_F;
static SCM out_of_memory_args = SCM_BOOL_F;
/* Since these two functions may be called in response to resource
exhaustion, we have to avoid allocating memory. */
void
scm_report_stack_overflow (void)
{
/* Arguments as if from:
if (scm_is_false (stack_overflow_args))
abort ();
throw_without_pre_unwind (scm_stack_overflow_key, stack_overflow_args);
scm_error (stack-overflow, NULL, "Stack overflow", #f, #f);
/* Not reached. */
abort ();
}
We build the arguments manually because we throw without running
pre-unwind handlers. (Pre-unwind handlers could rewind the
stack.) */
SCM args = scm_list_4 (SCM_BOOL_F,
scm_from_latin1_string ("Stack overflow"),
SCM_BOOL_F,
SCM_BOOL_F);
throw_without_pre_unwind (scm_stack_overflow_key, args);
void
scm_report_out_of_memory (void)
{
if (scm_is_false (out_of_memory_args))
abort ();
throw_without_pre_unwind (scm_out_of_memory_key, out_of_memory_args);
/* Not reached. */
abort ();
@ -607,6 +650,22 @@ scm_init_throw ()
throw_var = scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1,
throw_without_pre_unwind));
/* Arguments as if from:
scm_error (stack-overflow, NULL, "Stack overflow", #f, #f);
We build the arguments manually because we throw without running
pre-unwind handlers. (Pre-unwind handlers could rewind the
stack.) */
stack_overflow_args = scm_list_4 (SCM_BOOL_F,
scm_from_latin1_string ("Stack overflow"),
SCM_BOOL_F,
SCM_BOOL_F);
out_of_memory_args = scm_list_4 (SCM_BOOL_F,
scm_from_latin1_string ("Out of memory"),
SCM_BOOL_F,
SCM_BOOL_F);
#include "libguile/throw.x"
}