From 061b9d0e786ff52f401aab28b18be38d27ff083e Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Date: Tue, 27 Jan 2009 21:49:52 +0100
Subject: [PATCH] New function, EXT:HEAP-SIZE to change the memory limits

---
 src/CHANGELOG         |  5 +++++
 src/c/alloc_2.d       | 17 +++++++++++++++++
 src/c/symbols_list.h  |  4 ++++
 src/c/symbols_list2.h |  4 ++++
 src/h/external.h      |  1 +
 5 files changed, 31 insertions(+)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 7c3c0434a..25760d1a7 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -66,6 +66,11 @@ ECL 9.1.0:
  - The canonicalized default arguments list now contains functions instead
    of the forms to be evaluated.
 
+* Visible changes:
+
+ - New function (EXT:HEAP-SIZE &optional NEW-MAX-HEAP-SIZE) can change the      
+   memory limits.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***
diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d
index 82320b964..16f59d2bb 100644
--- a/src/c/alloc_2.d
+++ b/src/c/alloc_2.d
@@ -55,6 +55,23 @@ out_of_memory(cl_env_ptr the_env)
 	cl_error(1, @'ext::storage-exhausted');
 }
 
+@(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);
+                }
+        }
+	@(return output);
+@)
+
 #ifdef alloc_object
 #undef alloc_object
 #endif
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index e846c279a..81b234c8a 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1745,5 +1745,9 @@ 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
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index d44d1ba24..5c0b4df50 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1745,5 +1745,9 @@ cl_symbols[] = {
 
 {SYS_ "COPY-FILE","si_copy_file"},
 
+#ifdef GBC_BOEHM
+{EXT_ "HEAP-SIZE","si_heap_size"},
+#endif
+
 /* Tag for end of list */
 {NULL,NULL}};
diff --git a/src/h/external.h b/src/h/external.h
index 36fadc38a..1ba44244a 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -220,6 +220,7 @@ 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);