Restore some basic stack exhaustion handling for windows arm64

The new approach from windows x86 with SetThreadStackGuarantee doesn't
work because the lisp control stack is separate and grows in the
opposite direction.

src/code/target-thread.lisp

@@ -1862,7 +1862,7 @@ session."
                      `(alien-funcall (extern-alien ,fun (function void int
                                                                   system-area-pointer))
                                      1 thread-sap)))
-          #-win32
+          #-(and win32 c-stack-is-control-stack)
           (prot "protect_control_stack_guard_page")
           (prot "protect_binding_stack_guard_page")
           (prot "protect_alien_stack_guard_page")))

src/runtime/arm64-win32-os.c

@@ -45,17 +45,8 @@
 
 int arch_os_thread_init(struct thread *thread)
 {
-    // On ARM64 Windows, we use the allocated Lisp control stack (from alloc_thread_struct),
-    // not the OS thread's C stack. Unlike x86-64 which uses C_STACK_IS_CONTROL_STACK,
-    // ARM64 has a separate Lisp control stack.
-    // Therefore, we do NOT call VirtualQuery here to overwrite control_stack_start/end.
-    // They have already been set correctly by alloc_thread_struct().
-
-    // CRITICAL: Set the TLS value so that get_sb_vm_thread() returns the correct thread!
-    // Without this, funcall0-3 will get the wrong thread from TlsGetValue.
-    extern DWORD OUR_TLS_INDEX;
-    TlsSetValue(OUR_TLS_INDEX, thread);
-
+    /* For some reason this is still needed, even though the control
+     * stack is seperate from the C stack and has its own guards */
     extern void win32_set_stack_guarantee(void);
     win32_set_stack_guarantee();
 

src/runtime/interrupt.c

@@ -1548,7 +1548,7 @@ undefined_alien_function(void)
 
 void lower_thread_control_stack_guard_page(__attribute__((unused)) struct thread *th)
 {
-#ifndef LISP_FEATURE_WIN32
+#if !(defined LISP_FEATURE_WIN32 && defined LISP_FEATURE_C_STACK_IS_CONTROL_STACK)
     protect_control_stack_guard_page(0, th);
     protect_control_stack_return_guard_page(1, th);
     th->state_word.control_stack_guard_page_protected = 0;
@@ -1606,7 +1606,7 @@ bool handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
 {
     struct thread *th = get_sb_vm_thread();
 
-#ifndef LISP_FEATURE_WIN32
+#if !(defined LISP_FEATURE_WIN32 && defined LISP_FEATURE_C_STACK_IS_CONTROL_STACK)
     if(addr >= CONTROL_STACK_HARD_GUARD_PAGE(th) &&
        addr < CONTROL_STACK_HARD_GUARD_PAGE(th) + os_vm_page_size) {
 #ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK

src/runtime/thread.c

@@ -320,14 +320,12 @@ void create_main_lisp_thread(lispobj function) {
     th->lisp_thread = cons_lisp_thread(th);
     SET_LISPTHREAD_TID(LISPTHREAD(th));
 
-#ifndef LISP_FEATURE_WIN32
+#if !(defined LISP_FEATURE_WIN32 && defined LISP_FEATURE_C_STACK_IS_CONTROL_STACK)
     protect_control_stack_hard_guard_page(1, th);
+    protect_control_stack_guard_page(1, th);
 #endif
     protect_binding_stack_hard_guard_page(1, th);
     protect_alien_stack_hard_guard_page(1, th);
-#ifndef LISP_FEATURE_WIN32
-    protect_control_stack_guard_page(1, th);
-#endif
     protect_binding_stack_guard_page(1, th);
     protect_alien_stack_guard_page(1, th);
 
@@ -383,7 +381,7 @@ init_new_thread(struct thread *th,
 #define GUARD_BINDING_STACK 2
 #define GUARD_ALIEN_STACK   4
 
-#ifndef LISP_FEATURE_WIN32
+#if !(defined LISP_FEATURE_WIN32 && defined LISP_FEATURE_C_STACK_IS_CONTROL_STACK)
     if (guardp & GUARD_CONTROL_STACK)
         protect_control_stack_guard_page(1, th);
 #endif

src/runtime/validate.c

@@ -120,7 +120,7 @@ protect_guard_page(void *page, int protect_p, os_vm_prot_t flags) {
         protect_guard_page(page_name(thread), protect_p, flags);        \
     }
 
-#ifndef LISP_FEATURE_WIN32
+#if !(defined LISP_FEATURE_WIN32 && defined LISP_FEATURE_C_STACK_IS_CONTROL_STACK)
 DEF_PROTECT_PAGE(control_stack_hard_guard_page,
                  CONTROL_STACK_HARD_GUARD_PAGE,
                  OS_VM_PROT_NONE)

src/runtime/validate.h

@@ -45,7 +45,7 @@
 #include <stdbool.h>
 #include "thread.h"
 
-#ifdef LISP_FEATURE_WIN32
+#if defined LISP_FEATURE_WIN32 && defined LISP_FEATURE_C_STACK_IS_CONTROL_STACK
 #define STACK_GUARD_SIZE (win32_page_size + win32_stack_guarantee)
 #else
 #define STACK_GUARD_SIZE os_vm_page_size

tests/exhaust.impure.lisp

@@ -11,7 +11,7 @@
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
-#+(or interpreter (and win32 arm64)) (invoke-restart 'run-tests::skip-file)
+#+interpreter (invoke-restart 'run-tests::skip-file)
 
 (test-util::disable-profiling)
 
@@ -63,7 +63,8 @@
 ;;; Check that non-local control transfers restore the stack
 ;;; exhaustion checking after unwinding -- and that previous test
 ;;; didn't break it.
-(with-test (:name (:exhaust :non-local-control))
+(with-test (:name (:exhaust :non-local-control)
+            :broken-on (and :win32 :arm64))
   (let ((exhaust-count 0)
         (recurse-count 0))
     (tagbody
@@ -80,7 +81,8 @@
 
 ;;; Check that we can safely use user-provided restarts to
 ;;; unwind.
-(with-test (:name (:exhaust :restarts))
+(with-test (:name (:exhaust :restarts)
+            :broken-on (and :win32 :arm64))
   (let ((exhaust-count 0)
         (recurse-count 0))
     (block nil
@@ -100,7 +102,7 @@
 ;;; memory protection set up by win32_reset_stack_overflow_guard_page(). This is
 ;;; certainly not fool proof, though.
 (with-test (:name (:exhaust :write-to-stack-on-unwind)
-            :skipped-on (not :win32))
+            :skipped-on (not (and :win32 :c-stack-is-control-stack)))
   (let ((count 0))
     (labels ((recurse-and-write-to-stack-on-unwind ()
                (let ((x (random 1.0)))
@@ -122,7 +124,7 @@
 ;;; will re-trigger the CONTROL_STACK_RETURN_GUARD_PAGE and
 ;;; CONTROL_STACK_GUARD_PAGE, and issue a CORRUPTION WARNING.
 (with-test (:name (:exhaust :write-to-stack-in-handler)
-            :skipped-on (not :win32))
+            :skipped-on (not (and :win32 :c-stack-is-control-stack)))
   (labels ((recurse-and-write-to-stack-on-error ()
              (let ((x 0))
                (handler-bind ((storage-condition (lambda (c)
@@ -137,6 +139,8 @@
   (let ((ok nil)
         (symbols (loop repeat 1024 collect (gensym)))
         (values (loop repeat 1024 collect nil)))
+    ;; FIXME
+    #-(and sb-safepoint (not c-stack-is-control-stack))
     (gc :full t)
     (labels ((exhaust-binding-stack (i)
                (progv symbols values