~ chicken-core (chicken-5) b7510458def3b95ab4656a03640e39b6247b0672


commit b7510458def3b95ab4656a03640e39b6247b0672
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sat Oct 17 13:10:33 2015 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Oct 26 08:58:13 2015 +1300

    Fix heap allocation size calculations in toplevel.
    
    The toplevel is responsible for decoding literals and storing them in
    the heap.  When the heap is not big enough to store one toplevel's
    literals, the toplevel will call C_rereclaim2 with the desired extra
    size for the heap.
    
    C_rereclaim2 will calculate the size by adding it to the current heap
    size, but because the heap is split in two parts, it needs to multiply
    the demanded size with two.
    
    This change also adds the current stack size to this, because when the
    GC is performed, it will also copy what's in the nursery to the heap. So
    worst case, the heap size needs to be (current heap size + demanded
    memory + stack size).
    
    We add regression tests for this as well.  This fixes #1221.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 6020e430..4cd6a9e3 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,9 @@
 - Platform support
   - CHICKEN now supports the Linux X32 ABI (thanks to Sven Hartrumpf).
 
+- Runtime system:
+  - Compiled programs with large literals won't crash on startup (#1221).
+
 4.10.1
 
 - Core libraries
diff --git a/chicken.h b/chicken.h
index 6bacf750..d50d291a 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1701,7 +1701,7 @@ C_fctexport C_word C_fcall C_mutate_slot(C_word *slot, C_word val) C_regparm;
 C_fctexport void C_fcall C_reclaim(void *trampoline, C_word c) C_regparm C_noret;
 C_fctexport void C_save_and_reclaim(void *trampoline, int n, C_word *av) C_noret;
 C_fctexport void C_save_and_reclaim_args(void *trampoline, int n, ...) C_noret;
-C_fctexport void C_fcall C_rereclaim2(C_uword size, int double_plus) C_regparm;
+C_fctexport void C_fcall C_rereclaim2(C_uword size, int relative_resize) C_regparm;
 C_fctexport void C_unbound_variable(C_word sym);
 C_fctexport C_word C_fcall C_retrieve2(C_word val, char *name) C_regparm;
 C_fctexport void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name) C_regparm;
diff --git a/distribution/manifest b/distribution/manifest
index 430f4691..34c6ae30 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -98,6 +98,7 @@ tests/thread-list.scm
 tests/data-structures-tests.scm
 tests/environment-tests.scm
 tests/gobble.scm
+tests/heap-literal-stress-test.scm
 tests/test-optional.scm
 tests/arithmetic-test.scm
 tests/arithmetic-test.32.expected
diff --git a/runtime.c b/runtime.c
index 10d70f78..a4d346f3 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3247,7 +3247,7 @@ static void remark(C_word *x) { \
 
 /* Do a major GC into a freshly allocated heap: */
 
-C_regparm void C_fcall C_rereclaim2(C_uword size, int double_plus)
+C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize)
 {
   int i, j;
   C_uword count, n, bytes;
@@ -3266,7 +3266,17 @@ C_regparm void C_fcall C_rereclaim2(C_uword size, int double_plus)
 
   if(C_pre_gc_hook != NULL) C_pre_gc_hook(GC_REALLOC);
 
-  if(double_plus) size = heap_size * 2 + size;
+  /*
+   * Normally, size is "absolute": it indicates the desired size of
+   * the entire new heap.  With relative_resize, size is a demanded
+   * increase of the heap, so we'll have to add it.  This calculation
+   * doubles the current heap size because heap_size is already both
+   * halves.  We add size*2 because we'll eventually divide the size
+   * by 2 for both halves.  We also add stack_size*2 because all the
+   * nursery data is also copied to the heap on GC, and the requested
+   * memory "size" must be available after the GC.
+   */
+  if(relative_resize) size = (heap_size + size + stack_size) * 2;
 
   if(size < MINIMAL_HEAP_SIZE) size = MINIMAL_HEAP_SIZE;
 
diff --git a/tests/heap-literal-stress-test.scm b/tests/heap-literal-stress-test.scm
new file mode 100644
index 00000000..964b16af
--- /dev/null
+++ b/tests/heap-literal-stress-test.scm
@@ -0,0 +1,16 @@
+;; This allocates several large objects directly in the heap via the
+;; toplevel entry point, for a total of about 10MB on 64-bit machines.
+;; This guards against regressions in heap reallocation (#1221).
+
+(define-syntax generate-literals
+  (ir-macro-transformer
+    (lambda (i r c)
+      (let lp ((i 0)
+	       (exprs '()))
+	(if (= i 1000)
+	    (cons 'begin exprs)
+	    (lp (add1 i)
+		(cons `(define ,(gensym)
+			 (quote ,(make-vector 1000))) exprs)))))))
+
+(generate-literals)
diff --git a/tests/runtests.bat b/tests/runtests.bat
index b6ef378a..9539bd4d 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -435,6 +435,17 @@ for %%s in (100000 120000 200000 250000 300000 350000 400000 450000 500000) do (
   if errorlevel 1 exit /b 1
 )
 
+echo ======================================== heap literal stress test ...
+%compile% heap-literal-stress-test.scm
+if errorlevel 1 exit /b 1
+
+for %%s in (100000 120000 200000 250000 300000 350000 400000 450000 500000) do (
+  echo %%s
+  a.out -:hi%%s
+  if errorlevel 1 exit /b 1
+)
+
+
 echo ======================================== symbol-GC tests ...
 %compile% symbolgc-tests.scm
 if errorlevel 1 exit /b 1
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 7e078ff1..4bbd171e 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -367,6 +367,13 @@ for s in 100000 120000 200000 250000 300000 350000 400000 450000 500000; do
     ../chicken -ignore-repository ../utils.scm -:s$s -output-file tmp.c -include-path ${TEST_DIR}/..
 done
 
+echo "======================================== heap literal stress test ..."
+$compile heap-literal-stress-test.scm
+for s in 100000 120000 200000 250000 300000 350000 400000 450000 500000; do
+  echo "  $s"
+  ./a.out -:d -:g -:hi$s
+done
+
 echo "======================================== symbol-GC tests ..."
 $compile symbolgc-tests.scm
 # Currently disabled, because this may leave 1 symbol unreclaimed.
Trap