On Wed, Oct 14, 2015 at 09:43:59AM +0200, Peter Bex wrote:
> On Tue, Oct 13, 2015 at 11:06:58PM +0200, felix.winkelm...@bevuta.com wrote:
> > > Am I correct in thinking that double_plus is misnamed and should really
> > > be called "relative_size" or something?  Felix: Do you remember the
> > > original meaning of these two parameters, how are they to be used?
> > 
> > I'm not sure. Double_plus is intended to enlarge the heap (by doubling it),
> > and add the required size. But it may very well be the case that by the 
> > subsequent
> > halving (for the two heap spaces), the "doubling" gets lost. Your 
> > description
> > of the bug seems plausible, but shouldn't this have caused problems before?
> 
> I think the reason it hasn't caused problems before is because it's
> kind of rare to allocate literals that are more than the current heap
> size.  And my guess is that most large literals are strings or blobs (or
> srfi-4 vectors which are internally blobs).  These do not trigger this
> problem due to the fact that they're allocated with malloc().

Well, here's a bunch of patches to fix this issue (#1221) as well as a
handful of memory-related issues.  I still haven't managed to pinpoint
the crashes we're seeing on Salmonella, but this is a separate issue
which seems to be fixed by one of the attached patches.

The other patches should be pretty self-explanatory, except perhaps for
patch 0002.  I noticed that these crashes we're seeing are always
happening due to data corruption in a reallocating GC.  The patch adds
a simple check:  When the object that we're currently mark()ing triggers
a reallocating GC because it's too big to fit the heap, we first check
whether its size makes some basic sense: if it's in the stack, it should
*never* be larger than the stack.  If it's in the heap, it should *never*
be larger than the heap.

By adding this check, we get an earlier opportunity to panic, which makes
the panic message make a little bit more sense, and might be helpful in
debugging, too.  It's not 100% reliable of course: a corrupted object does
not necessarily have to have an absurd size, but I still find the change
rather helpful.  It doesn't add any overhead to speak of, because it
only checks a single object when entering the reallocating GC.

Cheers,
Peter
From 27364487e4c03ccd0d09485bc5be009f3f141892 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 16:44:04 +0200
Subject: [PATCH 1/4] 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.
---
 NEWS                               |  3 +++
 chicken.h                          |  2 +-
 distribution/manifest              |  1 +
 runtime.c                          | 14 ++++++++++++--
 tests/heap-literal-stress-test.scm | 16 ++++++++++++++++
 tests/runtests.bat                 | 11 +++++++++++
 tests/runtests.sh                  |  7 +++++++
 7 files changed, 51 insertions(+), 3 deletions(-)
 create mode 100644 tests/heap-literal-stress-test.scm

diff --git a/NEWS b/NEWS
index fc7c0c6..386f100 100644
--- a/NEWS
+++ b/NEWS
@@ -37,6 +37,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 5c66802..701881d 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1821,7 +1821,7 @@ C_fctexport C_word C_fcall C_migrate_buffer_object(C_word **ptr, C_word *start,
 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 edb6c4d..eb3ebe7 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -98,6 +98,7 @@ tests/clustering-tests.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 8547722..dda983c 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3660,7 +3660,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;
@@ -3679,7 +3679,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 0000000..964b16a
--- /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 f44330b..3c35be2 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -452,6 +452,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 e07bdf9..c56968a 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -373,6 +373,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.
-- 
2.1.4

From 0e49dfeb0f57fb16d98c3f9c12b7a00e80f184e4 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 16:44:25 +0200
Subject: [PATCH 2/4] Try to detect corrupted data before performing
 GC_REALLOC.

If an "impossible" object in the stack or heap: one that has a size
that's larger than the memory area that contains it, we know we have a
data corruption on our hands.  Panic immediately instead of going in
for the reallocating GC.  This prevents the memory state from being
mutated any more, which may help in debugging.
---
 runtime.c | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/runtime.c b/runtime.c
index dda983c..af10825 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3627,6 +3627,11 @@ C_regparm void C_fcall really_mark(C_word *x)
     bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word);
 
     if(((C_byte *)p2 + bytes + sizeof(C_word)) > tospace_limit) {
+      /* Detect impossibilities before GC_REALLOC to preserve state: */
+      if (C_in_stackp((C_word)p) && bytes > stack_size)
+        panic(C_text("Detected corrupted data in stack"));
+      if (C_in_heapp((C_word)p) && bytes > (heap_size / 2))
+        panic(C_text("Detected corrupted data in heap"));
       if(C_heap_size_is_fixed)
 	panic(C_text("out of memory - heap full"));
       
-- 
2.1.4

From 9bbed3708e64e9a99d13beb556480f1541ca1fed Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 16:45:26 +0200
Subject: [PATCH 3/4] Make memory demand for rest-args list more precise.

When allocating a list for holding rest args, instead of demanding
memory corresponding to the total argument count, we should only
demand memory for the rest arguments.  This now matches the allocation
that corresponds to the demand, just before calling C_build_rest().

Conflicts:
	c-backend.scm
---
 c-backend.scm | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/c-backend.scm b/c-backend.scm
index 0473797..9f2f315 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -790,7 +790,7 @@
 		  (lambda (ubt)
 		    (gen #t (utype (cdr ubt)) #\space (car ubt) #\;))
 		  ubtemps)))
-	   (cond [(eq? 'toplevel id) 
+	   (cond ((eq? 'toplevel id) 
 		  (let ([ldemand (foldl (lambda (n lit) (+ n (literal-size lit))) 0 literals)]
 			[llen (length literals)] )
 		    (gen #t "C_word *a;"
@@ -817,14 +817,14 @@
 		      (gen #t "C_initialize_lf(lf," llen ");")
 		      (literal-frame)
 		      (gen #t "C_register_lf2(lf," llen ",create_ptable());"))
-		    (gen #\{) ) ]
-		 [rest
+		    (gen #\{) ) )
+		 (rest
 		  (gen #t "C_word *a;")
 		  (when (and (not unsafe) (not no-argc-checks) (> n 2) (not empty-closure))
 		    (gen #t "if(c<" n ") C_bad_min_argc_2(c," n ",t0);") )
 		  (when insert-timer-checks (gen #t "C_check_for_interrupt;"))
-		  (gen #t "if(!C_demand(c*C_SIZEOF_PAIR+" demand ")){") ]
-		 [else
+		  (gen #t "if(!C_demand((c-" n ")*C_SIZEOF_PAIR +" demand ")){") )
+		 (else
 		  (cond [(and (not direct) (> demand 0))
 			 (if looping
 			     (gen #t "C_word *a;"
@@ -846,7 +846,7 @@
 			 (if (and looping (> demand 0))
 			     (gen #t "if(!C_stack_probe(a)){")
 			     (gen #t "if(!C_stack_probe(&a)){") ) )
-			(else (gen #\{)))])
+			(else (gen #\{)))))
 	   (cond ((and (not (eq? 'toplevel id))
 		       (not direct)
 		       (or rest external (> demand 0)) )
-- 
2.1.4

From 435719c7fc9d8674bd1cbf386bb0d8bf0819355c Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 16:47:09 +0200
Subject: [PATCH 4/4] Make literal-size calculation for symbols more precise.

Symbol literals take up a symbol (size 4) and a bucket (size 3), for a
total of 7, not 10.

Conflicts:
	c-backend.scm
---
 c-backend.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/c-backend.scm b/c-backend.scm
index 9f2f315..9e7dab6 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -655,7 +655,7 @@
 	    ((string? lit) 0)		; statically allocated
 	    ((bignum? lit) 3)		; internal vector statically allocated
 	    ((flonum? lit) words-per-flonum)
-	    ((symbol? lit) 10)          ; size of symbol, and possibly a bucket
+	    ((symbol? lit) 7)           ; size of symbol, and possibly a bucket
 	    ((pair? lit) (+ 3 (literal-size (car lit)) (literal-size (cdr lit))))
 	    ((vector? lit)
 	     (+ 1 (vector-length lit)
-- 
2.1.4

From 1820a69df1d7f6d60bcf220793482facb0273c54 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 13:10:33 +0200
Subject: [PATCH 1/4] 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.
---
 NEWS                               |  3 +++
 chicken.h                          |  2 +-
 distribution/manifest              |  1 +
 runtime.c                          | 14 ++++++++++++--
 tests/heap-literal-stress-test.scm | 16 ++++++++++++++++
 tests/runtests.bat                 | 11 +++++++++++
 tests/runtests.sh                  |  7 +++++++
 7 files changed, 51 insertions(+), 3 deletions(-)
 create mode 100644 tests/heap-literal-stress-test.scm

diff --git a/NEWS b/NEWS
index 6020e43..4cd6a9e 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 6bacf75..d50d291 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 430f469..34c6ae3 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 10d70f7..a4d346f 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 0000000..964b16a
--- /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 b6ef378..9539bd4 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 7e078ff..5200f1f 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.
-- 
2.1.4

From 95b2af8f9d584125e9dede639a08c8543bea2f89 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 13:19:36 +0200
Subject: [PATCH 2/4] Try to detect corrupted data before performing
 GC_REALLOC.

If an "impossible" object in the stack or heap: one that has a size
that's larger than the memory area that contains it, we know we have a
data corruption on our hands.  Panic immediately instead of going in
for the reallocating GC.  This prevents the memory state from being
mutated any more, which may help in debugging.
---
 runtime.c | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/runtime.c b/runtime.c
index a4d346f..43edfe9 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3214,6 +3214,11 @@ C_regparm void C_fcall really_mark(C_word *x)
     bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word);
 
     if(((C_byte *)p2 + bytes + sizeof(C_word)) > tospace_limit) {
+      /* Detect impossibilities before GC_REALLOC to preserve state: */
+      if (C_in_stackp((C_word)p) && bytes > stack_size)
+        panic(C_text("Detected corrupted data in stack"));
+      if (C_in_heapp((C_word)p) && bytes > (heap_size / 2))
+        panic(C_text("Detected corrupted data in heap"));
       if(C_heap_size_is_fixed)
 	panic(C_text("out of memory - heap full"));
       
-- 
2.1.4

From cca6daa7716ed645d69f1eff0348f87ea83593c4 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 15:47:35 +0200
Subject: [PATCH 3/4] Make memory demand for rest-args list more precise.

When allocating a list for holding rest args, instead of demanding
memory corresponding to the total argument count, we should only
demand memory for the rest arguments.  This now matches the allocation
that corresponds to the demand, just before calling C_build_rest().
---
 c-backend.scm | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/c-backend.scm b/c-backend.scm
index 0832475..c70661e 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -774,7 +774,7 @@
 		  (lambda (ubt)
 		    (gen #t (utype (cdr ubt)) #\space (car ubt) #\;))
 		  ubtemps)))
-	   (cond [(eq? 'toplevel id) 
+	   (cond ((eq? 'toplevel id)
 		  (let ([ldemand (fold (lambda (lit n) (+ n (literal-size lit))) 0 literals)]
 			[llen (length literals)] )
 		    (gen #t "C_word *a;"
@@ -801,14 +801,14 @@
 		      (gen #t "C_initialize_lf(lf," llen ");")
 		      (literal-frame)
 		      (gen #t "C_register_lf2(lf," llen ",create_ptable());"))
-		    (gen #\{) ) ]
-		 [rest
+		    (gen #\{) ) )
+		 (rest
 		  (gen #t "C_word *a;")
 		  (when (and (not unsafe) (not no-argc-checks) (> n 2) (not empty-closure))
 		    (gen #t "if(c<" n ") C_bad_min_argc_2(c," n ",t0);") )
 		  (when insert-timer-checks (gen #t "C_check_for_interrupt;"))
-		  (gen #t "if(!C_demand(c*C_SIZEOF_PAIR+" demand ")){") ]
-		 [else
+		  (gen #t "if(!C_demand((c-" n ")*C_SIZEOF_PAIR +" demand ")){") )
+		 (else
 		  (cond [(and (not direct) (> demand 0))
 			 (if looping
 			     (gen #t "C_word *a;"
@@ -830,7 +830,7 @@
 			 (if (and looping (> demand 0))
 			     (gen #t "if(!C_stack_probe(a)){")
 			     (gen #t "if(!C_stack_probe(&a)){") ) )
-			(else (gen #\{)))])
+			(else (gen #\{)))))
 	   (cond ((and (not (eq? 'toplevel id))
 		       (not direct)
 		       (or rest external (> demand 0)) )
-- 
2.1.4

From 96339116e71b54b4341401fcc258176e26293b39 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 17 Oct 2015 15:50:06 +0200
Subject: [PATCH 4/4] Make literal-size calculation for symbols more precise.

Symbol literals take up a symbol (size 4) and a bucket (size 3), for a
total of 7, not 10.
---
 c-backend.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/c-backend.scm b/c-backend.scm
index c70661e..7374783 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -641,7 +641,7 @@
       (cond [(immediate? lit) 0]
 	    [(string? lit) 0]
 	    [(number? lit) words-per-flonum]
-	    [(symbol? lit) 10]		; size of symbol, and possibly a bucket
+	    [(symbol? lit) 7]		; size of symbol, and possibly a bucket
 	    [(pair? lit) (+ 3 (literal-size (car lit)) (literal-size (cdr lit)))]
 	    [(vector? lit) (+ 1 (vector-length lit) (reduce + 0 (map literal-size (vector->list lit))))]
 	    [(block-variable-literal? lit) 0]
-- 
2.1.4

Attachment: signature.asc
Description: Digital signature

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to