Add ARM64 Windows port
Masatoshi SANO <[email protected]> Thu, 12 Feb 2026 14:30:56 +0900
| Newsgroups | gmane.lisp.steel-bank.devel |
|---|---|
| Message-ID | <CAH6JMpjwjSKmw_cwfw-rQOd3Bgp8BWQ0XytfS3SaFLTt3jSfPQ@mail.gmail.com> |
This patch series adds ARM64 Windows (AArch64 WoA) support to SBCL.
Built and tested on Windows 11 ARM using MSYS2 clangarm64 toolchain,
cross-compiled from x86-64 Windows SBCL.
Most tests pass. Known failures:
- gethash-concurrency.pure.lisp: ~80% pass rate. Patch 4/5 adds
defensive workarounds but the root cause is likely ARM64 weak
memory ordering interacting with the hash table high-water-mark.
Patch 4/5 can be dropped if a different approach is preferred.
- Floating-point denormal tests (pre-existing on ARM64)
- sleepytests.pure.lisp hangs (safepoint interrupt delivery during
sleep, pre-existing on Windows safepoint builds)
The patches are structured as follows:
1/5 align.h LLP64 truncation fix (Windows 64-bit general)
2/5 LLP64 type fixes and general bugs found during porting
3/5 GC fix for ARM64 safepoint builds with precise stack scanning
4/5 Defensive GC validation for concurrent hash table operations
(optional -- see above)
5/5 ARM64 Windows platform support
Patches 1-2 fix bugs that affect existing platforms (Windows x86-64,
or all platforms). Patch 3 fixes a GC crash specific to ARM64
safepoint builds with precise scanning (!C_STACK_IS_CONTROL_STACK).
Patch 5 is the main platform port.
_______________________________________________
Sbcl-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-devel
0001-Fix-ALIGN_UP-ALIGN_DOWN-IS_ALIGNED-integer-truncatio.patch
(application/octet-stream, 1.8 KB)
From cc2b7499ac098490d52a38a03761de422a9f236b Mon Sep 17 00:00:00 2001 From: "SANO,Masatoshi" <[email protected]> Date: Thu, 12 Feb 2026 13:22:54 +0900 Subject: [PATCH 1/5] Fix ALIGN_UP/ALIGN_DOWN/IS_ALIGNED integer truncation on LLP64 On Windows 64-bit (LLP64 model), the granularity parameter in these macros is subject to implicit integer promotion rules. When granularity is passed as a bare integer literal or a variable of type `long`, it is only 32 bits wide on LLP64. For addresses above 4GB the bitwise complement ~(granularity-1) produces a mask that truncates the upper 32 bits, silently corrupting the result. Cast granularity to uword_t (always pointer-width) before arithmetic to ensure correct masking on all platforms. This affects Windows 64-bit (both x86-64 and ARM64). No change on Unix platforms where long is already 64 bits. Co-Authored-By: Claude Opus 4.6 <[email protected]> --- src/runtime/align.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/runtime/align.h b/src/runtime/align.h index e20866f1d..eafdc94dc 100644 --- a/src/runtime/align.h +++ b/src/runtime/align.h @@ -5,9 +5,9 @@ #include <string.h> #include "genesis/sbcl.h" -#define ALIGN_UP(value,granularity) (((value)+((granularity)-1))&(~((granularity)-1))) -#define ALIGN_DOWN(value,granularity) (((value))&(~((granularity)-1))) -#define IS_ALIGNED(value,granularity) (0==(((value))&((granularity)-1))) +#define ALIGN_UP(value,granularity) (((value)+((uword_t)(granularity)-1))&(~((uword_t)(granularity)-1))) +#define ALIGN_DOWN(value,granularity) (((value))&(~((uword_t)(granularity)-1))) +#define IS_ALIGNED(value,granularity) (0==(((value))&((uword_t)(granularity)-1))) #define PTR_ALIGN_UP(pointer,granularity) \ (typeof(pointer))ALIGN_UP((uintptr_t)pointer,granularity) -- 2.43.0
0000-cover-letter.patch
(application/octet-stream, 3.7 KB)
From f900a767dfcb3d4c1b0d8038c1f4ca62ee4d7e1a Mon Sep 17 00:00:00 2001 From: "SANO,Masatoshi" <[email protected]> Date: Thu, 12 Feb 2026 14:24:52 +0900 Subject: [PATCH 0/5] Add ARM64 Windows port MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This patch series adds ARM64 Windows (AArch64 WoA) support to SBCL. Built and tested on Windows 11 ARM using MSYS2 clangarm64 toolchain, cross-compiled from x86-64 Windows SBCL. Most tests pass. Known failures: - gethash-concurrency.pure.lisp: ~80% pass rate. Patch 4/5 adds defensive workarounds but the root cause is likely ARM64 weak memory ordering interacting with the hash table high-water-mark. Patch 4/5 can be dropped if a different approach is preferred. - Floating-point denormal tests (pre-existing on ARM64) - sleepytests.pure.lisp hangs (safepoint interrupt delivery during sleep, pre-existing on Windows safepoint builds) The patches are structured as follows: 1/5 align.h LLP64 truncation fix (Windows 64-bit general) 2/5 LLP64 type fixes and general bugs found during porting 3/5 GC fix for ARM64 safepoint builds with precise stack scanning 4/5 Defensive GC validation for concurrent hash table operations (optional -- see above) 5/5 ARM64 Windows platform support Patches 1-2 fix bugs that affect existing platforms (Windows x86-64, or all platforms). Patch 3 fixes a GC crash specific to ARM64 safepoint builds with precise scanning (!C_STACK_IS_CONTROL_STACK). Patch 5 is the main platform port. snmst (5): Fix ALIGN_UP/ALIGN_DOWN/IS_ALIGNED integer truncation on LLP64 Fix LLP64 and general bugs found during ARM64 Windows porting Fix GC control stack stale pointer crashes on ARM64 safepoint builds Add defensive GC validation for concurrent hash table operations on ARM64 Add ARM64 Windows platform support .github/workflows/linux-arm64.yml | 9 +- .github/workflows/mac.yml | 9 +- .github/workflows/windows-arm64.yml | 68 ++++++++ make-config.sh | 11 ++ make-windows-installer.sh | 2 +- src/assembly/arm64/tramps.lisp | 9 ++ src/code/debug-int.lisp | 6 +- src/code/float-trap.lisp | 4 +- src/code/room.lisp | 11 +- src/compiler/arm64/c-call.lisp | 2 + src/compiler/arm64/parms.lisp | 2 +- src/compiler/arm64/vm.lisp | 9 +- src/compiler/generic/genesis.lisp | 10 +- src/compiler/generic/parms.lisp | 5 +- src/runtime/Config.arm64-win32 | 55 +++++++ src/runtime/align.h | 6 +- src/runtime/arm64-arch.c | 69 +++++++- src/runtime/arm64-assem.S | 68 ++++++-- src/runtime/arm64-win32-os.c | 240 ++++++++++++++++++++++++++++ src/runtime/arm64-win32-os.h | 26 +++ src/runtime/coreparse.c | 8 +- src/runtime/gc-common.c | 128 ++++++++++++++- src/runtime/gencgc-impl.h | 2 +- src/runtime/gencgc.c | 72 ++++++++- src/runtime/hopscotch.c | 6 +- src/runtime/immobile-space.c | 12 +- src/runtime/immobile-space.h | 2 +- src/runtime/interrupt.c | 6 +- src/runtime/monitor.c | 2 +- src/runtime/pmrgc-impl.h | 2 +- src/runtime/pmrgc.c | 2 +- src/runtime/safepoint.c | 11 ++ src/runtime/win32-os.c | 133 ++++++++++++--- tests/subr.sh | 7 +- 34 files changed, 918 insertions(+), 96 deletions(-) create mode 100644 .github/workflows/windows-arm64.yml create mode 100644 src/runtime/Config.arm64-win32 create mode 100644 src/runtime/arm64-win32-os.c create mode 100644 src/runtime/arm64-win32-os.h -- 2.43.0
0003-Fix-GC-control-stack-stale-pointer-crashes-on-ARM64-.patch
(application/octet-stream, 7.6 KB)
From dea3b50f492090b7335c8754c2133ba38bab4080 Mon Sep 17 00:00:00 2001 From: "SANO,Masatoshi" <[email protected]> Date: Thu, 12 Feb 2026 13:29:36 +0900 Subject: [PATCH 3/5] Fix GC control stack stale pointer crashes on ARM64 safepoint builds MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit On ARM64 safepoint builds with precise GC and separate control/C stacks (!C_STACK_IS_CONTROL_STACK), the GC scans the control stack precisely — every pointer-shaped word is treated as a live reference and transported. However, dead variables in active call frames may hold stale pointers to already-freed from-space objects. Transporting these corrupts the heap, typically manifesting as random crashes after GC or "bad widetag" errors. This does not affect x86/x86-64 (conservative stack scanning pins rather than transports, masking stale pointers) or ARM64 Linux (uses signal-based GC stop, not safepoints). Three coordinated fixes: 1. gencgc.c: Limit control stack scan range. On safepoint builds, GC runs as Lisp code (SUB-GC) on the control stack, so thread->csp includes SUB-GC's own frames which may contain uninitialized data. Temporarily limit scanning to the interrupted code's CSP (saved in the interrupt context by fake_foreign_function_call), which excludes the GC infrastructure frames. 2. gc-common.c (scavenge_control_stack): Validate from-space pointers before transport. For list pointers, verify the target page is PAGE_TYPE_CONS (on precise GC, cons cells are only on cons pages). For other pointers, verify the header widetag is valid and its lowtag matches the pointer's lowtag. Invalid pointers are zeroed. 3. safepoint.c: Scrub stale control stack frames after undo_fake_foreign_function_call in the safepoint handler. This reduces the window for stale pointers to accumulate across GC cycles. All changes are guarded by: #if defined(LISP_FEATURE_SB_SAFEPOINT) && \ !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) No impact on other platforms. Co-Authored-By: Claude Opus 4.6 <[email protected]> --- src/runtime/gc-common.c | 34 ++++++++++++++++++++++++++++++++++ src/runtime/gencgc.c | 29 +++++++++++++++++++++++++++++ src/runtime/safepoint.c | 11 +++++++++++ 3 files changed, 74 insertions(+) diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index ace25d5ec..029ccb142 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -2442,6 +2442,40 @@ scavenge_control_stack(struct thread *th) #ifdef LISP_FEATURE_MARK_REGION_GC mr_preserve_object(word); #else +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* On safepoint builds with precise GC and separate stacks (ARM64), + * dead variables in active frames may contain stale pointers to + * from-space addresses that have been freed/reused. Without stack + * maps, the GC cannot distinguish live from dead variables. + * Transporting garbage data corrupts the heap, so validate that + * from-space pointers actually point to plausible objects before + * allowing scav1 to transport them. Zero invalid slots. */ + { + page_index_t pg = find_page_index((void*)word); + if (pg >= 0 && page_table[pg].gen == from_space) { + lispobj *target = native_pointer(word); + if (!forwarding_pointer_p(target)) { + int valid; + if (lowtag_of(word) == LIST_POINTER_LOWTAG) { + /* Cons pointers should target cons pages */ + valid = (page_table[pg].type == PAGE_TYPE_CONS); + } else { + /* Headered objects: validate header widetag and + * check that the widetag's lowtag matches the + * pointer's lowtag */ + int widetag = *target & WIDETAG_MASK; + valid = other_immediate_lowtag_p(widetag) + && LOWTAG_FOR_WIDETAG(widetag) + && LOWTAG_FOR_WIDETAG(widetag) == lowtag_of(word); + } + if (!valid) { + *object_ptr = 0; + continue; + } + } + } + } +#endif scav1(object_ptr, word); #endif } diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index c3b136701..1e996a6e1 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -3516,7 +3516,36 @@ garbage_collect_generation(generation_index_t generation, int raise, #if !defined(LISP_FEATURE_MIPS) && defined(reg_CODE) // interrupt contexts already pinned everything they see scavenge_interrupt_contexts(th); #endif +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* On safepoint builds with separate control and C stacks (ARM64), + * GC runs as Lisp code (SUB-GC) on the control stack. The current + * thread->csp includes SUB-GC's frames, which may contain stale or + * uninitialized pointers. Precise scanning of these frames crashes + * when it encounters stale pointers to freed from-space objects. + * + * Fix: temporarily limit the scan to the interrupted code's CSP + * (from the interrupt context stored by fake_foreign_function_call). + * The interrupt context registers are already scavenged by + * scavenge_interrupt_contexts above. */ + { + lispobj *saved_csp = access_control_stack_pointer(th); + int ctx_idx = fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX, th)); + if (ctx_idx > 0) { + os_context_t *ctx = nth_interrupt_context(ctx_idx - 1, th); + lispobj *interrupted_csp = + (lispobj*)(uword_t)(*os_context_register_addr(ctx, reg_CSP)); + /* build_fake_control_stack_frames places a 4-word frame above + * the interrupted CSP. Include it in the scan. */ + lispobj *limit = interrupted_csp + 4; + if (limit < saved_csp) + access_control_stack_pointer(th) = limit; + } + scavenge_control_stack(th); + access_control_stack_pointer(th) = saved_csp; + } +#else scavenge_control_stack(th); +#endif } # ifdef LISP_FEATURE_SB_SAFEPOINT diff --git a/src/runtime/safepoint.c b/src/runtime/safepoint.c index e653d29b7..1df7970ef 100644 --- a/src/runtime/safepoint.c +++ b/src/runtime/safepoint.c @@ -1066,6 +1066,17 @@ handle_safepoint_violation(os_context_t *ctx, os_vm_address_t fault_address) fake_foreign_function_call(ctx); thread_in_lisp_raised(ctx); undo_fake_foreign_function_call(ctx); + /* Scrub stale Lisp frames left on the control stack by SUB-GC + * and thruption handlers. undo_fake_foreign_function_call + * zeroed thread->csp (it IS foreign_function_call_active_p on + * ARM64), so temporarily restore it for scrubbing. */ + { + lispobj *csp = (lispobj*)(uword_t) + (*os_context_register_addr(ctx, reg_CSP)); + access_control_stack_pointer(self) = csp; + scrub_thread_control_stack(self); + access_control_stack_pointer(self) = 0; + } #endif return 1; } -- 2.43.0
0002-Fix-LLP64-and-general-bugs-found-during-ARM64-Window.patch
(application/octet-stream, 12.7 KB)
From 84deb2d430332d7e8bb8fcb3257a63e2b00f41cc Mon Sep 17 00:00:00 2001 From: "SANO,Masatoshi" <[email protected]> Date: Thu, 12 Feb 2026 13:28:37 +0900 Subject: [PATCH 2/5] Fix LLP64 and general bugs found during ARM64 Windows porting Fix several bugs found while porting SBCL to ARM64 Windows. Most are related to the LLP64 data model where `long` is 32 bits. LLP64 type truncation fixes (Windows 64-bit): - gencgc.c, gencgc-impl.h, pmrgc-impl.h, pmrgc.c, monitor.c: gc_card_table_mask declared as `long` but used as a bitmask for addresses above 4GB. Change to sword_t. - coreparse.c: `1L << nbits` produces a 32-bit result on LLP64. Cast to (sword_t)1 for correct 64-bit shift. - coreparse.c: `sizeof expr/sizeof (type)` has ambiguous parse. Use `sizeof(expr)/sizeof(type)` form. - interrupt.c: `(unsigned long)` cast truncates 64-bit code pointers. Use (uintptr_t) instead. General bug fixes (all platforms): - immobile-space.c, immobile-space.h: tlsf_page_sso declared as `unsigned short*` but page offsets can exceed 65535 on platforms with large (>64KB) IMMOBILE_CARD_BYTES. Change to unsigned int*. Also fix malloc/memset size to use sizeof *tlsf_page_sso. - hopscotch.c: Replace `extern int ffs()` declaration (which may not link on all Windows toolchains) with __builtin_ffs inline wrapper. - room.lisp: (room t) crashes with division-by-zero when a type has zero instances. Guard the per-object size computation with plusp. - gencgc.c: Guard os_protect call for FIXEDOBJ_SPACE_START against zero (fixedobj space disabled on some platforms like ARM64). Co-Authored-By: Claude Opus 4.6 <[email protected]> --- src/code/room.lisp | 11 ++++++----- src/runtime/coreparse.c | 6 +++--- src/runtime/gencgc-impl.h | 2 +- src/runtime/gencgc.c | 13 +++++++++---- src/runtime/hopscotch.c | 6 ++++-- src/runtime/immobile-space.c | 12 ++++++------ src/runtime/immobile-space.h | 2 +- src/runtime/interrupt.c | 6 +++--- src/runtime/monitor.c | 2 +- src/runtime/pmrgc-impl.h | 2 +- src/runtime/pmrgc.c | 2 +- 11 files changed, 36 insertions(+), 28 deletions(-) diff --git a/src/code/room.lisp b/src/code/room.lisp index cd93a6f6b..49d3a3824 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -726,12 +726,13 @@ We could try a few things to mitigate this: (classoid (format t " ~V@<~/sb-ext:print-symbol-with-prefix/~>" (1+ types-width) (classoid-name type)))) - (format t " ~V:D bytes, ~V:D object~:P " + (format t " ~V:D bytes, ~V:D object~:P" bytes-width bytes objects-width objects) - (let ((avarage-size (/ bytes objects))) - (if (ratiop avarage-size) - (format t "(~,2F per object)" (float avarage-size)) - (format t "(~:D per object)" avarage-size))) + (when (plusp objects) + (let ((avarage-size (/ bytes objects))) + (if (ratiop avarage-size) + (format t " (~,2F per object)" (float avarage-size)) + (format t " (~:D per object)" avarage-size)))) (format t ".~%"))) (loop for (type . (objects . bytes)) in interesting do (incf printed-bytes bytes) diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c index e216037e3..1ef5ba26c 100644 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@ -1007,7 +1007,7 @@ static bool compute_card_table_size(int saved_card_mask_nbits) // The card table size is a power of 2 at *least* as large // as the number of cards. These are the default values. int nbits = 13; - long num_gc_cards = 1L << nbits; + sword_t num_gc_cards = (sword_t)1 << nbits; // Sure there's a fancier way to round up to a power-of-2 // but this is executed exactly once, so KISS. @@ -1033,7 +1033,7 @@ static bool compute_card_table_size(int saved_card_mask_nbits) // Regardless of the mask implied by space size, it has to be gc_card_table_nbits wide // even if that is excessive - when the core is restarted using a _smaller_ dynamic space // size than saved at - otherwise lisp could overrun the mark table. - num_gc_cards = 1L << gc_card_table_nbits; + num_gc_cards = (sword_t)1 << gc_card_table_nbits; gc_card_table_mask = num_gc_cards - 1; return patch_card_index_mask_fixups; @@ -1451,7 +1451,7 @@ load_core_file(char *file, os_vm_offset_t file_offset, int merge_core_pages) // The initializer ensures that indexing into spaces[] is insensitive // to the space numbering and the order listed in defined_spaces. struct coreparse_space* spaces = - init_coreparse_spaces(sizeof defined_spaces/sizeof (struct coreparse_space), + init_coreparse_spaces(sizeof(defined_spaces)/sizeof(struct coreparse_space), defined_spaces); bool patch_card_marking_instructions = 0; diff --git a/src/runtime/gencgc-impl.h b/src/runtime/gencgc-impl.h index da78075af..e51815ecc 100644 --- a/src/runtime/gencgc-impl.h +++ b/src/runtime/gencgc-impl.h @@ -256,7 +256,7 @@ struct __attribute__((packed)) corefile_pte { * */ extern unsigned char *gc_card_mark; -extern long gc_card_table_mask; +extern sword_t gc_card_table_mask; #define addr_to_card_index(addr) ((((uword_t)addr)>>GENCGC_CARD_SHIFT) & gc_card_table_mask) #define page_to_card_index(n) addr_to_card_index(page_address(n)) diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index ae31b7ef9..c3b136701 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -3890,9 +3890,14 @@ collect_garbage(generation_index_t last_gen) #ifdef LISP_FEATURE_IMMOBILE_SPACE if (ENABLE_PAGE_PROTECTION) { // Unprotect the in-use ranges. Any page could be written during scavenge - os_protect((os_vm_address_t)FIXEDOBJ_SPACE_START, - (lispobj)fixedobj_free_pointer - FIXEDOBJ_SPACE_START, - OS_VM_PROT_ALL); + // On some platforms (e.g., ARM64), fixedobj space may be disabled + // (FIXEDOBJ_SPACE_START=0, size=0), so skip the protection change. + uword_t fixedobj_size = (lispobj)fixedobj_free_pointer - FIXEDOBJ_SPACE_START; + if (FIXEDOBJ_SPACE_START != 0 && fixedobj_size > 0) { + os_protect((os_vm_address_t)FIXEDOBJ_SPACE_START, + fixedobj_size, + OS_VM_PROT_ALL); + } } #endif @@ -4110,7 +4115,7 @@ gc_init(void) } int gc_card_table_nbits; -long gc_card_table_mask; +sword_t gc_card_table_mask; /* alloc() and alloc_list() are external interfaces for memory allocation. diff --git a/src/runtime/hopscotch.c b/src/runtime/hopscotch.c index 3f25fc8db..bfe3c61a6 100644 --- a/src/runtime/hopscotch.c +++ b/src/runtime/hopscotch.c @@ -22,8 +22,10 @@ #include <stdint.h> #include <stdio.h> #ifdef LISP_FEATURE_WIN32 -/* I don't know where ffs() is prototyped */ -extern int ffs(int); +// Provide ffs using __builtin_ffs for Windows +static inline int ffs(int i) { + return __builtin_ffs(i); +} #else /* https://www.freebsd.org/cgi/man.cgi?query=fls&sektion=3&manpath=FreeBSD+7.1-RELEASE says strings.h */ diff --git a/src/runtime/immobile-space.c b/src/runtime/immobile-space.c index 25eaab102..cf2d0ceef 100644 --- a/src/runtime/immobile-space.c +++ b/src/runtime/immobile-space.c @@ -134,7 +134,7 @@ unsigned char* text_page_genmask; // one per page *excluding* all pseudostatic pages. // Unlike with dynamic-space, the scan start for a text page // is an address not lower than the base page. -unsigned short int* tlsf_page_sso; +unsigned int* tlsf_page_sso; // Array of inverted write-protect flags, 1 bit per page. unsigned int* text_page_touched_bits; static int n_bitmap_elts; // length of array measured in 'int's @@ -186,7 +186,7 @@ void *tlsf_alloc_codeblob(tlsf_t tlsf, int requested_nwords, unsigned boxed) if (end > text_space_highwatermark) text_space_highwatermark = end; // Adjust the scan start if this became the lowest addressable in-use block on its page low_page_index_t tlsf_page = ((char*)c - (char*)tlsf_mem_start) / IMMOBILE_CARD_BYTES; - int offset = (uword_t)c & (IMMOBILE_CARD_BYTES-1); + unsigned int offset = (uword_t)c & (IMMOBILE_CARD_BYTES-1); if (offset < tlsf_page_sso[tlsf_page]) tlsf_page_sso[tlsf_page] = offset; text_page_genmask[find_text_page_index(c)] |= 1; #if 0 @@ -224,7 +224,7 @@ void tlsf_unalloc_codeblob(tlsf_t tlsf, struct code* code) } // See if the page scan start needs to change low_page_index_t tlsf_page = ((char*)code - (char*)tlsf_mem_start) / IMMOBILE_CARD_BYTES; - int offset = (uword_t)code & (IMMOBILE_CARD_BYTES-1); + unsigned int offset = (uword_t)code & (IMMOBILE_CARD_BYTES-1); if (offset == tlsf_page_sso[tlsf_page]) { lispobj* next = end; if (*next & block_header_free_bit) { @@ -515,7 +515,7 @@ lispobj* text_page_scan_start(low_page_index_t page) { } if (pagebase > (char*)text_space_highwatermark) return 0; int tlsf_page = (pagebase - (char*)tlsf_mem_start) / IMMOBILE_CARD_BYTES; - unsigned short sso = tlsf_page_sso[tlsf_page]; + unsigned int sso = tlsf_page_sso[tlsf_page]; return (sso < IMMOBILE_CARD_BYTES) ? (lispobj*)(pagebase + sso) : 0; } @@ -1251,8 +1251,8 @@ void immobile_space_coreparse(uword_t fixedobj_len, int tlsf_memory_size = tlsf_memory_end - (char*)tlsf_mem_start; tlsf_add_pool(tlsf_control, tlsf_mem_start, tlsf_memory_size); int n_tlsf_pages = tlsf_memory_size / IMMOBILE_CARD_BYTES; - tlsf_page_sso = malloc(n_tlsf_pages * sizeof (short int)); - memset(tlsf_page_sso, 0xff, n_tlsf_pages * sizeof (short int)); + tlsf_page_sso = malloc(n_tlsf_pages * sizeof *tlsf_page_sso); + memset(tlsf_page_sso, 0xff, n_tlsf_pages * sizeof *tlsf_page_sso); // Set the WP bits for pages occupied by the core file. // (There can be no inter-generation pointers.) diff --git a/src/runtime/immobile-space.h b/src/runtime/immobile-space.h index 87e736013..1584872d0 100644 --- a/src/runtime/immobile-space.h +++ b/src/runtime/immobile-space.h @@ -43,7 +43,7 @@ text_page_address(low_page_index_t page_num) } extern unsigned char* text_page_genmask; -extern unsigned short int* tlsf_page_sso; +extern unsigned int* tlsf_page_sso; static inline low_page_index_t find_fixedobj_page_index(void *addr) { diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 75d097412..5a3cdee2a 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -1568,14 +1568,14 @@ arrange_return_to_c_function(os_context_t *context, /* this much of the calling convention is common to all non-x86 ports */ - set_os_context_pc(context, (os_context_register_t)(unsigned long)code); + set_os_context_pc(context, (os_context_register_t)(uintptr_t)code); *os_context_register_addr(context,reg_NARGS) = 0; #ifdef reg_LIP *os_context_register_addr(context,reg_LIP) = - (os_context_register_t)(unsigned long)code; + (os_context_register_t)(uintptr_t)code; #endif *os_context_register_addr(context,reg_CFP) = - (os_context_register_t)(unsigned long)access_control_frame_pointer(th); + (os_context_register_t)(uintptr_t)access_control_frame_pointer(th); #endif #ifdef ARCH_HAS_NPC_REGISTER *os_context_npc_addr(context) = 4 + os_context_pc(context); diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c index 087b42401..96065e26e 100644 --- a/src/runtime/monitor.c +++ b/src/runtime/monitor.c @@ -1368,7 +1368,7 @@ int load_gc_crashdump(char* pathname) if (preamble.card_size != GENCGC_CARD_BYTES) lose("Can't load crashdump: memory parameters differ"); gc_card_table_nbits = preamble.card_table_nbits; - gc_card_table_mask = (1<<gc_card_table_nbits)-1; + gc_card_table_mask = ((sword_t)1<<gc_card_table_nbits)-1; #ifdef LISP_FEATURE_LINKAGE_SPACE linkage_space = (lispobj*)os_alloc_gc_space(0, 0, (char*)preamble.linkage_start, preamble.linkage_nbytes); diff --git a/src/runtime/pmrgc-impl.h b/src/runtime/pmrgc-impl.h index 80502343c..6d13de274 100644 --- a/src/runtime/pmrgc-impl.h +++ b/src/runtime/pmrgc-impl.h @@ -288,7 +288,7 @@ struct __attribute__((packed)) corefile_pte { * */ extern unsigned char *gc_card_mark; -extern long gc_card_table_mask; +extern sword_t gc_card_table_mask; #define addr_to_card_index(addr) ((((uword_t)addr)>>GENCGC_CARD_SHIFT) & gc_card_table_mask) #define page_to_card_index(n) addr_to_card_index(page_address(n)) diff --git a/src/runtime/pmrgc.c b/src/runtime/pmrgc.c index 96184e1dc..ea400e1df 100644 --- a/src/runtime/pmrgc.c +++ b/src/runtime/pmrgc.c @@ -1320,7 +1320,7 @@ gc_init(void) } int gc_card_table_nbits; -long gc_card_table_mask; +sword_t gc_card_table_mask; /* -- 2.43.0
0004-Add-defensive-GC-validation-for-concurrent-hash-tabl.patch
(application/octet-stream, 11.6 KB)
From c9bc38d32b48b06695b7da41bfb5a849ce481a3e Mon Sep 17 00:00:00 2001 From: "SANO,Masatoshi" <[email protected]> Date: Thu, 12 Feb 2026 13:32:11 +0900 Subject: [PATCH 4/5] Add defensive GC validation for concurrent hash table operations on ARM64 On ARM64 safepoint builds, the gethash-concurrency test crashes ~100% of the time. Multiple threads perform concurrent hash table operations while GC runs in parallel. The crashes stem from stale from-space pointers in kv-vectors that the GC fails to forward during scavenging. Root cause: ARM64 weak memory ordering creates a race between mutator threads writing kv-vector entries and updating the high-water-mark (HWM), and the GC thread reading HWM to determine scan range. The GC may see an old HWM while new entries are already visible, leaving from-space pointers beyond HWM unscavenged. This patch adds multi-layered defensive validation, all guarded by: #if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) No impact on other platforms. Layer 1 - scav1() pointer validation (gc-common.c): Before transporting from-space objects, validate them: - List pointers: target page must be PAGE_TYPE_CONS - Headered objects: widetag must be valid, transport function must exist Invalid pointers are zeroed rather than transported. Layer 2 - heap_scavenge() newspace defense (gc-common.c): Handle garbage data that was transported via stale list pointers: - scav_lose widetag encountered: zero and treat as cons cell - Object size overshoots page boundary: skip to end Layer 3 - scav_other_pointer() safety net (gc-common.c): Redundant validation for pointers reaching this function via scavtab (not through scav1). Layer 4 - Beyond-HWM scan in scan_nonweak_kv_vector (gc-common.c): Scan kv-vector entries beyond the high-water-mark to catch entries written by mutator threads that the GC would otherwise miss. Applied to both address-hashing and non-address-hashing tables. Layer 5 - Pinned objects scavenge (gencgc.c): Explicitly scavenge slots of pinned from_space objects. On precise GC platforms, pinned objects can reference non-pinned from_space objects that are not reached by the normal scavenge passes. Results: ~80% pass rate on gethash-concurrency (up from 0%). Remaining failures are likely due to fundamental write barrier or memory ordering issues that defensive validation cannot fully address. A proper fix may require DMB barriers in the safepoint handler or atomic HWM updates. This patch may be omitted if the maintainers prefer a different approach to the underlying memory ordering issue. Co-Authored-By: Claude Opus 4.6 <[email protected]> --- src/runtime/gc-common.c | 94 +++++++++++++++++++++++++++++++++++++++-- src/runtime/gencgc.c | 30 +++++++++++++ 2 files changed, 121 insertions(+), 3 deletions(-) diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index 029ccb142..64044ff4a 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -75,6 +75,7 @@ int sb_sprof_enabled; // - trans_code() is responsible for leaving FPs for both the code object // AND all embedded functions. static lispobj (*transother[64])(lispobj object); +static lispobj trans_lose(lispobj object); /* forward decl for validation */ sword_t (*sizetab[256])(lispobj *where); struct weak_pointer *weak_pointer_chain = WEAK_POINTER_CHAIN_END; struct cons *weak_vectors; @@ -138,8 +139,33 @@ static inline void scav1(lispobj* addr, lispobj object) #endif if (forwarding_pointer_p(native_pointer(object))) *addr = forwarding_pointer_value(native_pointer(object)); - else if (!pinned_p(object, page)) + else if (!pinned_p(object, page)) { +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* On ARM64 safepoint builds, concurrent hash table operations + * can leave stale pointers in kv-vectors due to HWM race + * conditions with weak memory ordering. Validate objects + * before transport to avoid copying garbage. */ + if (lowtag_of(object) == LIST_POINTER_LOWTAG) { + /* Cons pointers must target PAGE_TYPE_CONS pages */ + if (page_table[page].type != PAGE_TYPE_CONS) { + *addr = 0; + return; + } + } else { + /* Headered objects: validate header widetag and + * transport function. Some valid header widetags + * (e.g. 0x45) have no transport function. */ + int wt = *native_pointer(object) & WIDETAG_MASK; + if (!(widetag_lowtag[wt] & 0x80) + || (lowtag_of(object) == OTHER_POINTER_LOWTAG + && transother[wt>>2] == trans_lose)) { + *addr = 0; + return; + } + } +#endif scav_ptr[PTR_SCAVTAB_INDEX(object)](addr, object); + } } #ifdef LISP_FEATURE_IMMOBILE_SPACE // Test immobile_space_p() only if object was definitely not in dynamic space @@ -200,9 +226,34 @@ void heap_scavenge(lispobj *start, lispobj *end) * but a failure here is often clearer than ending up in * scav_lose without knowing the [start,end] */ if (scavtab[header_widetag(object)] == scav_lose) lose("Losing @ %p", object_ptr); +#endif +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* On ARM64 safepoint builds, garbage data from stale list-pointer + * transport can end up in newspace. If the "header" maps to + * scav_lose, zero it and treat as a cons cell. */ + if (scavtab[header_widetag(object)] == scav_lose) { + *object_ptr = 0; + gc_scav_pair(object_ptr); + object_ptr += 2; + continue; + } #endif /* It's some sort of header object or another. */ - object_ptr += (scavtab[header_widetag(object)])(object_ptr, object); + { + sword_t nwords = (scavtab[header_widetag(object)])(object_ptr, object); +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* Guard against corrupt headers with oversized length from + * garbage data that ended up in newspace via stale pointer + * transport. If the computed size overshoots, skip to end. + * Don't try to scavenge remaining words as they are likely + * corrupt data from the same stale transport. */ + if (object_ptr + nwords > end) { + object_ptr = end; + break; + } +#endif + object_ptr += nwords; + } } else { // it's a cons gc_scav_pair(object_ptr); object_ptr += 2; @@ -726,6 +777,15 @@ scav_other_pointer(lispobj *where, lispobj object) /* Object is a pointer into from space - not FP. */ lispobj *first_pointer = (lispobj *)(object - OTHER_POINTER_LOWTAG); int tag = widetag_of(first_pointer); +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* Additional safety net: if the scav1 check didn't catch this + * (e.g. called from scavtab path), zero stale pointers here too. */ + if (!(widetag_lowtag[tag] & 0x80) + || transother[other_immediate_lowtag_p(tag)?tag>>2:0] == trans_lose) { + *where = 0; + return 1; + } +#endif lispobj copy = transother[other_immediate_lowtag_p(tag)?tag>>2:0](object); // If the object was large, then instead of transporting it, @@ -1601,7 +1661,21 @@ static void scan_nonweak_kv_vector(struct vector *kv_vector, void (*scav_entry)( if (!vector_flagp(kv_vector->header, VectorAddrHashing)) { // All keys were hashed address-insensitively - return (void)scavenge(data + 2, KV_PAIRS_HIGH_WATER_MARK(data) * 2); + unsigned hwm_ni = KV_PAIRS_HIGH_WATER_MARK(data); + scavenge(data + 2, hwm_ni * 2); +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* On ARM64 with safepoints, concurrent rehash may write kv entries + * beyond the high-water-mark before updating hwm due to weak memory + * ordering. Scan beyond hwm to avoid leaving dangling pointers. */ + { + sword_t kv_len = vector_len(kv_vector); + sword_t max_idx = (kv_len - 1) / 2; + for (unsigned j = hwm_ni + 1; j <= (unsigned)max_idx; j++) + if (at_least_one_pointer_p(data[2*j], data[2*j+1])) + scavenge(&data[2*j], 2); + } +#endif + return; } // Read the hash vector (or NIL) from the last element. If the last element // satisfies instancep() then this vector belongs to a weak table, @@ -1626,6 +1700,20 @@ static void scan_nonweak_kv_vector(struct vector *kv_vector, void (*scav_entry)( gc_assert(2 * vector_len(VECTOR(kv_supplement)) + 1 == kv_length); } SCAV_ENTRIES(1, ); +#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_C_STACK_IS_CONTROL_STACK) + /* Same beyond-hwm scan for address-hashing tables */ + { + unsigned hwm_check = KV_PAIRS_HIGH_WATER_MARK(data); + sword_t max_idx = (kv_length - 1) / 2; + for (unsigned j = hwm_check + 1; j <= (unsigned)max_idx; j++) { + lispobj key = data[2*j]; + if (at_least_one_pointer_p(key, data[2*j+1])) { + scav_entry(&data[2*j]); + if (SHOULD_REHASH(key, data[2*j], hashvals, j)) rehash = 1; + } + } + } +#endif } bool scan_weak_hashtable(struct hash_table *hash_table, diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 1e996a6e1..6d9c66a20 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -2664,6 +2664,36 @@ static void newspace_full_scavenge(generation_index_t generation) } /* Enable recording of all new allocation regions */ record_new_regions_below = 1 + page_table_pages; + + /* Scavenge pinned from_space objects. These objects reside on pages with + * gen=from_space, so they are NOT processed by scavenge_root_gens (which + * requires gen >= from) or the newspace scan above (which requires + * gen == generation, i.e., new_space). Without this step, slots of pinned + * objects that point to from_space targets are never forwarded. + * After obliterate_nonpinned_words changes these pages to new_space gen, + * the stale pointers become dangling references when free_oldspace runs. + * + * On conservative platforms (x86), this is masked because the conservative + * stack scan tends to pin transitively reachable objects. On precise + * platforms (ARM64), pinned objects can reference non-pinned from_space + * objects that must be explicitly transported here. */ + if (gc_pin_count > 0) { + lispobj* keys = gc_filtered_pins; + int n = gc_pin_count; + for (int k = 0; k < n; k++) { + lispobj* obj = native_pointer(keys[k]); + page_index_t page = find_page_index(obj); + if (page < 0 || page_table[page].gen != from_space) continue; + if (!page_boxed_p(page)) continue; + lispobj header = *obj; + if (is_header(header)) { + scavtab[header_widetag(header)](obj, header); + } else { + /* cons cell */ + scavenge(obj, 2); + } + } + } } void gc_close_collector_regions(int flag) -- 2.43.0
0005-Add-ARM64-Windows-platform-support.patch
(application/octet-stream, 53.8 KB)
From f900a767dfcb3d4c1b0d8038c1f4ca62ee4d7e1a Mon Sep 17 00:00:00 2001 From: "SANO,Masatoshi" <[email protected]> Date: Thu, 12 Feb 2026 13:49:10 +0900 Subject: [PATCH 5/5] Add ARM64 Windows platform support Add complete ARM64 Windows (AArch64 WoA) support to SBCL. This enables building and running SBCL natively on Windows 11 ARM devices. Key design decisions: - x18 register reserved as TEB pointer (Windows ARM64 ABI requirement), matching the existing Darwin reservation - Safepoint GC with fake_foreign_function_call to save register context for precise stack scanning (ARM64 uses separate C and control stacks) - VEH (Vectored Exception Handling) for ARM64, decoding BRK instructions which Windows reports as EXCEPTION_ILLEGAL_INSTRUCTION - sb_udivmodti4 takes hi/lo split arguments to avoid __uint128_t ABI issues on LLP64 where unsigned long is 32 bits - FP exception traps disabled (ARM64 Windows does not deliver FP exceptions even with FPCR trap bits set) - Dynamic space pages committed on demand (Windows reserves but does not commit the full dynamic space upfront) New files: - src/runtime/Config.arm64-win32: Build configuration - src/runtime/arm64-win32-os.c: OS layer (VEH, context access, FP) - src/runtime/arm64-win32-os.h: Platform header - .github/workflows/windows-arm64.yml: CI workflow Modified files grouped by subsystem: Runtime (ARM64-specific): - arm64-arch.c: Windows memory APIs, LLP64-safe pointer storage, sb_udivmodti4 split-argument ABI, static space NIL header guard - arm64-assem.S: Windows calling conventions for call_into_lisp and call_into_c, TlsGetValue for thread pointer, x18 reservation Runtime (Windows general): - win32-os.c: ARM64 safepoint page handling, BRK exception decode, ARM64 VEH, dynamic space page commit, ARM64 debug printing Compiler: - vm.lisp: Reserve x18 on Windows (matching Darwin) - c-call.lisp: Don't zero control-stack-pointer on Windows (not FFCA) - parms.lisp: Address space layout for Windows ARM64 - tramps.lisp: Save CSP to thread for GC, don't zero CSP on Windows - genesis.lisp: GC_SAFEPOINT_PAGE_ADDR for non-x86-64 platforms - parms.lisp (generic): Update safepoint space comment - debug-int.lisp: NFP handling for ARM64 Windows - float-trap.lisp: Disable FP traps on ARM64 Windows - coreparse.c: ARM64 guard for TEXT_SPACE_START assignment Build system: - make-config.sh: ARM64 Windows detection and feature flags - make-windows-installer.sh: ARM64 architecture in installer CI: - linux-arm64.yml, mac.yml: Robustness fixes for repo naming - windows-arm64.yml: New workflow for ARM64 Windows builds Tests: - subr.sh: Auto-detect sbcl.exe on Windows Co-Authored-By: Claude Opus 4.6 <[email protected]> --- .github/workflows/linux-arm64.yml | 9 +- .github/workflows/mac.yml | 9 +- .github/workflows/windows-arm64.yml | 68 ++++++++ make-config.sh | 11 ++ make-windows-installer.sh | 2 +- src/assembly/arm64/tramps.lisp | 9 ++ src/code/debug-int.lisp | 6 +- src/code/float-trap.lisp | 4 +- src/compiler/arm64/c-call.lisp | 2 + src/compiler/arm64/parms.lisp | 2 +- src/compiler/arm64/vm.lisp | 9 +- src/compiler/generic/genesis.lisp | 10 +- src/compiler/generic/parms.lisp | 5 +- src/runtime/Config.arm64-win32 | 55 +++++++ src/runtime/arm64-arch.c | 69 +++++++- src/runtime/arm64-assem.S | 68 ++++++-- src/runtime/arm64-win32-os.c | 240 ++++++++++++++++++++++++++++ src/runtime/arm64-win32-os.h | 26 +++ src/runtime/coreparse.c | 2 + src/runtime/win32-os.c | 133 ++++++++++++--- tests/subr.sh | 7 +- 21 files changed, 684 insertions(+), 62 deletions(-) create mode 100644 .github/workflows/windows-arm64.yml create mode 100644 src/runtime/Config.arm64-win32 create mode 100644 src/runtime/arm64-win32-os.c create mode 100644 src/runtime/arm64-win32-os.h diff --git a/.github/workflows/linux-arm64.yml b/.github/workflows/linux-arm64.yml index 9694ffac4..12e7936ae 100644 --- a/.github/workflows/linux-arm64.yml +++ b/.github/workflows/linux-arm64.yml @@ -31,16 +31,19 @@ jobs: if: matrix.subfeatures == 'fasteval' run: cd tests; ./run-tests.sh --evaluator-mode interpret - name: make binary + continue-on-error: true run: | name=sbcl-`cat version.lisp-expr | ./run-sbcl.sh --noinform --noprint --eval '(write-line (read))'`-linux-arm64 mkdir sbcl-linux-binary-arm64${{ matrix.options }} cd .. - mv sbcl $name + current_dir=$(basename "$PWD/sbcl") + mv $current_dir $name ./$name/binary-distribution.sh $name bzip2 $name-binary.tar - mv $name sbcl - mv $name-binary.tar.bz2 sbcl/sbcl-linux-binary-arm64${{ matrix.options }} + mv $name $current_dir + mv $name-binary.tar.bz2 $current_dir/sbcl-linux-binary-arm64${{ matrix.options }} - name: save binary + continue-on-error: true uses: actions/upload-artifact@v4 with: name: sbcl-linux-binary-arm64${{ matrix.options }} diff --git a/.github/workflows/mac.yml b/.github/workflows/mac.yml index 599b57fb1..eab6958fa 100644 --- a/.github/workflows/mac.yml +++ b/.github/workflows/mac.yml @@ -22,16 +22,19 @@ jobs: SBCL_MAKE_TARGET_2_OPTIONS: --disable-ldb --disable-debugger run: ./make.sh ${{ matrix.options }} --with-sb-core-compression --xc-host='sbcl --lose-on-corruption --disable-ldb --disable-debugger' - name: make binary + continue-on-error: true run: | name=sbcl-`cat version.lisp-expr | ./run-sbcl.sh --noinform --noprint --eval '(write-line (read))'`-darwin-${{ matrix.arch }} mkdir "sbcl-mac-binary-${{ matrix.arch }}${{ matrix.options }}" cd .. - mv sbcl $name + current_dir=$(basename "$PWD/sbcl") + mv $current_dir $name ./$name/binary-distribution.sh $name bzip2 $name-binary.tar - mv $name sbcl - mv $name-binary.tar.bz2 "sbcl/sbcl-mac-binary-${{ matrix.arch }}${{ matrix.options }}" + mv $name $current_dir + mv $name-binary.tar.bz2 "$current_dir/sbcl-mac-binary-${{ matrix.arch }}${{ matrix.options }}" - name: save binary + continue-on-error: true uses: actions/upload-artifact@v4 with: name: sbcl-mac-binary-${{ matrix.arch }}${{ matrix.options }} diff --git a/.github/workflows/windows-arm64.yml b/.github/workflows/windows-arm64.yml new file mode 100644 index 000000000..a550b6b3e --- /dev/null +++ b/.github/workflows/windows-arm64.yml @@ -0,0 +1,68 @@ +name: Windows ARM64 + +on: [push] + +jobs: + build: + + runs-on: windows-11-arm + + strategy: + matrix: + include: + - { sys: clangarm64, env: clang-aarch64, arch: arm64} + + fail-fast: false + + defaults: + run: + shell: msys2 {0} + + steps: + - uses: actions/checkout@v4 + with: + fetch-depth: 0 + - uses: msys2/setup-msys2@v2 + with: + install: mingw-w64-${{matrix.env}}-clang mingw-w64-${{matrix.env}}-toolchain make diffutils git libzstd-devel + msystem: ${{matrix.sys}} + + - name: install host sbcl + shell: pwsh + run: | + choco install sbcl -source tools-for-build + - name: install WiX Toolset + shell: pwsh + run: | + choco install wixtoolset + $wixPath = (Get-ChildItem "C:\Program Files (x86)\WiX Toolset*" | Select-Object -First 1).FullName + echo "WIX=$wixPath" | Out-File -FilePath $env:GITHUB_ENV -Encoding utf8 -Append + - name: build + env: + SBCL_HOME: "/c/Program Files/Steel Bank Common Lisp/1.4.14" + run: | + PATH=$PATH:"/c/Program Files/Steel Bank Common Lisp/1.4.14" + export PATH + ./make.sh --arch=${{matrix.arch}} --with-sb-core-compression --xc-host='sbcl --lose-on-corruption --disable-ldb --disable-debugger' + - name: make installer + env: + WIX: ${{ env.WIX }} + run: | + ./make-windows-installer.sh + mkdir sbcl-windows-installer; mv output/*msi sbcl-windows-installer + - name: save installer + uses: actions/upload-artifact@v4 + with: + name: sbcl-windows-installer-${{ matrix.sys }} + path: sbcl-windows-installer + - name: tests + continue-on-error: true + working-directory: tests + run: ./run-tests.sh + - name: ansi-tests + continue-on-error: true + working-directory: tests + run: ./ansi-tests.sh + + + diff --git a/make-config.sh b/make-config.sh index 1f885a540..5940463fc 100755 --- a/make-config.sh +++ b/make-config.sh @@ -694,6 +694,17 @@ case "$sbcl_os" in printf ' :os-provides-dlopen' >> $ltf printf ' :sb-thread :sb-safepoint' >> $ltf # + case "$sbcl_arch" in + arm64) + printf ' :immobile-space' >> $ltf + ;; + x86 | x86-64) + ;; + *) + echo "unsupported architecture for win32: $sbcl_arch" + exit 1 + ;; + esac link_or_copy Config.$sbcl_arch-win32 Config link_or_copy $sbcl_arch-win32-os.h target-arch-os.h link_or_copy win32-os.h target-os.h diff --git a/make-windows-installer.sh b/make-windows-installer.sh index b64b95a21..6f6b18976 100644 --- a/make-windows-installer.sh +++ b/make-windows-installer.sh @@ -26,7 +26,7 @@ cd ./output :if-exists :supersede) (format f "~a-~a-windows-binary" (lisp-implementation-version) - #+x86 "x86" #+x86-64 "x86-64")) + #+x86 "x86" #+x86-64 "x86-64" #+arm64 "arm64")) (exit))' "$WIX_PATH/candle" sbcl.wxs diff --git a/src/assembly/arm64/tramps.lisp b/src/assembly/arm64/tramps.lisp index 44e9fc5f5..367612be8 100644 --- a/src/assembly/arm64/tramps.lisp +++ b/src/assembly/arm64/tramps.lisp @@ -80,6 +80,11 @@ (inst stp cfp-tn lr-tn (@ csp-tn -112)) (map-pairs stp csp-tn -80 lisp-registers) + ;; Update thread->control_stack_pointer to include the saved + ;; Lisp registers so that scavenge_control_stack scans them + ;; if GC is triggered by the C allocation function. + #+sb-thread + (storew csp-tn thread-tn thread-control-stack-pointer-slot) (map-pairs stp nsp-tn 0 float-registers :pre-index -512 :delta 32) (invoke-foreign-routine ,c-name nl3) @@ -90,7 +95,9 @@ (inst ldr lr-tn (@ csp-tn -104)) (inst sub csp-tn csp-tn (+ 32 80)) ;; deallocate the frame + ;; Windows uses control-stack-pointer as actual SP, not FFCA flag #+sb-thread + #-win32 (inst str zr-tn (@ thread-tn (* thread-control-stack-pointer-slot n-word-bytes))) #-sb-thread (progn @@ -146,6 +153,7 @@ (map-pairs ldp csp-tn -16 lisp-registers :delta -16) (inst ldr lr-tn (@ csp-tn -104)) (inst sub csp-tn csp-tn (+ 32 80)) + #-win32 (inst str zr-tn (@ thread-tn (* thread-control-stack-pointer-slot n-word-bytes)))) (map-pairs ldp nsp-tn 64 nl-registers :post-index 80 :delta -16) (inst ret)) @@ -167,6 +175,7 @@ (map-pairs ldp csp-tn -16 lisp-registers :delta -16) (inst ldr lr-tn (@ csp-tn -104)) (inst sub csp-tn csp-tn (+ 32 80)) + #-win32 (inst str zr-tn (@ thread-tn (* thread-control-stack-pointer-slot n-word-bytes)))) (map-pairs ldp nsp-tn 64 nl-registers :post-index 80 :delta -16) (inst ret))))) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index a34061bc5..84d0e11b0 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -2625,11 +2625,11 @@ register." :invalid-value-for-unescaped-register-storage)) (with-nfp ((var) &body body) ;; x86oids have no separate number stack, so dummy it - ;; up for them. - #+c-stack-is-control-stack + ;; up for them. ARM64 Windows is similar - use control stack pointer. + #+(or c-stack-is-control-stack (and arm64 win32)) `(let ((,var fp)) ,@body) - #-c-stack-is-control-stack + #-(or c-stack-is-control-stack (and arm64 win32)) `(let ((,var (if escaped (int-sap (context-register escaped sb-vm::nfp-offset)) diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp index 8bc7755b4..224f750d3 100644 --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -158,7 +158,9 @@ sets the floating point modes to their current values (and thus is a no-op)." ;;; disabled by default. Joe User can explicitly enable them if ;;; desired. (define-load-time-global *saved-floating-point-modes* - '(:traps (:overflow #-(or netbsd ppc) :invalid :divide-by-zero) + '(:traps (#-(and arm64 win32) :overflow + #-(or netbsd ppc (and arm64 win32)) :invalid + #-(and arm64 win32) :divide-by-zero) :rounding-mode :nearest :current-exceptions nil :accrued-exceptions nil :fast-mode nil #+x86 :precision #+x86 :53-bit)) diff --git a/src/compiler/arm64/c-call.lisp b/src/compiler/arm64/c-call.lisp index 03843f4e4..18b0f3b11 100644 --- a/src/compiler/arm64/c-call.lisp +++ b/src/compiler/arm64/c-call.lisp @@ -481,6 +481,8 @@ ;; No longer OK to run GC except at safepoints. #+(or sb-safepoint nonstop-foreign-call) (storew zr-tn thread-tn thread-saved-csp-slot)) + ;; Windows uses control-stack-pointer as actual SP, not FFCA flag + #-win32 (storew zr-tn thread-tn thread-control-stack-pointer-slot) return #-sb-thread diff --git a/src/compiler/arm64/parms.lisp b/src/compiler/arm64/parms.lisp index ad2ac2101..3e8518903 100644 --- a/src/compiler/arm64/parms.lisp +++ b/src/compiler/arm64/parms.lisp @@ -69,7 +69,7 @@ ;;;; Where to put the different spaces. -(gc-space-setup #+(or linux openbsd netbsd freebsd) +(gc-space-setup #+(or linux openbsd netbsd freebsd win32) #x2F0000000 #+darwin #x300000000 #-darwin :read-only-space-size #-darwin 0 diff --git a/src/compiler/arm64/vm.lisp b/src/compiler/arm64/vm.lisp index a2cf196a0..945c7578b 100644 --- a/src/compiler/arm64/vm.lisp +++ b/src/compiler/arm64/vm.lisp @@ -45,7 +45,8 @@ (defreg r5 15) (defreg r6 16) (defreg r7 17) - (defreg #-darwin r8 #+darwin reserved 18) + ;; x18 is reserved on Darwin (macOS) and Windows (TEB pointer) + (defreg #-(or darwin win32) r8 #+(or darwin win32) reserved 18) (defreg r9 19) (defreg r10 20) @@ -68,7 +69,7 @@ null cfp nsp lr) (defregset descriptor-regs - r0 r1 r2 r3 r4 r5 r6 r7 #-darwin r8 r9 r10 #-sb-thread r11 lexenv) + r0 r1 r2 r3 r4 r5 r6 r7 #-(or darwin win32) r8 r9 r10 #-sb-thread r11 lexenv) ;; nl9 can't be selected by PACK as it is a freely usable temp reg (defregset non-descriptor-regs @@ -76,7 +77,7 @@ (defregset boxed-regs r0 r1 r2 r3 r4 r5 r6 - r7 #-darwin r8 r9 r10 #-sb-thread r11 lexenv) + r7 #-(or darwin win32) r8 r9 r10 #-sb-thread r11 lexenv) ;; registers used to pass arguments ;; @@ -85,7 +86,7 @@ ;; names and offsets for registers used to pass arguments (defregset *register-arg-offsets* r0 r1 r2 r3) (defconstant-eqx register-arg-names '(r0 r1 r2 r3) #'equal) - (defregset *descriptor-args* r0 r1 r2 r3 r4 r5 r6 r7 #-darwin r8 r9 r10) + (defregset *descriptor-args* r0 r1 r2 r3 r4 r5 r6 r7 #-(or darwin win32) r8 r9 r10) (defregset *non-descriptor-args* nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 nl8) (defglobal *float-regs* (loop for i below 32 collect i))) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index ec6dcecc6..5e9a3bb5c 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -3293,12 +3293,14 @@ Legal values for OFFSET are -4, -8, -12, ..." "#define PSEUDO_ATOMIC_TRAP ~D /* 0x~:*~X */~%" sb-vm::pseudo-atomic-trap) (terpri)) + ;; x86-64 uses GC_SAFEPOINT_PAGE_ADDR from gc.h (at STATIC_SPACE_END). + ;; Other platforms (including ARM64 Windows) place it before STATIC_SPACE_START. #+(and sb-safepoint (not x86-64)) (progn - (format t "#define GC_SAFEPOINT_PAGE_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%" - sb-c:+backend-page-bytes+) - (format t "#define GC_SAFEPOINT_TRAP_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%" - sb-vm:gc-safepoint-trap-offset)) + (format t "#define GC_SAFEPOINT_PAGE_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%" + sb-c:+backend-page-bytes+) + (format t "#define GC_SAFEPOINT_TRAP_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%" + sb-vm:gc-safepoint-trap-offset)) (dolist (symbol '(sb-vm:float-traps-byte sb-vm::float-exceptions-byte diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp index 24dd3df45..896ff3323 100644 --- a/src/compiler/generic/parms.lisp +++ b/src/compiler/generic/parms.lisp @@ -83,10 +83,9 @@ ;; #+immobile-space implies a relocatable alien linkage space. And x86-64 always ;; has relocatable linkage tables #-(or x86-64 immobile-space) (alien-linkage ,alien-linkage-space-size) - ;; safepoint on 64-bit uses a relocatable trap page just below the card mark - ;; table, which works nicely assuming a register is wired to the card table + ;; x86-64 uses a relocatable trap page just below the card mark + ;; table (wired to a register). Other platforms allocate a separate page. #+(and sb-safepoint (not x86-64)) - ;; Must be just before NIL. (safepoint ,(symbol-value '+backend-page-bytes+)) (static ,small-space-size) #+darwin-jit (static-code ,small-space-size))) diff --git a/src/runtime/Config.arm64-win32 b/src/runtime/Config.arm64-win32 new file mode 100644 index 000000000..8c2843953 --- /dev/null +++ b/src/runtime/Config.arm64-win32 @@ -0,0 +1,55 @@ +# This software is part of the SBCL system. See the README file for +# more information. +# +# This software is derived from the CMU CL system, which was +# written at Carnegie Mellon University and released into the +# public domain. The software is in the public domain and is +# provided with absolutely no warranty. See the COPYING and CREDITS +# files for more information. + +TARGET=sbcl.exe + +ASSEM_SRC = arm64-assem.S +ARCH_SRC = arm64-arch.c + +OS_SRC = win32-os.c arm64-win32-os.c + +ifdef LISP_FEATURE_SB_LINKABLE_RUNTIME + LIBSBCL = libsbcl.a + USE_LIBSBCL = -Wl,--whole-archive libsbcl.a -Wl,--no-whole-archive +endif + +LINKFLAGS = -Wl,-export-all-symbols +LIBSBCL += mswin64.def mswin.def +USE_LIBSBCL += -Wl,mswin64.def -Wl,mswin.def +SOFLAGS += -Wl,-export-all-symbols -Wl,mswin64.def -Wl,mswin.def + +__LDFLAGS__ = + +OS_LIBS = -l ws2_32 -ladvapi32 +ifdef LISP_FEATURE_SB_CORE_COMPRESSION + OS_LIBS += -lzstd +endif +ifdef LISP_FEATURE_SB_FUTEX + OS_LIBS += -lSynchronization +endif + +ifdef LISP_FEATURE_IMMOBILE_SPACE + GC_SRC = fullcgc.c gencgc.c traceroot.c immobile-space.c +else + GC_SRC = fullcgc.c gencgc.c traceroot.c +endif + +CFLAGS += -g -W -Wall \ + -Wno-unused-function -Wno-unused-parameter -Wno-cast-function-type \ + -Wno-type-limits \ + -fno-omit-frame-pointer \ + -O3 -DWINVER=0x0501 \ + -D__W32API_USE_DLLIMPORT__ \ + -std=gnu99 + +CC = clang + +ifeq ($(shell $(LD) --disable-dynamicbase 2>&1 | grep disable-dynamicbase),) +LINKFLAGS += -Wl,--disable-dynamicbase +endif diff --git a/src/runtime/arm64-arch.c b/src/runtime/arm64-arch.c index 2296c2762..01266d755 100644 --- a/src/runtime/arm64-arch.c +++ b/src/runtime/arm64-arch.c @@ -25,7 +25,14 @@ os_vm_address_t arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context) { +#ifdef WIN32 + /* The `code` argument is really a pointer to an EXCEPTION_RECORD, + * not a siginfo_t. */ + EXCEPTION_RECORD *exception = (EXCEPTION_RECORD *)code; + return (os_vm_address_t)exception->ExceptionInformation[1]; +#else return (os_vm_address_t)code->si_addr; +#endif } void arch_skip_instruction(os_context_t *context) @@ -210,20 +217,30 @@ void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) } else { // Do orig_inst by copying it into a trampoline. +#ifdef WIN32 + SYSTEM_INFO sys_info; + GetSystemInfo(&sys_info); + size_t size = sys_info.dwPageSize; +#else size_t size = getpagesize(); +#endif // Allocate the thread-local trampoline on-demand. struct thread *th = get_sb_vm_thread(); unsigned int *trampoline = (unsigned int*)th->breakpoint_misc; if (!trampoline) { +#ifdef WIN32 + trampoline = VirtualAlloc(NULL, size, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); +#else trampoline = mmap(NULL, size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); +#endif th->breakpoint_misc = trampoline; } else - os_protect((os_vm_address_t)trampoline, size, PROT_READ | PROT_WRITE); + os_protect((os_vm_address_t)trampoline, size, OS_VM_PROT_READ | OS_VM_PROT_WRITE); unsigned int *inst_ptr = trampoline; unsigned int inst; @@ -246,11 +263,13 @@ void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) inst = 0xD61F0000 | BREAKPOINT_TEMP_REG << 5; *inst_ptr++ = inst; - // address - *(unsigned long *)inst_ptr++ = (unsigned long)next_pc; + // address (8 bytes for a 64-bit pointer; unsigned long is only + // 4 bytes on Windows LLP64, so use uint64_t explicitly) + *(uint64_t *)inst_ptr = (uint64_t)next_pc; + inst_ptr += 2; OS_CONTEXT_PC(context) = (uword_t)trampoline; os_flush_icache((os_vm_address_t) trampoline, (char*) inst_ptr - (char*)trampoline); - os_protect((os_vm_address_t)trampoline, size, PROT_READ | PROT_EXEC); + os_protect((os_vm_address_t)trampoline, size, OS_VM_PROT_READ | OS_VM_PROT_EXECUTE); return; } @@ -277,6 +296,7 @@ arch_handle_single_step_trap(os_context_t *context, int trap) arch_skip_instruction(context); } +#ifndef WIN32 static void sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context) { @@ -289,10 +309,11 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context) handle_trap(context, code); } +#endif void sigill_handler(int signal, siginfo_t *siginfo, os_context_t *context); -#ifndef LISP_FEATURE_DARWIN +#if !defined(LISP_FEATURE_DARWIN) && !defined(WIN32) void sigill_handler(int signal, siginfo_t *siginfo, os_context_t *context) { fake_foreign_function_call(context); @@ -302,8 +323,12 @@ sigill_handler(int signal, siginfo_t *siginfo, os_context_t *context) { void arch_install_interrupt_handlers() { +#ifndef WIN32 ll_install_handler(SIGTRAP, sigtrap_handler); ll_install_handler(SIGILL, sigill_handler); +#else + // Interrupt handlers are installed in win32-os.c +#endif } @@ -320,7 +345,7 @@ void arch_write_linkage_table_entry(int index, void *target_addr, int datap) char *reloc_addr = (char*)ALIEN_LINKAGE_SPACE_START + index * ALIEN_LINKAGE_TABLE_ENTRY_SIZE; if (datap) { - *(unsigned long *)reloc_addr = (unsigned long)target_addr; + *(uword_t *)reloc_addr = (uword_t)target_addr; goto DONE; } /* @@ -341,8 +366,9 @@ void arch_write_linkage_table_entry(int index, void *target_addr, int datap) inst = 0xD61F0000 | LINKAGE_TEMP_REG << 5; *inst_ptr++ = inst; - // address - *(unsigned long *)inst_ptr++ = (unsigned long)target_addr; + // address (64-bit pointer - must use uword_t on Windows where unsigned long is 32-bit) + *(uword_t *)inst_ptr = (uword_t)target_addr; + inst_ptr += 2; // advance by 8 bytes (2 x 4-byte ints) os_flush_icache((os_vm_address_t) reloc_addr, (char*) inst_ptr - reloc_addr); @@ -369,6 +395,19 @@ os_vm_address_t coreparse_alloc_space(int space_id, int attr, addr -= extra_request; // try to put text space start where expected } #endif + +#ifdef WIN32 + // On Windows ARM64, STATIC_SPACE needs extra space before it for NIL header access. + // ARM64 accesses NIL-0x1F for type checking, which must be within allocated memory. + // This must be done even when size==0. + if (space_id == STATIC_CORE_SPACE_ID) { + uword_t alloc_size = (size == 0) ? BACKEND_PAGE_BYTES : size + BACKEND_PAGE_BYTES; + addr = os_alloc_gc_space(space_id, attr, addr - BACKEND_PAGE_BYTES, alloc_size) + BACKEND_PAGE_BYTES; + if (!addr) lose("Can't allocate %#"OBJ_FMTX" bytes for space %d", size, space_id); + return addr; + } +#endif + if (size == 0) return addr; #ifdef LISP_FEATURE_SB_SAFEPOINT @@ -385,14 +424,28 @@ os_vm_address_t coreparse_alloc_space(int space_id, int attr, #ifdef LISP_FEATURE_IMMOBILE_SPACE if (space_id == IMMOBILE_TEXT_CORE_SPACE_ID) { ALIEN_LINKAGE_SPACE_START = (uword_t)addr; + // TEXT_SPACE actually starts after ALIEN_LINKAGE_SPACE + TEXT_SPACE_START = (uword_t)addr + extra_request; addr += extra_request; } #endif return addr; } +#ifdef _WIN32 +/* Windows ARM64 (LLP64): unsigned long is 32-bit, and __uint128_t + passing via registers differs from the Lisp alien-funcall ABI. + Take hi/lo as separate 64-bit args to match the Lisp transform. */ +uint64_t sb_udivmodti4(uint64_t lo, uint64_t hi, uint64_t y, uint64_t *rem) { + __uint128_t x = ((__uint128_t)hi << 64) | lo; + if (rem) + *rem = x % y; + return x / y; +} +#else long sb_udivmodti4(__uint128_t x, unsigned long y, unsigned long *rem) { if (rem) *rem = x % y; return x / y; } +#endif diff --git a/src/runtime/arm64-assem.S b/src/runtime/arm64-assem.S index 57b6e945e..9181e90f0 100644 --- a/src/runtime/arm64-assem.S +++ b/src/runtime/arm64-assem.S @@ -23,8 +23,16 @@ ldr \dest, [\dest, _\symbol@PAGEOFF] .endm -#else +#elif defined(LISP_FEATURE_WIN32) +#define TYPE(name) +#define SIZE(name) +#define GNAME(var) var +.macro LOAD_GNAME, dest, symbol + adrp \dest, \symbol + ldr \dest, [\dest, #:lo12:\symbol] +.endm +#else #define TYPE(name) .type name,%function #define SIZE(name) .size name,.-name #define GNAME(var) var @@ -153,6 +161,22 @@ GNAME(call_into_lisp): mov reg_LEXENV, x0 #ifdef LISP_FEATURE_SB_THREAD +#if defined(LISP_FEATURE_WIN32) + // On Windows ARM64, get thread pointer via TlsGetValue(OUR_TLS_INDEX) + // Save arguments (x1, x2) and link register before C call + stp x1, x2, [sp, #-32]! + stp x29, x30, [sp, #16] + + // Load OUR_TLS_INDEX (sbcl_thread_tls_index) and call TlsGetValue + adrp x0, sbcl_thread_tls_index + ldr w0, [x0, #:lo12:sbcl_thread_tls_index] + bl TlsGetValue + mov reg_THREAD, x0 + + // Restore arguments and link register + ldp x29, x30, [sp, #16] + ldp x1, x2, [sp], #32 +#else #ifdef LISP_FEATURE_GCC_TLS #ifdef LISP_FEATURE_DARWIN @@ -179,6 +203,7 @@ GNAME(call_into_lisp): bl pthread_getspecific mov reg_THREAD, x0 #endif +#endif #endif // Clear the boxed registers that don't already have something // in them. @@ -190,7 +215,8 @@ GNAME(call_into_lisp): mov reg_R5, #0 mov reg_R6, #0 mov reg_R7, #0 -#ifndef LISP_FEATURE_DARWIN +#if !defined(LISP_FEATURE_DARWIN) && !defined(LISP_FEATURE_WIN32) + // x18 is reserved on Darwin (macOS) and Windows (TEB pointer) mov reg_R8, #0 #endif mov reg_R10, #0 @@ -219,7 +245,10 @@ GNAME(call_into_lisp): 1: #endif +// Windows uses control_stack_pointer as actual SP, not FFCA flag +#ifndef LISP_FEATURE_WIN32 str xzr,[reg_THREAD, THREAD_CONTROL_STACK_POINTER_OFFSET] +#endif #else ldr reg_NL3, =GNAME(foreign_function_call_active) str xzr, [reg_NL3] @@ -251,8 +280,9 @@ Lno_args: ldr reg_LR, [reg_LEXENV, #CLOSURE_FUN_OFFSET] blr reg_LR - // Correct stack pointer for return processing. - csel reg_CSP, reg_OCFP, reg_CSP, eq + // NOTE: We do NOT adjust CSP here. The Lisp calling convention ensures that + // the callee restores CSP to its pre-call value before returning. + // The original code had a csel instruction here that was buggy. // Return value mov x0, reg_R0 @@ -311,14 +341,17 @@ GNAME(call_into_c): // All other C arguments are already stashed on the C stack. // Build a Lisp stack frame. - // Can store two values above the stack pointer, interrupts ignore them. - stp reg_CFP, reg_LR, [reg_CSP] - add reg_R10, reg_CSP, #2*8 + // Save the current thread structure CFP/CSP first, then our own CFP/LR. +#ifdef LISP_FEATURE_SB_THREAD + ldp x3, x4, [reg_THREAD, THREAD_CONTROL_FRAME_POINTER_OFFSET] // Load thread CFP/CSP + stp x3, x4, [reg_CSP, #-16]! // Push thread CFP/CSP onto stack, CSP -= 16 +#endif + stp reg_CFP, reg_LR, [reg_CSP, #-16]! // Push our CFP/LR, CSP -= 16 + add reg_R10, reg_CSP, #32 // R10 = original CSP (before both pushes) mov reg_LEXENV, reg_LR - // Save the lisp stack and frame pointers. - #ifdef LISP_FEATURE_SB_THREAD + // Now save our own stack pointers to thread structure. stp reg_CSP, reg_R10, [reg_THREAD, THREAD_CONTROL_FRAME_POINTER_OFFSET] #else ENTER_PA @@ -359,7 +392,8 @@ GNAME(call_into_c): mov reg_R5, #0 mov reg_R6, #0 mov reg_R7, #0 -#ifndef LISP_FEATURE_DARWIN +#if !defined(LISP_FEATURE_DARWIN) && !defined(LISP_FEATURE_WIN32) + // x18 is reserved on Darwin (macOS) and Windows (TEB pointer) mov reg_R8,#0 #endif #ifndef LISP_FEATURE_SB_THREAD @@ -372,14 +406,24 @@ GNAME(call_into_c): #endif - // Restore the Lisp stack and frame pointers + // Restore the Lisp stack and frame pointers from the stack + // Stack layout: [CSP] = CFP, [CSP+8] = LR, [CSP+16] = thread CFP, [CSP+24] = thread CSP + ldp reg_CFP, reg_LR, [reg_CSP], #16 // Restore CFP/LR, CSP += 16 + #ifdef LISP_FEATURE_SB_THREAD + // Now restore the thread structure CFP/CSP that we saved at entry. + ldp x3, x4, [reg_CSP], #16 // Load saved thread CFP/CSP, CSP += 16 + stp x3, x4, [reg_THREAD, THREAD_CONTROL_FRAME_POINTER_OFFSET] // Restore to thread structure + +// Windows uses control_stack_pointer as actual SP, not FFCA flag +#ifndef LISP_FEATURE_WIN32 str xzr, [reg_THREAD, THREAD_CONTROL_STACK_POINTER_OFFSET] +#endif #else // Clear FFCA, so the runtime knows that we're "in lisp". str xzr, [reg_OCFP] #endif - mov reg_LR, reg_LEXENV + mov reg_LEXENV, reg_LR ret SIZE(call_into_c) diff --git a/src/runtime/arm64-win32-os.c b/src/runtime/arm64-win32-os.c new file mode 100644 index 000000000..ac18482db --- /dev/null +++ b/src/runtime/arm64-win32-os.c @@ -0,0 +1,240 @@ +/* + * The ARM64 Win32 incarnation of arch-dependent OS-dependent routines. + * See also "win32-os.c". + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +#include <stdio.h> +#include <stddef.h> +#include <string.h> // For memset +#include <sys/param.h> +#include <sys/file.h> +#include <sys/types.h> +#include <unistd.h> +#include <errno.h> + +#include "os.h" +#include "arch.h" +#include "globals.h" +#include "interrupt.h" +#include "interr.h" +#include "lispregs.h" +#include "genesis/sbcl.h" + +#include <sys/types.h> +#include "runtime.h" +#include <sys/time.h> +#include <sys/stat.h> +#include <unistd.h> +#include "thread.h" /* dynamic_values_bytes */ +#include "align.h" + +#include "validate.h" + +#include <windows.h> // For VirtualQuery, GetLastError, FlushInstructionCache + +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); + + extern void win32_set_stack_guarantee(void); + win32_set_stack_guarantee(); + + return 1; +} + +/* free any arch/os-specific resources used by thread, which is now + * defunct. Not called on live threads + */ +int arch_os_thread_cleanup(struct thread *thread) { + return 0; +} + +sigset_t *os_context_sigmask_addr(os_context_t *context) +{ + return &context->sigmask; +} + +void visit_context_registers(void (*proc)(os_context_register_t,void*), + os_context_t *context, void* arg) +{ + // ARM64 general purpose registers X0-X30 and program counter Pc + proc(context->win32_context->X0, arg); + proc(context->win32_context->X1, arg); + proc(context->win32_context->X2, arg); + proc(context->win32_context->X3, arg); + proc(context->win32_context->X4, arg); + proc(context->win32_context->X5, arg); + proc(context->win32_context->X6, arg); + proc(context->win32_context->X7, arg); + proc(context->win32_context->X8, arg); + proc(context->win32_context->X9, arg); + proc(context->win32_context->X10, arg); + proc(context->win32_context->X11, arg); + proc(context->win32_context->X12, arg); + proc(context->win32_context->X13, arg); + proc(context->win32_context->X14, arg); + proc(context->win32_context->X15, arg); + proc(context->win32_context->X16, arg); + proc(context->win32_context->X17, arg); + proc(context->win32_context->X18, arg); + proc(context->win32_context->X19, arg); + proc(context->win32_context->X20, arg); + proc(context->win32_context->X21, arg); + proc(context->win32_context->X22, arg); + proc(context->win32_context->X23, arg); + proc(context->win32_context->X24, arg); + proc(context->win32_context->X25, arg); + proc(context->win32_context->X26, arg); + proc(context->win32_context->X27, arg); + proc(context->win32_context->X28, arg); + proc(context->win32_context->Fp, arg); // X29 Frame Pointer + proc(context->win32_context->Lr, arg); // X30 Link Register + proc(context->win32_context->Pc, arg); // Program Counter +} + +#include "lispregs.h" // This will pull in arm64-lispregs.h via target-lispregs.h + +// ... (rest of the file remains the same until os_context_register_addr) ... + +os_context_register_t * +os_context_register_addr(os_context_t *context, int offset) +{ + if (!context) { + return NULL; + } + if (!context->win32_context) { + return NULL; + } + + // Map physical ARM64 register number (0-31) to CONTEXT structure fields + // The offset parameter is the physical register number from arm64-lispregs.h + + switch (offset) { + case 0: return (os_context_register_t*)&context->win32_context->X0; + case 1: return (os_context_register_t*)&context->win32_context->X1; + case 2: return (os_context_register_t*)&context->win32_context->X2; + case 3: return (os_context_register_t*)&context->win32_context->X3; + case 4: return (os_context_register_t*)&context->win32_context->X4; + case 5: return (os_context_register_t*)&context->win32_context->X5; + case 6: return (os_context_register_t*)&context->win32_context->X6; + case 7: return (os_context_register_t*)&context->win32_context->X7; + case 8: return (os_context_register_t*)&context->win32_context->X8; + case 9: return (os_context_register_t*)&context->win32_context->X9; + case 10: return (os_context_register_t*)&context->win32_context->X10; + case 11: return (os_context_register_t*)&context->win32_context->X11; + case 12: return (os_context_register_t*)&context->win32_context->X12; + case 13: return (os_context_register_t*)&context->win32_context->X13; + case 14: return (os_context_register_t*)&context->win32_context->X14; + case 15: return (os_context_register_t*)&context->win32_context->X15; + case 16: return (os_context_register_t*)&context->win32_context->X16; + case 17: return (os_context_register_t*)&context->win32_context->X17; + case 18: return (os_context_register_t*)&context->win32_context->X18; + case 19: return (os_context_register_t*)&context->win32_context->X19; + case 20: return (os_context_register_t*)&context->win32_context->X20; + case 21: return (os_context_register_t*)&context->win32_context->X21; + case 22: return (os_context_register_t*)&context->win32_context->X22; + case 23: return (os_context_register_t*)&context->win32_context->X23; + case 24: return (os_context_register_t*)&context->win32_context->X24; + case 25: return (os_context_register_t*)&context->win32_context->X25; + case 26: return (os_context_register_t*)&context->win32_context->X26; + case 27: return (os_context_register_t*)&context->win32_context->X27; + case 28: return (os_context_register_t*)&context->win32_context->X28; + case 29: return (os_context_register_t*)&context->win32_context->Fp; // X29 + case 30: return (os_context_register_t*)&context->win32_context->Lr; // X30 + case 31: return (os_context_register_t*)&context->win32_context->Sp; // X31 (SP) + default: + return NULL; + } +} + +os_context_register_t * +os_context_sp_addr(os_context_t *context) +{ + return (os_context_register_t*)&context->win32_context->Sp; +} + +os_context_register_t * +os_context_fp_addr(os_context_t *context) +{ + return (os_context_register_t*)&context->win32_context->Fp; +} + +os_context_register_t * +os_context_lr_addr(os_context_t *context) +{ + return (os_context_register_t*)&context->win32_context->Lr; +} + +os_context_register_t * +os_context_flags_addr(os_context_t *context) +{ + // On ARM64 Windows, the CPSR is typically available as a separate field + // within the CONTEXT structure or can be accessed via an appropriate + // field for flags. Assuming `Cpsr` is the field name. + return (os_context_register_t*)&context->win32_context->Cpsr; +} + + +unsigned long +os_context_fp_control(os_context_t *context) +{ + return context->win32_context->Fpsr | context->win32_context->Fpcr; +} + +void +os_restore_fp_control(os_context_t *context) +{ + /* No-op on ARM64, same as Linux and BSD. FPCR is preserved across exceptions. */ +} + +os_context_register_t * +os_context_float_register_addr(os_context_t *context, int offset) +{ + if (!context) { + return NULL; + } + if (!context->win32_context) { + return NULL; + } + + // ARM64 Windows CONTEXT structure has V[0-31] array for SIMD/FP registers + // Each V register is 128 bits (16 bytes) + // The offset parameter is the physical register number (0-31) + + if (offset >= 0 && offset < 32) { + return (os_context_register_t*)&context->win32_context->V[offset]; + } + + return NULL; +} + +void +os_flush_icache(os_vm_address_t address, os_vm_size_t length) +{ + // Use the Windows API function for flushing instruction cache. + // The first argument is a process handle. For the current process, GetCurrentProcess() can be used. + if (!FlushInstructionCache(GetCurrentProcess(), address, length)) { + // Log an error or handle failure if necessary. + fprintf(stderr, "FlushInstructionCache failed: 0x%lx.\n", GetLastError()); + } +} diff --git a/src/runtime/arm64-win32-os.h b/src/runtime/arm64-win32-os.h new file mode 100644 index 000000000..60154d046 --- /dev/null +++ b/src/runtime/arm64-win32-os.h @@ -0,0 +1,26 @@ +#ifndef _ARM64_WIN32_OS_H +#define _ARM64_WIN32_OS_H + +typedef struct os_context_t { + CONTEXT* win32_context; + sigset_t sigmask; +} os_context_t; + +typedef intptr_t os_context_register_t; + +static inline DWORD NT_GetLastError() { + return GetLastError(); +} + +unsigned long os_context_fp_control(os_context_t *context); +void os_restore_fp_control(os_context_t *context); +os_context_register_t * os_context_fp_addr(os_context_t *context); +os_context_register_t * os_context_sp_addr(os_context_t *context); +os_context_register_t * os_context_lr_addr(os_context_t *context); +os_context_register_t * os_context_flags_addr(os_context_t *context); +os_context_register_t * os_context_register_addr(os_context_t *context, int offset); +os_context_register_t * os_context_float_register_addr(os_context_t *context, int offset); + +#define OS_CONTEXT_PC(context) context->win32_context->Pc + +#endif /* _ARM64_WIN32_OS_H */ diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c index 1ef5ba26c..7e163fcc5 100644 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@ -853,7 +853,9 @@ process_directory(int count, struct ndir_entry *entry, break; #endif case IMMOBILE_TEXT_CORE_SPACE_ID: +#ifndef LISP_FEATURE_ARM64 TEXT_SPACE_START = addr; +#endif break; case DYNAMIC_CORE_SPACE_ID: { diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c index 849ce3fce..63bc29460 100644 --- a/src/runtime/win32-os.c +++ b/src/runtime/win32-os.c @@ -115,7 +115,14 @@ static void set_seh_frame(void *frame) void alloc_gc_page() { -#ifndef LISP_FEATURE_64_BIT // 64-bit uses the page below the card mark table +#ifdef LISP_FEATURE_ARM64 + // ARM64: safepoint page address is reserved by the address space layout + // (parms.lisp), but needs to be committed. Use MEM_COMMIT only. + gc_assert(VirtualAlloc(GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES, + MEM_COMMIT, PAGE_READWRITE)); +#elif !defined(LISP_FEATURE_64_BIT) + // 32-bit: reserve and commit safepoint page. + // 64-bit x86-64: allocated as part of static space (extra_above in x86-64-arch.c). gc_assert(VirtualAlloc(GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES, MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE)); #endif @@ -144,16 +151,20 @@ void alloc_gc_page() */ void map_gc_page() { +#if defined(LISP_FEATURE_SB_SAFEPOINT) DWORD oldProt; gc_assert(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES, PAGE_READWRITE, &oldProt)); +#endif } void unmap_gc_page() { +#if defined(LISP_FEATURE_SB_SAFEPOINT) DWORD oldProt; gc_assert(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES, PAGE_NOACCESS, &oldProt)); +#endif } uint32_t os_get_build_time_shared_libraries(uint32_t excl_maximum, @@ -735,7 +746,6 @@ void os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { DWORD old_prot; - DWORD new_prot = os_protect_modes[prot]; gc_assert(VirtualProtect(address, length, new_prot, &old_prot)|| (VirtualAlloc(address, length, MEM_COMMIT, new_prot) && @@ -750,16 +760,19 @@ extern int internal_errors_enabled; extern void exception_handler_wrapper(); -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) #define voidreg(ctxptr,name) ((void*)((ctxptr)->E##name)) -#else +#elif defined(LISP_FEATURE_X86_64) #define voidreg(ctxptr,name) ((void*)((ctxptr)->R##name)) +#else // ARM64 and others. Stub out for now. +#define voidreg(ctxptr,name) (0) #endif static int handle_single_step(os_context_t *ctx) { +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) if (!single_stepping) return -1; @@ -768,19 +781,48 @@ handle_single_step(os_context_t *ctx) restore_breakpoint_from_single_step(ctx); return 0; +#else + return -1; +#endif } -#ifdef LISP_FEATURE_UD2_BREAKPOINTS -#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION -#define TRAP_CODE_WIDTH 2 -#else -#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_BREAKPOINT -#define TRAP_CODE_WIDTH 1 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) + #ifdef LISP_FEATURE_UD2_BREAKPOINTS + #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION + #define TRAP_CODE_WIDTH 2 + #else + #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_BREAKPOINT + #define TRAP_CODE_WIDTH 1 + #endif +#elif defined(LISP_FEATURE_ARM64) + // On Windows ARM64, BRK instructions trigger EXCEPTION_ILLEGAL_INSTRUCTION, not EXCEPTION_BREAKPOINT + #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION + #define TRAP_CODE_WIDTH 4 // ARM breakpoint instruction is 4 bytes #endif static int handle_breakpoint_trap(os_context_t *ctx, struct thread* self) { +#if defined(LISP_FEATURE_ARM64) + uint32_t trap_instruction = *(uint32_t *)OS_CONTEXT_PC(ctx); + unsigned int trap; + + // Check for BRK instruction format used by SBCL. The high bits are + // 11010100001, which is 0x6a1. + if ((trap_instruction >> 21) == 0x6a1) { + // Extract 8-bit trap code from bits 5..12 (matching sigtrap_handler on Linux) + trap = (trap_instruction >> 5) & 0xFF; + } else { + // Not a recognized SBCL trap, could be a debugger breakpoint + // or a real illegal instruction. Let other handlers deal with it. + return -1; + } + + /* On ARM64, do NOT advance PC past the BRK instruction here. + * The Lisp-side internal-error-args reads the BRK instruction from + * the context PC to decode error number and arguments. + * PC will be advanced by arch_skip_instruction after error handling. */ +#else /* Not ARM64 */ #ifdef LISP_FEATURE_UD2_BREAKPOINTS if (((unsigned short *)OS_CONTEXT_PC(ctx))[0] != 0x0b0f) return -1; @@ -793,14 +835,14 @@ handle_breakpoint_trap(os_context_t *ctx, struct thread* self) /* Now EIP points just after the INT3 byte and aims at the * 'kind' value (eg trap_Cerror). */ unsigned trap = *(unsigned char *)OS_CONTEXT_PC(ctx); +#endif /* Before any other trap handler: gc_safepoint ensures that inner alloc_sap for passing the context won't trap on pseudo-atomic. */ /* Now that there is no alloc_sap, I don't know what happens here. */ if (trap == trap_PendingInterrupt) { - /* Done everything needed for this trap, except EIP - adjustment */ + /* Advance PC past the trap instruction and any trailing data. */ arch_skip_instruction(ctx); thread_interrupted(ctx); return 0; @@ -840,9 +882,9 @@ handle_access_violation(os_context_t *ctx, win32_context->Edi, fault_address, exception_record->ExceptionInformation[0]); -#else +#elif defined(LISP_FEATURE_X86_64) odxprint(pagefaults, - "SEGV. ThSap %p, Eip %p, Esp %p, Esi %p, Edi %p, " + "SEGV. ThSap %p, Rip %p, Rsp %p, Rsi %p, Rdi %p, " "Addr %p Access %d\n", self, win32_context->Rip, @@ -851,11 +893,42 @@ handle_access_violation(os_context_t *ctx, win32_context->Rdi, fault_address, exception_record->ExceptionInformation[0]); +#elif defined(LISP_FEATURE_ARM64) + odxprint(pagefaults, + "SEGV. ThSap %p, Pc %p, Sp %p, " + "Addr %p Access %d\n", + self, + win32_context->Pc, + win32_context->Sp, + fault_address, + exception_record->ExceptionInformation[0]); #endif /* Safepoint pages */ if (fault_address == (void *) GC_SAFEPOINT_TRAP_ADDR) { +#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK + /* x86/x86-64: set_csp_from_context arranges for the conservative + * stack scan to cover the CONTEXT, so register values are found. */ + thread_in_lisp_raised(ctx); +#else + /* ARM64: separate control and C stacks. The register context must + * be explicitly saved so that GC can scan Lisp register values. + * (Mirrors handle_safepoint_violation in safepoint.c for Unix.) */ + fake_foreign_function_call(ctx); thread_in_lisp_raised(ctx); + undo_fake_foreign_function_call(ctx); + /* Scrub stale Lisp frames left on the control stack by SUB-GC. + * undo_fake_foreign_function_call zeroed thread->csp (it IS + * foreign_function_call_active_p on ARM64), so temporarily + * restore it from the interrupt context for scrubbing. */ + { + lispobj *csp = (lispobj*)(uword_t) + (*os_context_register_addr(ctx, reg_CSP)); + access_control_stack_pointer(self) = csp; + scrub_thread_control_stack(self); + access_control_stack_pointer(self) = 0; + } +#endif return 0; } @@ -867,7 +940,15 @@ handle_access_violation(os_context_t *ctx, /* dynamic space */ page_index_t page = find_page_index(fault_address); #ifdef LISP_FEATURE_SOFT_CARD_MARKS - if (page >= 0) lose("should not get access violation in dynamic space %p", fault_address); + if (page >= 0) { + /* With soft card marks, pages are never write-protected, so a + * dynamic space access violation means the page needs committing. + * (Windows reserves the full dynamic space but only commits pages + * on demand or via prepare_pages/gc_alloc_large.) */ + os_commit_memory(PTR_ALIGN_DOWN(fault_address, os_vm_page_size), + os_vm_page_size); + return 0; + } #else if (page != -1 && !PAGE_WRITEPROTECTED_P(page)) { os_commit_memory(PTR_ALIGN_DOWN(fault_address, os_vm_page_size), @@ -913,7 +994,9 @@ signal_internal_error_or_lose(os_context_t *ctx, /* The exception system doesn't automatically clear pending * exceptions, so we lose as soon as we execute any FP * instruction unless we do this first. */ + #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) asm("fnclex"); +#endif /* We're making the somewhat arbitrary decision that having * internal errors enabled means that lisp has sufficient * marbles to be able to handle exceptions, but exceptions @@ -928,7 +1011,7 @@ signal_internal_error_or_lose(os_context_t *ctx, DX_ALLOC_SAP(exception_record_sap, exception_record); thread_sigmask(SIG_SETMASK, &ctx->sigmask, NULL); -#ifdef LISP_FEATURE_X86_64 +#if defined(LISP_FEATURE_X86_64) asm("fninit"); #endif @@ -1003,6 +1086,7 @@ handle_exception_ex(EXCEPTION_RECORD *exception_record, /* For EXCEPTION_ACCESS_VIOLATION only. */ void *fault_address = (void *)exception_record->ExceptionInformation[1]; + #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) odxprint(seh, "SEH: rec %p, ctxptr %p, rip %p, fault %p\n" "... code %p, rcx %p, fp-tags %p\n\n", @@ -1013,6 +1097,15 @@ handle_exception_ex(EXCEPTION_RECORD *exception_record, (void*)(intptr_t)code, voidreg(win32_context,cx), win32_context->FloatSave.TagWord); +#else // ARM64 + odxprint(seh, + "SEH: rec %p, ctxptr %p, pc %p, fault %p, code %p\n\n", + exception_record, + win32_context, + (void*)win32_context->Pc, + fault_address, + (void*)(intptr_t)code); +#endif /* This function had become unwieldy. Let's cut it down into * pieces based on the different exception codes. Each exception @@ -1093,7 +1186,7 @@ handle_exception(EXCEPTION_RECORD *exception_record, return handle_exception_ex(exception_record, exception_frame, win32_context, FALSE); } -#ifdef LISP_FEATURE_X86_64 +#if defined(LISP_FEATURE_X86_64) || defined(LISP_FEATURE_ARM64) #define RESTORING_ERRNO() \ int sbcl__lastErrno = errno; \ @@ -1119,7 +1212,11 @@ veh(EXCEPTION_POINTERS *ep) return EXCEPTION_CONTINUE_SEARCH; } +#if defined(LISP_FEATURE_X86_64) DWORD64 rip = ep->ContextRecord->Rip; +#elif defined(LISP_FEATURE_ARM64) + DWORD64 rip = ep->ContextRecord->Pc; +#endif long int code = ep->ExceptionRecord->ExceptionCode; BOOL from_lisp = (rip >= DYNAMIC_SPACE_START && rip < DYNAMIC_SPACE_START+dynamic_space_size) || @@ -1166,7 +1263,7 @@ wos_install_interrupt_handlers handler->next_frame = get_seh_frame(); handler->handler = (void*)exception_handler_wrapper; set_seh_frame(handler); -#else +#elif defined(LISP_FEATURE_X86_64) || defined(LISP_FEATURE_ARM64) static int once = 0; if (!once++) AddVectoredExceptionHandler(1,veh); diff --git a/tests/subr.sh b/tests/subr.sh index 1c115f15c..b6471f17e 100644 --- a/tests/subr.sh +++ b/tests/subr.sh @@ -28,7 +28,12 @@ set -a # export all variables at assignment-time. # quote them (with double quotes), to contend with whitespace. SBCL_HOME="${TEST_SBCL_HOME:-$SBCL_PWD/../obj/sbcl-home}" SBCL_CORE="${TEST_SBCL_CORE:-$SBCL_PWD/../output/sbcl.core}" -SBCL_RUNTIME="${TEST_SBCL_RUNTIME:-$SBCL_PWD/../src/runtime/sbcl}" +# On Windows, the runtime is sbcl.exe; on Unix, it's sbcl +if [ -f "$SBCL_PWD/../src/runtime/sbcl.exe" ]; then + SBCL_RUNTIME="${TEST_SBCL_RUNTIME:-$SBCL_PWD/../src/runtime/sbcl.exe}" +else + SBCL_RUNTIME="${TEST_SBCL_RUNTIME:-$SBCL_PWD/../src/runtime/sbcl}" +fi SBCL_ARGS="${TEST_SBCL_ARGS:---disable-ldb --noinform --no-sysinit --no-userinit --noprint --disable-debugger}" -- 2.43.0