diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-05-26 23:00:58 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-05-26 23:41:23 +0200 |
commit | f1046e6b78f3044db6d9fd64cf272864366a1182 (patch) | |
tree | 8b12f0cdcc257a75372ed88e8b63708048ea1d4d | |
parent | 01fded8c776feba9cb721996414dd98cd687e917 (diff) | |
download | guile-f1046e6b78f3044db6d9fd64cf272864366a1182.tar.gz |
Raise an exception upon VM stack overflows (fixes bug #29574).
* libguile/vm-engine.c (VM_NAME)[vm_error_stack_overflow]: Increase
`vp->stack_limit' when possible.
* libguile/vm.c (VM_STACK_RESERVE_SIZE): New macro.
* test-suite/lib.scm (exception:vm-error): New variable.
* test-suite/tests/eval.test ("stack overflow"): New test prefix.
-rw-r--r-- | libguile/vm-engine.c | 4 | ||||
-rw-r--r-- | libguile/vm.c | 9 | ||||
-rw-r--r-- | test-suite/lib.scm | 3 | ||||
-rw-r--r-- | test-suite/tests/eval.test | 13 |
4 files changed, 26 insertions, 3 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 1976f7107..11981ba30 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -188,6 +188,10 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) vm_error_stack_overflow: err_msg = scm_from_locale_string ("VM: Stack overflow"); finish_args = SCM_EOL; + if (stack_limit < vp->stack_base + vp->stack_size) + /* There are VM_STACK_RESERVE_SIZE bytes left. Make them available so + that `throw' below can run on this VM. */ + vp->stack_limit = vp->stack_base + vp->stack_size; goto vm_error; vm_error_stack_underflow: diff --git a/libguile/vm.c b/libguile/vm.c index 1f3e1f85b..e036b63e1 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -65,6 +65,10 @@ for a discussion. */ #define VM_ENABLE_PRECISE_STACK_GC_SCAN +/* Size in SCM objects of the stack reserve. The reserve is used to run + exception handling code in case of a VM stack overflow. */ +#define VM_STACK_RESERVE_SIZE 512 + /* @@ -505,7 +509,7 @@ make_vm (void) #ifdef VM_ENABLE_STACK_NULLING memset (vp->stack_base, 0, vp->stack_size * sizeof (SCM)); #endif - vp->stack_limit = vp->stack_base + vp->stack_size; + vp->stack_limit = vp->stack_base + vp->stack_size - VM_STACK_RESERVE_SIZE; vp->ip = NULL; vp->sp = vp->stack_base - 1; vp->fp = NULL; @@ -534,8 +538,7 @@ vm_stack_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr, vm = * ((struct scm_vm **) addr); if (vm == NULL - || (SCM *) addr != vm->stack_base - 1 - || vm->stack_limit - vm->stack_base != vm->stack_size) + || (SCM *) addr != vm->stack_base - 1) /* ADDR must be a pointer to a free-list element, which we must ignore (see warning in <gc/gc_mark.h>). */ return mark_stack_ptr; diff --git a/test-suite/lib.scm b/test-suite/lib.scm index f32c7c308..235a10195 100644 --- a/test-suite/lib.scm +++ b/test-suite/lib.scm @@ -37,6 +37,7 @@ exception:string-contains-nul exception:read-error exception:null-pointer-error + exception:vm-error ;; Reporting passes and failures. run-test @@ -281,6 +282,8 @@ (cons 'read-error "^.*$")) (define exception:null-pointer-error (cons 'null-pointer-error "^.*$")) +(define exception:vm-error + (cons 'vm-error "^.*$")) ;; as per throw in scm_to_locale_stringn() (define exception:string-contains-nul diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test index 8c0652215..83820f72e 100644 --- a/test-suite/tests/eval.test +++ b/test-suite/tests/eval.test @@ -18,6 +18,7 @@ (define-module (test-suite test-eval) :use-module (test-suite lib) :use-module ((srfi srfi-1) :select (unfold count)) + :use-module ((system vm vm) :select (make-vm vm-apply)) :use-module (ice-9 documentation)) @@ -439,4 +440,16 @@ (pass-if "equal?" (equal? (values 1 2 3 4) (values 1 2 3 4)))) +;;; +;;; stack overflow handling +;;; + +(with-test-prefix "stack overflow" + + (pass-if-exception "exception raised" + exception:vm-error + (let ((vm (make-vm)) + (thunk (let loop () (cons 's (loop))))) + (vm-apply vm thunk)))) + ;;; eval.test ends here |