From 45fbf9edb8600b35ce03fc6aa90c3719e58c113d 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 +- manual/Using the compiler | 2 ++ runtime.c | 58 ++++++++++++++++++++++++++++++++--------------- tests/apply-test.scm | 35 ++++++++++++++++------------ tests/runtests.bat | 13 +++++++++-- tests/runtests.sh | 11 +++++++-- 8 files changed, 86 insertions(+), 40 deletions(-) diff --git a/NEWS b/NEWS index b1a110d..643f972 100644 --- a/NEWS +++ b/NEWS @@ -19,6 +19,8 @@ which is faster because it is inlined (#1260, thanks to Kooda). - The default error handler now truncates very long condition messages (thanks to Lemonboy). + - The number of arguments to procedures, both via "apply" and direct + invocation, are now limited only by the C stack size (#1098). - Syntax expander - DSSSL lambda lists have improved hygiene, so they don't need diff --git a/chicken.h b/chicken.h index d451835..f5a706f 100644 --- a/chicken.h +++ b/chicken.h @@ -600,7 +600,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 @@ -1717,7 +1717,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 e95542f..6676d03 100644 --- a/library.scm +++ b/library.scm @@ -4199,7 +4199,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/manual/Using the compiler b/manual/Using the compiler index 2d0393d..f9c183e 100644 --- a/manual/Using the compiler +++ b/manual/Using the compiler @@ -194,6 +194,8 @@ compiler itself) accept a small set of runtime options: ; {{-:aNUMBER}} : Specifies the length of the buffer for recording a trace of the last invoked procedures. Defaults to 16. +; {{-:ANUMBER}} : Specifies fixed "temporary stack" size. This is used mostly for {{apply}}. If you supply a zero size (the default), the stack will be dynamically reallocated as needed. + ; {{-:b}} : Enter a read-eval-print-loop when an error is encountered. ; {{-:B}} : Sounds a bell (ASCII 7) on every major garbage collection. diff --git a/runtime.c b/runtime.c index cdaaa0e..5c28c62 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 #define PROFILE_TABLE_SIZE 1024 @@ -398,7 +398,9 @@ static C_TLS C_byte static C_TLS C_uword heapspace1_size, heapspace2_size, - heap_size; + heap_size, + temporary_stack_size, + fixed_temporary_stack_size = 0; static C_TLS C_char buffer[ STRING_BUFFER_SIZE ], *private_repository = NULL, @@ -671,10 +673,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 = fixed_temporary_stack_size ? fixed_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: */ @@ -1308,6 +1311,7 @@ void CHICKEN_parse_command_line(int argc, char *argv[], C_word *heap, C_word *st " -:B sound bell on major GC\n" " -:G force GUI mode\n" " -:aSIZE set trace-buffer/call-chain size\n" + " -:ASIZE set fixed temporary stack size\n" " -:H dump heap state on exit\n" " -:S do not handle segfaults or other serious conditions\n" "\n SIZE may have a `k' (`K'), `m' (`M') or `g' (`G') suffix, meaning size\n" @@ -1369,6 +1373,10 @@ void CHICKEN_parse_command_line(int argc, char *argv[], C_word *heap, C_word *st C_trace_buffer_size = arg_val(ptr); goto next; + case 'A': + fixed_temporary_stack_size = arg_val(ptr); + goto next; + case 't': *symbols = arg_val(ptr); goto next; @@ -1618,11 +1626,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; @@ -2426,14 +2429,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); @@ -2794,9 +2789,36 @@ C_mutate_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 << (int)ceil(log2(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(fixed_temporary_stack_size) + panic(C_text("fixed temporary stack overflow (\"apply\" called with too many arguments?)")); + + 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); @@ -4538,7 +4560,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 4996dd0..5c43d82 100644 --- a/tests/apply-test.scm +++ b/tests/apply-test.scm @@ -1,29 +1,34 @@ (require-extension srfi-1) -(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 (iota i 1))) +(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 ,@(iota i 1)))) - (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 ,@(iota (- 2000 i) 1))))))))) - (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 28ba4c8..d94ee9c 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -108,12 +108,21 @@ 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 +a.out -:A10k + +if errorlevel 1 ( + echo apply test with limited temp stack failed as it should. +) else ( + echo apply test with limited temp stack didn't fail + exit /b 1 +) + %compile% test-gc-hooks.scm if errorlevel 1 exit /b 1 a.out diff --git a/tests/runtests.sh b/tests/runtests.sh index d5d6f8e..4e8cea3 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -143,9 +143,16 @@ 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 +if ./a.out -:A10k; then + echo "apply test with limited temp stack didn't fail" + exit 1 +else + echo "apply test with limited temp stack failed as it should." +fi + $compile test-gc-hooks.scm ./a.out -- 2.1.4