0.8.14.24: En Garde!

            * Robuster control stack exhaustion handling:
               automagically reprotect the guard-page after enough
               stack has unwound.
            * Simple stress tests for this.

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 25b8943..6e6c4a7 100644 (file)
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -701,17 +701,31 @@ void thread_exit_handler(int num, siginfo_t *info, void *v_context)
 
 boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr){
     struct thread *th=arch_os_get_current_thread();
+    
     /* note the os_context hackery here.  When the signal handler returns, 
      * it won't go back to what it was doing ... */
-    if(addr>=(void *)CONTROL_STACK_GUARD_PAGE(th) && 
-       addr<(void *)(CONTROL_STACK_GUARD_PAGE(th)+os_vm_page_size)) {
-       /* we hit the end of the control stack.  disable protection
-        * temporarily so the error handler has some headroom */
-       protect_control_stack_guard_page(th->pid,0L);
-       
-       arrange_return_to_lisp_function
-           (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
-       return 1;
+    if(addr >= CONTROL_STACK_GUARD_PAGE(th) && 
+       addr < CONTROL_STACK_GUARD_PAGE(th) + os_vm_page_size) {
+        /* We hit the end of the control stack: disable guard page
+         * protection so the error handler has some headroom, protect the
+         * previous page so that we can catch returns from the guard page
+         * and restore it. */
+        protect_control_stack_guard_page(th->pid,0);
+        protect_control_stack_return_guard_page(th->pid,1);
+        
+        arrange_return_to_lisp_function
+            (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
+        return 1;
+    }
+    else if(addr >= CONTROL_STACK_RETURN_GUARD_PAGE(th) &&
+            addr < CONTROL_STACK_RETURN_GUARD_PAGE(th) + os_vm_page_size) {
+        /* We're returning from the guard page: reprotect it, and
+         * unprotect this one. This works even if we somehow missed
+         * the return-guard-page, and hit it on our way to new
+         * exhaustion instead. */
+        protect_control_stack_guard_page(th->pid,1);
+        protect_control_stack_return_guard_page(th->pid,0);
+        return 1;
     }
     else return 0;
 }

diff --git a/src/runtime/validate.c b/src/runtime/validate.c
index a7e9a3d..2c01436 100644 (file)
--- a/src/runtime/validate.c
+++ b/src/runtime/validate.c
@@ -69,3 +69,9 @@ void protect_control_stack_guard_page(pid_t t_id, int protect_p) {
               (OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
 }
 
+void protect_control_stack_return_guard_page(pid_t t_id, int protect_p) {
+    struct thread *th = find_thread_by_pid(t_id);
+    os_protect(CONTROL_STACK_RETURN_GUARD_PAGE(th),
+              os_vm_page_size,protect_p ?
+              (OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
+}

diff --git a/src/runtime/validate.h b/src/runtime/validate.h
index 36c973c..bc7ca14 100644 (file)
--- a/src/runtime/validate.h
+++ b/src/runtime/validate.h
@@ -27,13 +27,15 @@
 #include <thread.h>
 #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD 
 #define CONTROL_STACK_GUARD_PAGE(th) ((void *)(th->control_stack_start))
+#define CONTROL_STACK_RETURN_GUARD_PAGE(th) (CONTROL_STACK_GUARD_PAGE(th) + os_vm_page_size)
 #else
-#define CONTROL_STACK_GUARD_PAGE(th) \
-     (((void *)(th->control_stack_end)) - os_vm_page_size)
+#define CONTROL_STACK_GUARD_PAGE(th) (((void *)(th->control_stack_end)) - os_vm_page_size)
+#define CONTROL_STACK_RETURN_GUARD_PAGE(th) (CONTROL_STACK_GUARD_PAGE(th) - os_vm_page_size)
 #endif
 
 extern void validate(void);
 extern void protect_control_stack_guard_page(pid_t t_id, int protect_p);
+extern void protect_control_stack_return_guard_page(pid_t t_id, int protect_p);
 #endif
 
 /* note for anyone trying to port an architecture's support files

diff --git a/tests/exhaust.impure.lisp b/tests/exhaust.impure.lisp
index fc432b4..bc4dd7b 100644 (file)
--- a/tests/exhaust.impure.lisp
+++ b/tests/exhaust.impure.lisp
@@ -21,12 +21,54 @@
 ;;; Post 0.7.6.1, this was rewritten to use mprotect()-based stack
 ;;; protection which does not require lisp code to check anything,
 ;;; and works at all optimization settings.  However, it now signals a
-;;; STORAGE-CONDITION instead of an ERROR, so this test needs revising
-(locally
-  (defun recurse () (recurse) (recurse))
-  (handler-case
-    (recurse)
-    (storage-condition (c) (declare (ignore c)) (quit :unix-status 104))))
-\f
-;;; oops
-(quit :unix-status 1)
+;;; STORAGE-CONDITION instead of an ERROR.
+
+(defun recurse () 
+  (recurse) 
+  (recurse))
+
+(defvar *count* 100)
+
+;;; Base-case: detecting exhaustion
+(assert (eq :exhausted
+            (handler-case
+                (recurse)
+              (storage-condition (c) 
+                (declare (ignore c))
+                :exhausted))))
+
+;;; Check that non-local control transfers restore the stack
+;;; exhaustion checking after unwinding -- and that previous test
+;;; didn't break it.
+(let ((exhaust-count 0)
+      (recurse-count 0))
+  (tagbody
+     :retry
+     (handler-bind ((storage-condition (lambda (c)
+                                         (declare (ignore c))
+                                         (if (= *count* (incf exhaust-count))
+                                             (go :stop)
+                                             (go :retry)))))
+       (incf recurse-count)
+       (recurse))
+     :stop)
+  (assert (= exhaust-count recurse-count *count*)))
+
+;;; Check that we can safely use user-provided restarts to
+;;; unwind.
+(let ((exhaust-count 0)
+      (recurse-count 0))
+  (block nil
+   (handler-bind ((storage-condition (lambda (c)
+                                       (declare (ignore c))
+                                       (if (= *count* (incf exhaust-count))
+                                           (return)
+                                           (invoke-restart (find-restart 'ok))))))
+      (loop
+       (with-simple-restart (ok "ok")
+         (incf recurse-count)
+         (recurse)))))
+  (assert (= exhaust-count recurse-count *count*)))
+
+;;; OK!
+(quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 2ac5955..4930792 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.14.23"
+"0.8.14.24"