summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-05-26 23:00:58 +0200
committerLudovic Courtès <ludo@gnu.org>2010-05-26 23:41:23 +0200
commitf1046e6b78f3044db6d9fd64cf272864366a1182 (patch)
tree8b12f0cdcc257a75372ed88e8b63708048ea1d4d
parent01fded8c776feba9cb721996414dd98cd687e917 (diff)
downloadguile-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.c4
-rw-r--r--libguile/vm.c9
-rw-r--r--test-suite/lib.scm3
-rw-r--r--test-suite/tests/eval.test13
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