common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Add ARM64 Windows platform support

Browse source 
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 <noreply@anthropic.com>
This commit is contained in:
SANO,Masatoshi 2026-02-12 13:49:10 +09:00 committed by Stas Boukarev
parent 66e8662c13
commit aa0fa1c56e
19 changed files with 658 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
.github/workflows/windows-arm64.yml vendored Normal file
View file

@ -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

11
make-config.sh
View file

@ -694,6 +694,17 @@ case "$sbcl_os" in
printf ' :os-provides-dlopen' >> $ltf printf ' :os-provides-dlopen' >> $ltf
printf ' :sb-thread :sb-safepoint' >> $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 Config.$sbcl_arch-win32 Config
link_or_copy $sbcl_arch-win32-os.h target-arch-os.h link_or_copy $sbcl_arch-win32-os.h target-arch-os.h
link_or_copy win32-os.h target-os.h link_or_copy win32-os.h target-os.h

2
make-windows-installer.sh
View file

@ -26,7 +26,7 @@ cd ./output
:if-exists :supersede) :if-exists :supersede)
(format f "~a-~a-windows-binary" (format f "~a-~a-windows-binary"
(lisp-implementation-version) (lisp-implementation-version)
#+x86 "x86" #+x86-64 "x86-64")) #+x86 "x86" #+x86-64 "x86-64" #+arm64 "arm64"))
(exit))' (exit))'
"$WIX_PATH/candle" sbcl.wxs "$WIX_PATH/candle" sbcl.wxs

4
src/assembly/arm64/tramps.lisp
View file

@ -90,7 +90,7 @@
(inst ldr lr-tn (@ csp-tn -104)) (inst ldr lr-tn (@ csp-tn -104))
(inst sub csp-tn csp-tn (+ 32 80)) ;; deallocate the frame (inst sub csp-tn csp-tn (+ 32 80)) ;; deallocate the frame
#+sb-thread #+(and sb-thread (not win32))
(inst str zr-tn (@ thread-tn (* thread-control-stack-pointer-slot n-word-bytes))) (inst str zr-tn (@ thread-tn (* thread-control-stack-pointer-slot n-word-bytes)))
#-sb-thread #-sb-thread
(progn (progn
@ -146,6 +146,7 @@
(map-pairs ldp csp-tn -16 lisp-registers :delta -16) (map-pairs ldp csp-tn -16 lisp-registers :delta -16)
(inst ldr lr-tn (@ csp-tn -104)) (inst ldr lr-tn (@ csp-tn -104))
(inst sub csp-tn csp-tn (+ 32 80)) (inst sub csp-tn csp-tn (+ 32 80))
#-win32
(inst str zr-tn (@ thread-tn (* thread-control-stack-pointer-slot n-word-bytes)))) (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) (map-pairs ldp nsp-tn 64 nl-registers :post-index 80 :delta -16)
(inst ret)) (inst ret))
@ -167,6 +168,7 @@
(map-pairs ldp csp-tn -16 lisp-registers :delta -16) (map-pairs ldp csp-tn -16 lisp-registers :delta -16)
(inst ldr lr-tn (@ csp-tn -104)) (inst ldr lr-tn (@ csp-tn -104))
(inst sub csp-tn csp-tn (+ 32 80)) (inst sub csp-tn csp-tn (+ 32 80))
#-win32
(inst str zr-tn (@ thread-tn (* thread-control-stack-pointer-slot n-word-bytes)))) (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) (map-pairs ldp nsp-tn 64 nl-registers :post-index 80 :delta -16)
(inst ret))))) (inst ret)))))

6
src/code/debug-int.lisp
View file

@ -2625,11 +2625,11 @@ register."
:invalid-value-for-unescaped-register-storage)) :invalid-value-for-unescaped-register-storage))
(with-nfp ((var) &body body) (with-nfp ((var) &body body)
;; x86oids have no separate number stack, so dummy it ;; x86oids have no separate number stack, so dummy it
;; up for them. ;; up for them. ARM64 Windows is similar - use control stack pointer.
#+c-stack-is-control-stack #+(or c-stack-is-control-stack (and arm64 win32))
`(let ((,var fp)) `(let ((,var fp))
,@body) ,@body)
#-c-stack-is-control-stack #-(or c-stack-is-control-stack (and arm64 win32))
`(let ((,var (if escaped `(let ((,var (if escaped
(int-sap (int-sap
(context-register escaped sb-vm::nfp-offset)) (context-register escaped sb-vm::nfp-offset))

4
src/code/float-trap.lisp
View file

@ -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 ;;; disabled by default. Joe User can explicitly enable them if
;;; desired. ;;; desired.
(define-load-time-global *saved-floating-point-modes* (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 :rounding-mode :nearest :current-exceptions nil
:accrued-exceptions nil :fast-mode nil :accrued-exceptions nil :fast-mode nil
#+x86 :precision #+x86 :53-bit)) #+x86 :precision #+x86 :53-bit))

1
src/compiler/arm64/c-call.lisp
View file

@ -481,6 +481,7 @@
;; No longer OK to run GC except at safepoints. ;; No longer OK to run GC except at safepoints.
#+(or sb-safepoint nonstop-foreign-call) #+(or sb-safepoint nonstop-foreign-call)
(storew zr-tn thread-tn thread-saved-csp-slot)) (storew zr-tn thread-tn thread-saved-csp-slot))
#-win32
(storew zr-tn thread-tn thread-control-stack-pointer-slot) (storew zr-tn thread-tn thread-control-stack-pointer-slot)
return return
#-sb-thread #-sb-thread

2
src/compiler/arm64/parms.lisp
View file

@ -69,7 +69,7 @@
;;;; Where to put the different spaces. ;;;; Where to put the different spaces.
(gc-space-setup #+(or linux openbsd netbsd freebsd) (gc-space-setup #+(or linux openbsd netbsd freebsd win32)
#x2F0000000 #x2F0000000
#+darwin #x300000000 #+darwin #x300000000
#-darwin :read-only-space-size #-darwin 0 #-darwin :read-only-space-size #-darwin 0

9
src/compiler/arm64/vm.lisp
View file

@ -45,7 +45,8 @@
(defreg r5 15) (defreg r5 15)
(defreg r6 16) (defreg r6 16)
(defreg r7 17) (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 r9 19)
(defreg r10 20) (defreg r10 20)
@ -68,7 +69,7 @@
null cfp nsp lr) null cfp nsp lr)
(defregset descriptor-regs (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 ;; nl9 can't be selected by PACK as it is a freely usable temp reg
(defregset non-descriptor-regs (defregset non-descriptor-regs
@ -76,7 +77,7 @@
(defregset boxed-regs (defregset boxed-regs
r0 r1 r2 r3 r4 r5 r6 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 ;; registers used to pass arguments
;; ;;
@ -85,7 +86,7 @@
;; names and offsets for registers used to pass arguments ;; names and offsets for registers used to pass arguments
(defregset *register-arg-offsets* r0 r1 r2 r3) (defregset *register-arg-offsets* r0 r1 r2 r3)
(defconstant-eqx register-arg-names '(r0 r1 r2 r3) #'equal) (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) (defregset *non-descriptor-args* nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 nl8)
(defglobal *float-regs* (loop for i below 32 collect i))) (defglobal *float-regs* (loop for i below 32 collect i)))

10
src/compiler/generic/genesis.lisp
View file

@ -3297,12 +3297,14 @@ Legal values for OFFSET are -4, -8, -12, ..."
"#define PSEUDO_ATOMIC_TRAP ~D /* 0x~:*~X */~%" "#define PSEUDO_ATOMIC_TRAP ~D /* 0x~:*~X */~%"
sb-vm::pseudo-atomic-trap) sb-vm::pseudo-atomic-trap)
(terpri)) (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)) #+(and sb-safepoint (not x86-64))
(progn (progn
(format t "#define GC_SAFEPOINT_PAGE_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%" (format t "#define GC_SAFEPOINT_PAGE_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%"
sb-c:+backend-page-bytes+) sb-c:+backend-page-bytes+)
(format t "#define GC_SAFEPOINT_TRAP_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%" (format t "#define GC_SAFEPOINT_TRAP_ADDR (void*)((char*)STATIC_SPACE_START - ~d)~%"
sb-vm:gc-safepoint-trap-offset)) sb-vm:gc-safepoint-trap-offset))
(dolist (symbol '(sb-vm:float-traps-byte (dolist (symbol '(sb-vm:float-traps-byte
sb-vm::float-exceptions-byte sb-vm::float-exceptions-byte

5
src/compiler/generic/parms.lisp
View file

@ -83,10 +83,9 @@
;; #+immobile-space implies a relocatable alien linkage space. And x86-64 always ;; #+immobile-space implies a relocatable alien linkage space. And x86-64 always
;; has relocatable linkage tables ;; has relocatable linkage tables
#-(or x86-64 immobile-space) (alien-linkage ,alien-linkage-space-size) #-(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 ;; x86-64 uses a relocatable trap page just below the card mark
;; table, which works nicely assuming a register is wired to the card table ;; table (wired to a register). Other platforms allocate a separate page.
#+(and sb-safepoint (not x86-64)) #+(and sb-safepoint (not x86-64))
;; Must be just before NIL.
(safepoint ,(symbol-value '+backend-page-bytes+)) (safepoint ,(symbol-value '+backend-page-bytes+))
(static ,small-space-size) (static ,small-space-size)
#+darwin-jit (static-code ,small-space-size))) #+darwin-jit (static-code ,small-space-size)))

55
src/runtime/Config.arm64-win32 Normal file
View file

@ -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

69
src/runtime/arm64-arch.c
View file

@ -25,7 +25,14 @@
os_vm_address_t arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context) 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; return (os_vm_address_t)code->si_addr;
#endif
} }
void arch_skip_instruction(os_context_t *context) 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 { else {
// Do orig_inst by copying it into a trampoline. // 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(); size_t size = getpagesize();
#endif
// Allocate the thread-local trampoline on-demand. // Allocate the thread-local trampoline on-demand.
struct thread *th = get_sb_vm_thread(); struct thread *th = get_sb_vm_thread();
unsigned int *trampoline = (unsigned int*)th->breakpoint_misc; unsigned int *trampoline = (unsigned int*)th->breakpoint_misc;
if (!trampoline) { if (!trampoline) {
#ifdef WIN32
trampoline = VirtualAlloc(NULL, size, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
#else
trampoline = mmap(NULL, size, trampoline = mmap(NULL, size,
PROT_READ | PROT_WRITE, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS, MAP_PRIVATE | MAP_ANONYMOUS,
-1, 0); -1, 0);
#endif
th->breakpoint_misc = trampoline; th->breakpoint_misc = trampoline;
} }
else 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_ptr = trampoline;
unsigned int inst; 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 = 0xD61F0000 | BREAKPOINT_TEMP_REG << 5;
*inst_ptr++ = inst; *inst_ptr++ = inst;
// address // address (8 bytes for a 64-bit pointer; unsigned long is only
*(unsigned long *)inst_ptr++ = (unsigned long)next_pc; // 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_CONTEXT_PC(context) = (uword_t)trampoline;
os_flush_icache((os_vm_address_t) trampoline, (char*) inst_ptr - (char*)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; return;
} }
@ -277,6 +296,7 @@ arch_handle_single_step_trap(os_context_t *context, int trap)
arch_skip_instruction(context); arch_skip_instruction(context);
} }
#ifndef WIN32
static void static void
sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context) 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); handle_trap(context, code);
} }
#endif
void sigill_handler(int signal, siginfo_t *siginfo, os_context_t *context); void sigill_handler(int signal, siginfo_t *siginfo, os_context_t *context);
#ifndef LISP_FEATURE_DARWIN #if !defined(LISP_FEATURE_DARWIN) && !defined(WIN32)
void void
sigill_handler(int signal, siginfo_t *siginfo, os_context_t *context) { sigill_handler(int signal, siginfo_t *siginfo, os_context_t *context) {
fake_foreign_function_call(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() void arch_install_interrupt_handlers()
{ {
#ifndef WIN32
ll_install_handler(SIGTRAP, sigtrap_handler); ll_install_handler(SIGTRAP, sigtrap_handler);
ll_install_handler(SIGILL, sigill_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; char *reloc_addr = (char*)ALIEN_LINKAGE_SPACE_START + index * ALIEN_LINKAGE_TABLE_ENTRY_SIZE;
if (datap) { if (datap) {
*(unsigned long *)reloc_addr = (unsigned long)target_addr; *(uword_t *)reloc_addr = (uword_t)target_addr;
goto DONE; 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 = 0xD61F0000 | LINKAGE_TEMP_REG << 5;
*inst_ptr++ = inst; *inst_ptr++ = inst;
// address // address (64-bit pointer - must use uword_t on Windows where unsigned long is 32-bit)
*(unsigned long *)inst_ptr++ = (unsigned long)target_addr; *(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); 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 addr -= extra_request; // try to put text space start where expected
} }
#endif #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; if (size == 0) return addr;
#ifdef LISP_FEATURE_SB_SAFEPOINT #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 #ifdef LISP_FEATURE_IMMOBILE_SPACE
if (space_id == IMMOBILE_TEXT_CORE_SPACE_ID) { if (space_id == IMMOBILE_TEXT_CORE_SPACE_ID) {
ALIEN_LINKAGE_SPACE_START = (uword_t)addr; 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; addr += extra_request;
} }
#endif #endif
return addr; 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) { long sb_udivmodti4(__uint128_t x, unsigned long y, unsigned long *rem) {
if (rem) if (rem)
*rem = x % y; *rem = x % y;
return x / y; return x / y;
} }
#endif

53
src/runtime/arm64-assem.S
View file

@ -23,8 +23,16 @@
ldr \dest, [\dest, _\symbol@PAGEOFF] ldr \dest, [\dest, _\symbol@PAGEOFF]
.endm .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 TYPE(name) .type name,%function
#define SIZE(name) .size name,.-name #define SIZE(name) .size name,.-name
#define GNAME(var) var #define GNAME(var) var
@ -153,6 +161,22 @@ GNAME(call_into_lisp):
mov reg_LEXENV, x0 mov reg_LEXENV, x0
#ifdef LISP_FEATURE_SB_THREAD #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_GCC_TLS
#ifdef LISP_FEATURE_DARWIN #ifdef LISP_FEATURE_DARWIN
@ -179,6 +203,7 @@ GNAME(call_into_lisp):
bl pthread_getspecific bl pthread_getspecific
mov reg_THREAD, x0 mov reg_THREAD, x0
#endif #endif
#endif
#endif #endif
// Clear the boxed registers that don't already have something // Clear the boxed registers that don't already have something
// in them. // in them.
@ -190,7 +215,8 @@ GNAME(call_into_lisp):
mov reg_R5, #0 mov reg_R5, #0
mov reg_R6, #0 mov reg_R6, #0
mov reg_R7, #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 mov reg_R8, #0
#endif #endif
mov reg_R10, #0 mov reg_R10, #0
@ -219,7 +245,10 @@ GNAME(call_into_lisp):
1: 1:
#endif #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] str xzr,[reg_THREAD, THREAD_CONTROL_STACK_POINTER_OFFSET]
#endif
#else #else
ldr reg_NL3, =GNAME(foreign_function_call_active) ldr reg_NL3, =GNAME(foreign_function_call_active)
str xzr, [reg_NL3] str xzr, [reg_NL3]
@ -311,13 +340,21 @@ GNAME(call_into_c):
// All other C arguments are already stashed on the C stack. // All other C arguments are already stashed on the C stack.
// Build a Lisp stack frame. // Build a Lisp stack frame.
#ifdef LISP_FEATURE_WIN32
// On Windows ARM64, save thread CFP/CSP before overwriting.
// CSP cannot be zeroed to indicate "in Lisp" state on safepoint builds.
ldp x3, x4, [reg_THREAD, THREAD_CONTROL_FRAME_POINTER_OFFSET]
stp x3, x4, [reg_CSP, #-16]!
stp reg_CFP, reg_LR, [reg_CSP, #-16]!
add reg_R10, reg_CSP, #32
#else
// Can store two values above the stack pointer, interrupts ignore them. // Can store two values above the stack pointer, interrupts ignore them.
stp reg_CFP, reg_LR, [reg_CSP] stp reg_CFP, reg_LR, [reg_CSP]
add reg_R10, reg_CSP, #2*8 add reg_R10, reg_CSP, #2*8
#endif
mov reg_LEXENV, reg_LR mov reg_LEXENV, reg_LR
// Save the lisp stack and frame pointers. // Save the lisp stack and frame pointers.
#ifdef LISP_FEATURE_SB_THREAD #ifdef LISP_FEATURE_SB_THREAD
stp reg_CSP, reg_R10, [reg_THREAD, THREAD_CONTROL_FRAME_POINTER_OFFSET] stp reg_CSP, reg_R10, [reg_THREAD, THREAD_CONTROL_FRAME_POINTER_OFFSET]
#else #else
@ -359,7 +396,8 @@ GNAME(call_into_c):
mov reg_R5, #0 mov reg_R5, #0
mov reg_R6, #0 mov reg_R6, #0
mov reg_R7, #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 mov reg_R8,#0
#endif #endif
#ifndef LISP_FEATURE_SB_THREAD #ifndef LISP_FEATURE_SB_THREAD
@ -373,6 +411,12 @@ GNAME(call_into_c):
// Restore the Lisp stack and frame pointers // Restore the Lisp stack and frame pointers
#ifdef LISP_FEATURE_WIN32
// Restore CFP/LR from stack, then restore saved thread CFP/CSP.
ldp reg_CFP, reg_LR, [reg_CSP], #16
ldp x3, x4, [reg_CSP], #16
stp x3, x4, [reg_THREAD, THREAD_CONTROL_FRAME_POINTER_OFFSET]
#else
#ifdef LISP_FEATURE_SB_THREAD #ifdef LISP_FEATURE_SB_THREAD
str xzr, [reg_THREAD, THREAD_CONTROL_STACK_POINTER_OFFSET] str xzr, [reg_THREAD, THREAD_CONTROL_STACK_POINTER_OFFSET]
#else #else
@ -380,6 +424,7 @@ GNAME(call_into_c):
str xzr, [reg_OCFP] str xzr, [reg_OCFP]
#endif #endif
mov reg_LR, reg_LEXENV mov reg_LR, reg_LEXENV
#endif
ret ret
SIZE(call_into_c) SIZE(call_into_c)

240
src/runtime/arm64-win32-os.c Normal file
View file

@ -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());
}
}

26
src/runtime/arm64-win32-os.h Normal file
View file

@ -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 */

2
src/runtime/coreparse.c
View file

@ -853,7 +853,9 @@ process_directory(int count, struct ndir_entry *entry,
break; break;
#endif #endif
case IMMOBILE_TEXT_CORE_SPACE_ID: case IMMOBILE_TEXT_CORE_SPACE_ID:
#ifndef LISP_FEATURE_ARM64
TEXT_SPACE_START = addr; TEXT_SPACE_START = addr;
#endif
break; break;
case DYNAMIC_CORE_SPACE_ID: case DYNAMIC_CORE_SPACE_ID:
{ {

133
src/runtime/win32-os.c
View file

@ -115,7 +115,14 @@ static void set_seh_frame(void *frame)
void alloc_gc_page() 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, gc_assert(VirtualAlloc(GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES,
MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE)); MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE));
#endif #endif
@ -144,16 +151,20 @@ void alloc_gc_page()
*/ */
void map_gc_page() void map_gc_page()
{ {
#if defined(LISP_FEATURE_SB_SAFEPOINT)
DWORD oldProt; DWORD oldProt;
gc_assert(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES, gc_assert(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES,
PAGE_READWRITE, &oldProt)); PAGE_READWRITE, &oldProt));
#endif
} }
void unmap_gc_page() void unmap_gc_page()
{ {
#if defined(LISP_FEATURE_SB_SAFEPOINT)
DWORD oldProt; DWORD oldProt;
gc_assert(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES, gc_assert(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, BACKEND_PAGE_BYTES,
PAGE_NOACCESS, &oldProt)); PAGE_NOACCESS, &oldProt));
#endif
} }
uint32_t os_get_build_time_shared_libraries(uint32_t excl_maximum, 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) os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
{ {
DWORD old_prot; DWORD old_prot;
DWORD new_prot = os_protect_modes[prot]; DWORD new_prot = os_protect_modes[prot];
gc_assert(VirtualProtect(address, length, new_prot, &old_prot)|| gc_assert(VirtualProtect(address, length, new_prot, &old_prot)||
(VirtualAlloc(address, length, MEM_COMMIT, new_prot) && (VirtualAlloc(address, length, MEM_COMMIT, new_prot) &&
@ -750,16 +760,19 @@ extern int internal_errors_enabled;
extern void exception_handler_wrapper(); extern void exception_handler_wrapper();
#ifdef LISP_FEATURE_X86 #if defined(LISP_FEATURE_X86)
#define voidreg(ctxptr,name) ((void*)((ctxptr)->E##name)) #define voidreg(ctxptr,name) ((void*)((ctxptr)->E##name))
#else #elif defined(LISP_FEATURE_X86_64)
#define voidreg(ctxptr,name) ((void*)((ctxptr)->R##name)) #define voidreg(ctxptr,name) ((void*)((ctxptr)->R##name))
#else // ARM64 and others. Stub out for now.
#define voidreg(ctxptr,name) (0)
#endif #endif
static int static int
handle_single_step(os_context_t *ctx) handle_single_step(os_context_t *ctx)
{ {
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
if (!single_stepping) if (!single_stepping)
return -1; return -1;
@ -768,19 +781,48 @@ handle_single_step(os_context_t *ctx)
restore_breakpoint_from_single_step(ctx); restore_breakpoint_from_single_step(ctx);
return 0; return 0;
#else
return -1;
#endif
} }
#ifdef LISP_FEATURE_UD2_BREAKPOINTS #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION #ifdef LISP_FEATURE_UD2_BREAKPOINTS
#define TRAP_CODE_WIDTH 2 #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION
#else #define TRAP_CODE_WIDTH 2
#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_BREAKPOINT #else
#define TRAP_CODE_WIDTH 1 #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 #endif
static int static int
handle_breakpoint_trap(os_context_t *ctx, struct thread* self) 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 #ifdef LISP_FEATURE_UD2_BREAKPOINTS
if (((unsigned short *)OS_CONTEXT_PC(ctx))[0] != 0x0b0f) if (((unsigned short *)OS_CONTEXT_PC(ctx))[0] != 0x0b0f)
return -1; 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 /* Now EIP points just after the INT3 byte and aims at the
* 'kind' value (eg trap_Cerror). */ * 'kind' value (eg trap_Cerror). */
unsigned trap = *(unsigned char *)OS_CONTEXT_PC(ctx); unsigned trap = *(unsigned char *)OS_CONTEXT_PC(ctx);
#endif
/* Before any other trap handler: gc_safepoint ensures that /* Before any other trap handler: gc_safepoint ensures that
inner alloc_sap for passing the context won't trap on inner alloc_sap for passing the context won't trap on
pseudo-atomic. */ pseudo-atomic. */
/* Now that there is no alloc_sap, I don't know what happens here. */ /* Now that there is no alloc_sap, I don't know what happens here. */
if (trap == trap_PendingInterrupt) { if (trap == trap_PendingInterrupt) {
/* Done everything needed for this trap, except EIP /* Advance PC past the trap instruction and any trailing data. */
adjustment */
arch_skip_instruction(ctx); arch_skip_instruction(ctx);
thread_interrupted(ctx); thread_interrupted(ctx);
return 0; return 0;
@ -840,9 +882,9 @@ handle_access_violation(os_context_t *ctx,
win32_context->Edi, win32_context->Edi,
fault_address, fault_address,
exception_record->ExceptionInformation[0]); exception_record->ExceptionInformation[0]);
#else #elif defined(LISP_FEATURE_X86_64)
odxprint(pagefaults, 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", "Addr %p Access %d\n",
self, self,
win32_context->Rip, win32_context->Rip,
@ -851,11 +893,42 @@ handle_access_violation(os_context_t *ctx,
win32_context->Rdi, win32_context->Rdi,
fault_address, fault_address,
exception_record->ExceptionInformation[0]); 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 #endif
/* Safepoint pages */ /* Safepoint pages */
if (fault_address == (void *) GC_SAFEPOINT_TRAP_ADDR) { 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); 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; return 0;
} }
@ -867,7 +940,15 @@ handle_access_violation(os_context_t *ctx,
/* dynamic space */ /* dynamic space */
page_index_t page = find_page_index(fault_address); page_index_t page = find_page_index(fault_address);
#ifdef LISP_FEATURE_SOFT_CARD_MARKS #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 #else
if (page != -1 && !PAGE_WRITEPROTECTED_P(page)) { if (page != -1 && !PAGE_WRITEPROTECTED_P(page)) {
os_commit_memory(PTR_ALIGN_DOWN(fault_address, os_vm_page_size), 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 /* The exception system doesn't automatically clear pending
* exceptions, so we lose as soon as we execute any FP * exceptions, so we lose as soon as we execute any FP
* instruction unless we do this first. */ * instruction unless we do this first. */
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
asm("fnclex"); asm("fnclex");
#endif
/* We're making the somewhat arbitrary decision that having /* We're making the somewhat arbitrary decision that having
* internal errors enabled means that lisp has sufficient * internal errors enabled means that lisp has sufficient
* marbles to be able to handle exceptions, but exceptions * 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); DX_ALLOC_SAP(exception_record_sap, exception_record);
thread_sigmask(SIG_SETMASK, &ctx->sigmask, NULL); thread_sigmask(SIG_SETMASK, &ctx->sigmask, NULL);
#ifdef LISP_FEATURE_X86_64 #if defined(LISP_FEATURE_X86_64)
asm("fninit"); asm("fninit");
#endif #endif
@ -1003,6 +1086,7 @@ handle_exception_ex(EXCEPTION_RECORD *exception_record,
/* For EXCEPTION_ACCESS_VIOLATION only. */ /* For EXCEPTION_ACCESS_VIOLATION only. */
void *fault_address = (void *)exception_record->ExceptionInformation[1]; void *fault_address = (void *)exception_record->ExceptionInformation[1];
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
odxprint(seh, odxprint(seh,
"SEH: rec %p, ctxptr %p, rip %p, fault %p\n" "SEH: rec %p, ctxptr %p, rip %p, fault %p\n"
"... code %p, rcx %p, fp-tags %p\n\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, (void*)(intptr_t)code,
voidreg(win32_context,cx), voidreg(win32_context,cx),
win32_context->FloatSave.TagWord); 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 /* This function had become unwieldy. Let's cut it down into
* pieces based on the different exception codes. Each exception * 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); 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() \ #define RESTORING_ERRNO() \
int sbcl__lastErrno = errno; \ int sbcl__lastErrno = errno; \
@ -1119,7 +1212,11 @@ veh(EXCEPTION_POINTERS *ep)
return EXCEPTION_CONTINUE_SEARCH; return EXCEPTION_CONTINUE_SEARCH;
} }
#if defined(LISP_FEATURE_X86_64)
DWORD64 rip = ep->ContextRecord->Rip; DWORD64 rip = ep->ContextRecord->Rip;
#elif defined(LISP_FEATURE_ARM64)
DWORD64 rip = ep->ContextRecord->Pc;
#endif
long int code = ep->ExceptionRecord->ExceptionCode; long int code = ep->ExceptionRecord->ExceptionCode;
BOOL from_lisp = BOOL from_lisp =
(rip >= DYNAMIC_SPACE_START && rip < DYNAMIC_SPACE_START+dynamic_space_size) || (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->next_frame = get_seh_frame();
handler->handler = (void*)exception_handler_wrapper; handler->handler = (void*)exception_handler_wrapper;
set_seh_frame(handler); set_seh_frame(handler);
#else #elif defined(LISP_FEATURE_X86_64) || defined(LISP_FEATURE_ARM64)
static int once = 0; static int once = 0;
if (!once++) if (!once++)
AddVectoredExceptionHandler(1,veh); AddVectoredExceptionHandler(1,veh);

7
tests/subr.sh
View file

@ -28,7 +28,12 @@ set -a # export all variables at assignment-time.
# quote them (with double quotes), to contend with whitespace. # quote them (with double quotes), to contend with whitespace.
SBCL_HOME="${TEST_SBCL_HOME:-$SBCL_PWD/../obj/sbcl-home}" SBCL_HOME="${TEST_SBCL_HOME:-$SBCL_PWD/../obj/sbcl-home}"
SBCL_CORE="${TEST_SBCL_CORE:-$SBCL_PWD/../output/sbcl.core}" 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}" SBCL_ARGS="${TEST_SBCL_ARGS:---disable-ldb --noinform --no-sysinit --no-userinit --noprint --disable-debugger}"