diff --git a/src/CHANGELOG b/src/CHANGELOG
index ab842c31f..98f034faa 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -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
diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d
index 18656401b..a3e099b78 100644
--- a/src/c/alloc_2.d
+++ b/src/c/alloc_2.d
@@ -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();
 }
 
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index a2a53915c..9d046ebf8 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -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)},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index f8c04b0d3..2b8a237ed 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -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},
diff --git a/src/h/external.h b/src/h/external.h
index ba9b06bf3..df18afbd5 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -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);
diff --git a/src/h/internal.h b/src/h/internal.h
index 736c62d23..e6faa77e0 100644
--- a/src/h/internal.h
+++ b/src/h/internal.h
@@ -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 */