From 5b63d92fb05797f07ab16ae402568c2d76eae5fd Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sat, 31 Oct 2015 19:57:38 +0100 Subject: [PATCH] Dynamically resize temporary stack when needed. When the argcount is extremely large, the temporary stack can be resized to fit the arguments on GC. The default temporary stack size can thus be lowered, because the size no longer has to fit the worst case. This fixes #1098. --- NEWS | 2 ++ chicken.h | 3 +-- library.scm | 2 +- runtime.c | 48 ++++++++++++++++++++++++++++++------------------ tests/apply-test.scm | 35 ++++++++++++++++++++--------------- tests/runtests.bat | 4 ++-- tests/runtests.sh | 4 ++-- 7 files changed, 58 insertions(+), 40 deletions(-) diff --git a/NEWS b/NEWS index 19b6936..8313e8f 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,8 @@ now return exact numbers where possible, so code relying on flonums being returned may need to be changed if rational numbers do not provide the desired performance. + - The number of arguments to procedures, both via "apply" and direct + invocation, are now limited only by the C stack size (#1098). - Compiler - Fixed an off by one allocation problem in generated C code for (list ...). diff --git a/chicken.h b/chicken.h index 701881d..6eb6872 100644 --- a/chicken.h +++ b/chicken.h @@ -632,7 +632,7 @@ static inline int isinf_ld (long double x) #define C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR 2 #define C_BAD_ARGUMENT_TYPE_ERROR 3 #define C_UNBOUND_VARIABLE_ERROR 4 -#define C_TOO_MANY_PARAMETERS_ERROR 5 +/* Unused: 5 */ #define C_OUT_OF_MEMORY_ERROR 6 #define C_DIVISION_BY_ZERO_ERROR 7 #define C_OUT_OF_RANGE_ERROR 8 @@ -1798,7 +1798,6 @@ C_fctexport void C_bad_min_argc(int c, int n) C_noret; C_fctexport void C_bad_argc_2(int c, int n, C_word closure) C_noret; C_fctexport void C_bad_min_argc_2(int c, int n, C_word closure) C_noret; C_fctexport void C_stack_overflow(void) C_noret; -C_fctexport void C_temp_stack_overflow(void) C_noret; C_fctexport void C_unbound_error(C_word sym) C_noret; C_fctexport void C_no_closure_error(C_word x) C_noret; C_fctexport void C_div_by_zero_error(char *loc) C_noret; diff --git a/library.scm b/library.scm index bb49d8b..37486fd 100644 --- a/library.scm +++ b/library.scm @@ -4908,7 +4908,7 @@ EOF (if fn (list fn) '())))) ((3) (apply ##sys#signal-hook #:type-error loc "bad argument type" args)) ((4) (apply ##sys#signal-hook #:runtime-error loc "unbound variable" args)) - ((5) (apply ##sys#signal-hook #:limit-error loc "parameter limit exceeded" args)) + ;; ((5) ...unused...) ((6) (apply ##sys#signal-hook #:limit-error loc "out of memory" args)) ((7) (apply ##sys#signal-hook #:arithmetic-error loc "division by zero" args)) ((8) (apply ##sys#signal-hook #:bounds-error loc "out of range" args)) diff --git a/runtime.c b/runtime.c index 05fcd98..6b5b6b0 100644 --- a/runtime.c +++ b/runtime.c @@ -162,7 +162,7 @@ static C_TLS int timezone; #define WEAK_COUNTER_MASK 3 #define WEAK_COUNTER_MAX 2 -#define TEMPORARY_STACK_SIZE 4096 +#define DEFAULT_TEMPORARY_STACK_SIZE 1024 #define STRING_BUFFER_SIZE 4096 #define DEFAULT_MUTATION_STACK_SIZE 1024 @@ -401,7 +401,8 @@ static C_TLS size_t heapspace1_size, heapspace2_size, heap_size, - scratchspace_size; + scratchspace_size, + temporary_stack_size; static C_TLS C_char buffer[ STRING_BUFFER_SIZE ], *private_repository = NULL, @@ -712,10 +713,11 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel) C_set_or_change_heap_size(heap ? heap : DEFAULT_HEAP_SIZE, 0); /* Allocate temporary stack: */ - if((C_temporary_stack_limit = (C_word *)C_malloc(TEMPORARY_STACK_SIZE * sizeof(C_word))) == NULL) + temporary_stack_size = DEFAULT_TEMPORARY_STACK_SIZE; + if((C_temporary_stack_limit = (C_word *)C_malloc(temporary_stack_size * sizeof(C_word))) == NULL) return 0; - C_temporary_stack_bottom = C_temporary_stack_limit + TEMPORARY_STACK_SIZE; + C_temporary_stack_bottom = C_temporary_stack_limit + temporary_stack_size; C_temporary_stack = C_temporary_stack_bottom; /* Allocate mutation stack: */ @@ -1621,11 +1623,6 @@ void barf(int code, char *loc, ...) c = 1; break; - case C_TOO_MANY_PARAMETERS_ERROR: - msg = C_text("parameter limit exceeded"); - c = 0; - break; - case C_OUT_OF_MEMORY_ERROR: msg = C_text("not enough memory"); c = 0; @@ -2501,14 +2498,6 @@ void C_stack_overflow_with_msg(C_char *msg) barf(C_STACK_OVERFLOW_ERROR, NULL); } -void C_temp_stack_overflow(void) -{ - /* Just raise a "too many parameters" error; it isn't very useful to - show a different message here. */ - barf(C_TOO_MANY_PARAMETERS_ERROR, NULL); -} - - void C_unbound_error(C_word sym) { barf(C_UNBOUND_VARIABLE_ERROR, NULL, sym); @@ -3106,9 +3095,32 @@ C_regparm C_word C_fcall C_mutate_scratch_slot(C_word *slot, C_word val) void C_save_and_reclaim(void *trampoline, int n, C_word *av) { + C_word new_size = nmax(1UL << C_ilen(n), DEFAULT_TEMPORARY_STACK_SIZE); + assert(av > C_temporary_stack_bottom || av < C_temporary_stack_limit); assert(C_temporary_stack == C_temporary_stack_bottom); + /* Don't *immediately* slam back to default size */ + if (new_size < temporary_stack_size) + new_size = temporary_stack_size >> 1; + + if (new_size != temporary_stack_size) { + if(debug_mode) { + C_dbg(C_text("debug"), C_text("resizing temp stack dynamically from " UWORD_COUNT_FORMAT_STRING "k to " UWORD_COUNT_FORMAT_STRING "k ...\n"), + C_wordstobytes(temporary_stack_size) / 1024, + C_wordstobytes(new_size) / 1024); + } + + C_free(C_temporary_stack_limit); + + if((C_temporary_stack_limit = (C_word *)C_malloc(new_size * sizeof(C_word))) == NULL) + panic(C_text("out of memory - could not resize temporary stack")); + + C_temporary_stack_bottom = C_temporary_stack_limit + new_size; + C_temporary_stack = C_temporary_stack_bottom; + temporary_stack_size = new_size; + } + C_temporary_stack = C_temporary_stack_bottom - n; assert(C_temporary_stack >= C_temporary_stack_limit); @@ -4753,7 +4765,7 @@ C_regparm C_word C_fcall C_fudge(C_word fudge_factor) return C_fix(C_getpid()); case C_fix(34): /* effective maximum for procedure arguments */ - return C_fix(TEMPORARY_STACK_SIZE); + return C_fix(stack_size / 2); /* An educated guess :) */ case C_fix(35): /* unused */ /* used to be apply-hook indicator */ diff --git a/tests/apply-test.scm b/tests/apply-test.scm index 3ec491c..6140bcd 100644 --- a/tests/apply-test.scm +++ b/tests/apply-test.scm @@ -18,30 +18,35 @@ (car lst) (loop (cdr lst))))) -(when (feature? 'manyargs) (print "many arguments supported.")) +;; Non-manyarg CHICKENs are no longer made +(assert (feature? 'manyargs)) (define (foo . args) (when (pair? args) (assert (= (length args) (last args))))) -(printf "testing 'apply' with 0..~A (maximum apply argument count)...\n" 2000) +(printf "testing 'apply' with 0..~A...\n" 2000) (do ((i 0 (add1 i))) ((>= i 2000)) (apply foo (list-tabulate i add1))) +(print "testing 'apply' with 10000...") +(apply foo (list-tabulate 10000 add1)) + (let-syntax ((invoke-directly (ir-macro-transformer - (lambda (i r c) - `(begin - (print "invoking directly with 0..50...") - ;; Lowest edge cases - ,@(list-tabulate 50 (lambda (i) `(foo ,@(list-tabulate i add1)))) - (printf "invoking directly with ~A..~A (maximum ~A direct argument count)...\n" - ,(- 2000 50) 2000 - (cond-expand (compiling "compiled") (else "interpreted"))) - ;; Highest edge cases - ,@(list-tabulate - 50 (lambda (i) `(foo ,@(list-tabulate (- 2000 i) add1))))))))) - (print "If this segfaults on x86-64, try updating GCC (4.5 has a code-generation bug):") - (invoke-directly)) + (lambda (e r c) + (let ((proc (cadr e)) + (count (caddr e)) + (end (cadddr e)) + (message (car (cddddr e)))) + `(begin + (printf "invoking directly with ~A..~A (~A)...\n" + ,(- end count) ,end ,message) + ,@(list-tabulate + count + (lambda (i) + `(,proc ,@(list-tabulate (- end i) add1)))))))))) + (invoke-directly foo 50 50 "Lower edge case") + (invoke-directly foo 50 2000 "Lower edge case")) diff --git a/tests/runtests.bat b/tests/runtests.bat index 9511ca5..10651a9 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -119,11 +119,11 @@ if errorlevel 1 ( ) echo ======================================== runtime tests ... -%interpret% -s apply-test.scm +%interpret% -:d -s apply-test.scm if errorlevel 1 exit /b 1 %compile% apply-test.scm if errorlevel 1 exit /b 1 -a.out +a.out -:d if errorlevel 1 exit /b 1 %compile% test-gc-hooks.scm if errorlevel 1 exit /b 1 diff --git a/tests/runtests.sh b/tests/runtests.sh index 05d6c42..e543411 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -149,9 +149,9 @@ else fi echo "======================================== runtime tests ..." -$interpret -s apply-test.scm +$interpret -:d -s apply-test.scm $compile apply-test.scm -./a.out +./a.out -:d $compile test-gc-hooks.scm ./a.out -- 2.1.4