From a658c5f2789318fd90597aaaed04e7540c353cfc 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 4336f0f..8daba36 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 aaa82fd..c9fdfaf 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 @@ -1823,7 +1823,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 5203c52..b245a12 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/manual/Using the compiler b/manual/Using the compiler index 79b53c0..5c072ae 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 78bb3a6..8984ffb 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 @@ -403,7 +403,9 @@ static C_TLS C_uword heapspace1_size, heapspace2_size, heap_size, - scratchspace_size; + scratchspace_size, + temporary_stack_size, + fixed_temporary_stack_size = 0; static C_TLS C_char buffer[ STRING_BUFFER_SIZE ], *private_repository = NULL, @@ -714,10 +716,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: */ @@ -1344,6 +1347,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" @@ -1405,6 +1409,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; @@ -1641,11 +1649,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; @@ -2521,14 +2524,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); @@ -3129,9 +3124,36 @@ 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(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); @@ -4790,7 +4812,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 7458989..8136668 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -119,12 +119,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 b02b716..aa60e39 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -150,9 +150,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