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.

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:

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;

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

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