mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 05:12:38 -08:00
Code Issues Projects Releases Packages Wiki Activity

Out of memory errors are now somewhat restartable.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-05-20 22:03:58 +02:00
parent a692c9c50f
commit 2c8690bf58
6 changed files with 92 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/CHANGELOG
View file

@ -24,6 +24,10 @@ ECL 9.5:
- New command line arguments, --heap-size, --lisp-stack, --frame-stack and
--c-stack control the different memory limits.
- The out of memory error (ext:storage-exhausted) can now be recovered.
By default a correctable error is signaled and the user is given the
chance to increase the heap size.
* Bugs fixed:
- Remove an obsolete #if statement for Solaris that broke current builds

108
src/c/alloc_2.d
View file

@ -42,31 +42,81 @@ _ecl_set_max_heap_size(cl_index new_size)
ecl_enable_interrupts_env(the_env);
}
static void
out_of_memory(cl_env_ptr the_env)
static int failure;
static void *
out_of_memory_check(size_t requested_bytes)
{
the_env->string_pool = Cnil;
_ecl_set_max_heap_size(cl_core.max_heap_size +
ecl_get_option(ECL_OPT_HEAP_SAFETY_AREA));
cl_error(1, @'ext::storage-exhausted');
failure = 1;
return 0;
}
@(defun ext::heap-size (&optional (new_max_heap_size Cnil))
cl_index size;
cl_object output;
@
ecl_disable_interrupts_env(the_env);
size = GC_get_heap_size();
ecl_enable_interrupts_env(the_env);
output = ecl_make_unsigned_integer(size);
if (!Null(new_max_heap_size)) {
cl_index new_size = fixnnint(new_max_heap_size);
if (new_size > size) {
_ecl_set_max_heap_size(new_size);
static void
no_warnings(char *msg, void *arg)
{
}
static void *
out_of_memory(size_t requested_bytes)
{
const cl_env_ptr the_env = ecl_process_env();
int interrupts = the_env->disable_interrupts;
int method = 0;
if (!interrupts)
ecl_disable_interrupts_env(the_env);
#ifdef ECL_THREADS
/* The out of memory condition may happen in more than one thread */
/* But then we have to ensure the error has not been solved */
ERROR_HANDLER_LOCK();
#endif
failure = 0;
GC_gcollect();
GC_oom_fn = out_of_memory_check;
{
void *output = GC_MALLOC(requested_bytes);
GC_oom_fn = out_of_memory;
if (output != 0 && failure == 0) {
ERROR_HANDLER_UNLOCK();
return output;
}
}
@(return output);
@)
if (cl_core.max_heap_size == 0) {
/* We did not set any limit in the amount of memory,
* yet we failed, or we had some limits but we have
* not reached them. */
if (cl_core.safety_region) {
/* We can free some memory and try handling the error */
GC_free(cl_core.safety_region);
the_env->string_pool = Cnil;
cl_core.safety_region = 0;
method = 0;
} else {
/* No possibility of continuing */
method = 2;
}
} else {
cl_core.max_heap_size += ecl_get_option(ECL_OPT_HEAP_SAFETY_AREA);
GC_set_max_heap_size(cl_core.max_heap_size);
method = 1;
}
ERROR_HANDLER_UNLOCK();
ecl_enable_interrupts_env(the_env);
switch (method) {
case 0: cl_error(1, @'ext::storage-exhausted');
break;
case 1: cl_cerror(2, make_constant_base_string("Extend heap size"),
@'ext::storage-exhausted');
break;
default:
ecl_internal_error("Memory exhausted, quitting program.");
break;
}
if (!interrupts)
ecl_disable_interrupts_env(the_env);
GC_set_max_heap_size(cl_core.max_heap_size +=
cl_core.max_heap_size / 2);
/* Default allocation. Note that we do not allocate atomic. */
return GC_MALLOC(requested_bytes);
}
#ifdef alloc_object
#undef alloc_object
@ -141,18 +191,14 @@ ecl_alloc_object(cl_type t)
ecl_disable_interrupts_env(the_env);
obj = (cl_object)GC_MALLOC(type_size[t]);
ecl_enable_interrupts_env(the_env);
if (obj != NULL) {
obj->d.t = t;
return obj;
}
obj->d.t = t;
return obj;
break;
}
default:
printf("\ttype = %d\n", t);
ecl_internal_error("alloc botch.");
}
out_of_memory(the_env);
return OBJNULL;
}
#ifdef make_cons
@ -167,7 +213,6 @@ ecl_cons(cl_object a, cl_object d)
ecl_disable_interrupts_env(the_env);
obj = GC_MALLOC(sizeof(struct ecl_cons));
ecl_enable_interrupts_env(the_env);
if (obj == NULL) out_of_memory(the_env);
#ifdef ECL_SMALL_CONS
obj->car = a;
obj->cdr = d;
@ -188,7 +233,6 @@ ecl_list1(cl_object a)
ecl_disable_interrupts_env(the_env);
obj = GC_MALLOC(sizeof(struct ecl_cons));
ecl_enable_interrupts_env(the_env);
if (obj == NULL) out_of_memory(the_env);
#ifdef ECL_SMALL_CONS
obj->car = a;
obj->cdr = Cnil;
@ -220,7 +264,6 @@ ecl_alloc_uncollectable(size_t size)
ecl_disable_interrupts_env(the_env);
output = GC_MALLOC_UNCOLLECTABLE(size);
ecl_enable_interrupts_env(the_env);
if (output == NULL) out_of_memory(the_env);
return output;
}
@ -253,7 +296,6 @@ ecl_alloc(cl_index n)
ecl_disable_interrupts_env(the_env);
output = ecl_alloc_unprotected(n);
ecl_enable_interrupts_env(the_env);
if (output == NULL) out_of_memory(the_env);
return output;
}
@ -265,7 +307,6 @@ ecl_alloc_atomic(cl_index n)
ecl_disable_interrupts_env(the_env);
output = ecl_alloc_atomic_unprotected(n);
ecl_enable_interrupts_env(the_env);
if (output == NULL) out_of_memory(the_env);
return output;
}
@ -365,10 +406,15 @@ init_alloc(void)
init_tm(t_longfloat, "LONG-FLOAT", sizeof(struct ecl_long_float));
#endif
/* Save some memory for the case we get tight. */
cl_core.safety_region = ecl_alloc_atomic(sizeof(cl_fixnum)*1024);
old_GC_push_other_roots = GC_push_other_roots;
GC_push_other_roots = stacks_scanner;
GC_start_call_back = (void (*)())finalize_queued;
GC_java_finalization = 1;
GC_oom_fn = out_of_memory;
GC_set_warn_proc(no_warnings);
GC_enable();
}

8
src/c/symbols_list.h
View file

@ -1717,6 +1717,7 @@ cl_symbols[] = {
{EXT_ "INTERACTIVE-INTERRUPT", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "STORAGE-EXHAUSTED", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "STACK-OVERFLOW", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "STACK-OVERFLOW-SIZE", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "STACK-OVERFLOW-TYPE", EXT_ORDINARY, NULL, -1, OBJNULL},
@ -1724,6 +1725,7 @@ cl_symbols[] = {
{EXT_ "FRAME-STACK", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "LISP-STACK", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "C-STACK", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "HEAP-SIZE", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "SET-LIMIT", EXT_ORDINARY, si_set_limit, 2, OBJNULL},
{EXT_ "GET-LIMIT", EXT_ORDINARY, si_get_limit, 1, OBJNULL},
{EXT_ "SEGMENTATION-VIOLATION", EXT_ORDINARY, NULL, -1, OBJNULL},
@ -1738,8 +1740,6 @@ cl_symbols[] = {
{KEY_ "UCS-2", KEYWORD, NULL, -1, OBJNULL},
{KEY_ "UCS-4", KEYWORD, NULL, -1, OBJNULL},
{EXT_ "STORAGE-EXHAUSTED", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "CONSTANTLY-T", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "CONSTANTLY-NIL", EXT_ORDINARY, NULL, -1, OBJNULL},
@ -1765,10 +1765,6 @@ cl_symbols[] = {
{SYS_ "COPY-FILE", SI_ORDINARY, si_copy_file, 2, OBJNULL},
#ifdef GBC_BOEHM
{EXT_ "HEAP-SIZE", EXT_ORDINARY, si_heap_size, -1, OBJNULL},
#endif
{EXT_ "FILL-ARRAY-WITH-ELT", EXT_ORDINARY, si_fill_array_with_elt, 4, OBJNULL},
{EXT_ "+ECL-VERSION-NUMBER+", EXT_CONSTANT, NULL, -1, MAKE_FIXNUM(ECL_VERSION_NUMBER)},

8
src/c/symbols_list2.h
View file

@ -1717,6 +1717,7 @@ cl_symbols[] = {
{EXT_ "INTERACTIVE-INTERRUPT",NULL},
{EXT_ "STORAGE-EXHAUSTED",NULL},
{EXT_ "STACK-OVERFLOW",NULL},
{EXT_ "STACK-OVERFLOW-SIZE",NULL},
{EXT_ "STACK-OVERFLOW-TYPE",NULL},
@ -1724,6 +1725,7 @@ cl_symbols[] = {
{EXT_ "FRAME-STACK",NULL},
{EXT_ "LISP-STACK",NULL},
{EXT_ "C-STACK",NULL},
{EXT_ "HEAP-SIZE",NULL},
{EXT_ "SET-LIMIT","si_set_limit"},
{EXT_ "GET-LIMIT","si_get_limit"},
{EXT_ "SEGMENTATION-VIOLATION",NULL},
@ -1738,8 +1740,6 @@ cl_symbols[] = {
{KEY_ "UCS-2",NULL},
{KEY_ "UCS-4",NULL},
{EXT_ "STORAGE-EXHAUSTED",NULL},
{EXT_ "CONSTANTLY-T",NULL},
{EXT_ "CONSTANTLY-NIL",NULL},
@ -1765,10 +1765,6 @@ cl_symbols[] = {
{SYS_ "COPY-FILE","si_copy_file"},
#ifdef GBC_BOEHM
{EXT_ "HEAP-SIZE","si_heap_size"},
#endif
{EXT_ "FILL-ARRAY-WITH-ELT","si_fill_array_with_elt"},
{EXT_ "+ECL-VERSION-NUMBER+",NULL},

4
src/h/external.h
View file

@ -206,6 +206,9 @@ struct cl_core_struct {
cl_object gc_counter;
bool gc_stats;
int path_max;
#ifdef GBC_BOEHM
char *safety_region;
#endif
#ifdef ECL_UNICODE
cl_object unicode_database;
@ -224,7 +227,6 @@ extern ECL_API cl_object ecl_alloc_instance(cl_index slots);
extern ECL_API cl_object ecl_cons(cl_object a, cl_object d);
extern ECL_API cl_object ecl_list1(cl_object a);
#ifdef GBC_BOEHM
extern ECL_API cl_object si_heap_size _ARGS((cl_narg narg, ...));
extern ECL_API cl_object si_gc(cl_object area);
extern ECL_API cl_object si_gc_dump(void);
extern ECL_API cl_object si_gc_stats(cl_object enable);

4
src/h/internal.h
View file

@ -281,6 +281,8 @@ extern void cl_write_object(cl_object x, cl_object stream);
# define PACKAGE_UNLOCK(p) if (pthread_mutex_unlock(&(p)->pack.lock)) ecl_internal_error("")
# define PACKAGE_OP_UNLOCK() if (pthread_mutex_unlock(&cl_core.global_lock)) ecl_internal_error("")
# define THREAD_OP_UNLOCK() if (pthread_mutex_unlock(&cl_core.global_lock)) ecl_internal_error("")
# define ERROR_HANDLER_LOCK() THREAD_OP_LOCK()
# define ERROR_HANDLER_UNLOCK() THREAD_OP_UNLOCK()
#else
# define HASH_TABLE_LOCK(h)
# define HASH_TABLE_UNLOCK(h)
@ -288,6 +290,8 @@ extern void cl_write_object(cl_object x, cl_object stream);
# define PACKAGE_UNLOCK(p)
# define PACKAGE_OP_LOCK()
# define PACKAGE_OP_UNLOCK()
# define ERROR_HANDLER_LOCK()
# define ERROR_HANDLER_UNLOCK()
#endif /* ECL_THREADS */