~ chicken-core (chicken-5) 9eed2742d4adcec1e60fb7cdfaa1fd621b645965
commit 9eed2742d4adcec1e60fb7cdfaa1fd621b645965
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Thu Oct 1 15:57:56 2015 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Sun Oct 4 20:43:58 2015 +1300
Avoid allocating argvectors on the temporary stack.
The temporary stack should be strictly reserved for setting aside live
data just before performing a GC & longjump (which resets the stack).
There are several problems with (ab)using the temporary stack in non-GC
situations, which surfaced only after the re-use of argvectors was made
more prevalent:
1) Anything allocated on the temp stack will be kept around during a GC,
which may cause objects to unnecessarily stick around for another round
of GC.
2) When the longjmp is performed, if the argvector is allocated in the
temporary stack and then the temporary_stack pointer is reset, we may
scribble over the argvector whenever something is put on the temp stack.
With argvector re-use, this will more commonly trigger errors.
Now the restart trampoline will move the saved data from the temporary
stack to the C stack. This should probably slightly more cause garbage
collection events, but it will also make it easier to eventually make
a dynamically allocated temporary stack (see also #1098).
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/runtime.c b/runtime.c
index ac4a84a8..c2909e92 100644
--- a/runtime.c
+++ b/runtime.c
@@ -1410,8 +1410,9 @@ C_word CHICKEN_run(void *toplevel)
serious_signal_occurred = 0;
if(!return_to_host) {
- C_word *p = C_temporary_stack;
-
+ int argcount = C_temporary_stack_bottom - C_temporary_stack;
+ C_word *p = C_alloc(argcount);
+ C_memcpy(p, C_temporary_stack, argcount * sizeof(C_word));
C_temporary_stack = C_temporary_stack_bottom;
((C_proc)C_restart_trampoline)(C_restart_c, p);
}
@@ -1961,7 +1962,7 @@ C_word C_fcall C_callback_wrapper(void *proc, int argc)
*a = C_alloc(2),
closure = C_closure(&a, 1, (C_word)proc),
result;
-
+
result = C_callback(closure, argc);
assert(C_temporary_stack == C_temporary_stack_bottom);
return result;
@@ -2706,11 +2707,14 @@ C_mutate_slot(C_word *slot, C_word val)
void C_save_and_reclaim(void *trampoline, int n, C_word *av)
{
- if(C_temporary_stack != av) { /* used in apply */
- C_temporary_stack = C_temporary_stack_bottom - n;
- C_memmove(C_temporary_stack, av, n * sizeof(C_word));
- }
+ assert(av > C_temporary_stack_bottom || av < C_temporary_stack_limit);
+ assert(C_temporary_stack == C_temporary_stack_bottom);
+
+ C_temporary_stack = C_temporary_stack_bottom - n;
+ assert(C_temporary_stack >= C_temporary_stack_limit);
+
+ C_memmove(C_temporary_stack, av, n * sizeof(C_word));
C_reclaim(trampoline, n);
}
@@ -2836,6 +2840,8 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
mark(*msp);
}
+ assert(C_temporary_stack >= C_temporary_stack_limit);
+
/* Clear the mutated slot stack: */
mutation_stack_top = mutation_stack_bottom;
@@ -5958,41 +5964,41 @@ void C_ccall C_apply(C_word c, C_word *av)
/* closure = av[ 0 ] */
k = av[ 1 ],
fn = av[ 2 ];
- int i, n = c - 3;
- int m = n - 1;
- C_word x, skip, *ptr;
+ int av2_size, i, n = c - 3;
+ int non_list_args = n - 1;
+ C_word lst, *ptr, *av2;
if(c < 4) C_bad_min_argc(c, 4);
if(C_immediatep(fn) || C_header_bits(fn) != C_CLOSURE_TYPE)
barf(C_NOT_A_CLOSURE_ERROR, "apply", fn);
- ptr = C_temporary_stack_limit;
- *(ptr++) = fn;
- *(ptr++) = k;
+ lst = av[ c - 1 ];
+ if(lst != C_SCHEME_END_OF_LIST && (C_immediatep(lst) || C_block_header(lst) != C_PAIR_TAG))
+ barf(C_BAD_ARGUMENT_TYPE_ERROR, "apply", lst);
- if(n > 1) {
- C_memmove(ptr, av + 3, m * sizeof(C_word));
- ptr += m;
- }
+ av2_size = 2 + non_list_args + C_unfix(C_u_i_length(lst));
- x = av[ c - 1 ];
+ if(!C_demand(av2_size))
+ C_save_and_reclaim((void *)C_apply, c, av);
- if(x != C_SCHEME_END_OF_LIST && (C_immediatep(x) || C_block_header(x) != C_PAIR_TAG))
- barf(C_BAD_ARGUMENT_TYPE_ERROR, "apply", x);
+ av2 = ptr = C_alloc(av2_size);
+ *(ptr++) = fn;
+ *(ptr++) = k;
- for(skip = x; !C_immediatep(skip) && C_block_header(skip) == C_PAIR_TAG; skip = C_u_i_cdr(skip)) {
- x = C_u_i_car(skip);
-
- if(ptr >= C_temporary_stack_bottom)
- barf(C_TOO_MANY_PARAMETERS_ERROR, "apply");
+ if(non_list_args > 0) {
+ C_memcpy(ptr, av + 3, non_list_args * sizeof(C_word));
+ ptr += non_list_args;
+ }
- *(ptr++) = x;
- ++m;
+ while(!C_immediatep(lst) && C_block_header(lst) == C_PAIR_TAG) {
+ *(ptr++) = C_u_i_car(lst);
+ lst = C_u_i_cdr(lst);
}
- C_temporary_stack = C_temporary_stack_bottom;
- ((C_proc)(void *)C_block_item(fn, 0))(m + 2, C_temporary_stack_limit);
+ assert((ptr - av2) == av2_size);
+
+ ((C_proc)(void *)C_block_item(fn, 0))(av2_size, av2);
}
@@ -6109,22 +6115,27 @@ void C_ccall C_apply_values(C_word c, C_word *av)
lst = av[ 2 ];
+ if(lst != C_SCHEME_END_OF_LIST && (C_immediatep(lst) || C_block_header(lst) != C_PAIR_TAG))
+ barf(C_BAD_ARGUMENT_TYPE_ERROR, "apply", lst);
+
/* Check continuation wether it receives multiple values: */
if(C_block_item(k, 0) == (C_word)values_continuation) {
- C_word
- *av2,
- *ptr = C_temporary_stack_limit;
+ C_word *av2, *ptr;
- for(n = 0; !C_immediatep(lst) && C_block_header(lst) == C_PAIR_TAG; ++n) {
+ n = C_unfix(C_u_i_length(lst)) + 1;
+
+ if(!C_demand(n))
+ C_save_and_reclaim((void *)C_apply_values, c, av);
+
+ av2 = C_alloc(n + 1);
+ av2[ 0 ] = k;
+ ptr = av2 + 1;
+ while(!C_immediatep(lst) && C_block_header(lst) == C_PAIR_TAG) {
*(ptr++) = C_u_i_car(lst);
lst = C_u_i_cdr(lst);
}
- /* copy into new array */
- av2 = C_alloc(n + 1);
- av2[ 0 ] = k;
- C_memcpy(av2 + 1, C_temporary_stack_limit, n * sizeof(C_word));
- C_do_apply(n + 1, av2);
+ C_do_apply(n, av2);
}
if(C_immediatep(lst)) {
@@ -7804,6 +7815,7 @@ void C_ccall C_fixnum_to_string(C_word c, C_word *av)
void C_ccall C_make_structure(C_word c, C_word *av)
{
if(!C_demand(c - 1)) {
+ assert(C_temporary_stack == C_temporary_stack_bottom);
C_temporary_stack = C_temporary_stack_bottom - (c - 1);
C_memmove(C_temporary_stack, av + 1, (c - 1) * sizeof(C_word));
C_reclaim((void *)make_structure_2, c - 1);
Trap