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

Implement nonstop-foreign-call for x86-64

Browse source
This commit is contained in:
Stas Boukarev 2025-10-20 03:23:07 +03:00
parent 2b5fb7caba
commit f8bd4b2b03
15 changed files with 111 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.github/workflows/linux.yml vendored
View file

@ -16,6 +16,7 @@ jobs:
- { arch: x86-64, subfeatures: sse4, options: --with-sb-thread }
- { arch: x86-64, subfeatures: fasteval, options: --with-sb-fasteval --without-sb-eval }
- { arch: x86-64, options: --with-mark-region-gc }
- { arch: x86-64, options: --with-nonstop-foreign-call }
fail-fast: false

4
.github/workflows/mac.yml vendored
View file

@ -10,9 +10,7 @@ jobs:
strategy:
matrix:
arch: [arm64, x86-64]
options: [--with-sb-thread, --with-mark-region-gc]
include:
- { arch: arm64, options: --with-nonstop-foreign-call }
options: [--with-sb-thread, --with-mark-region-gc, --with-nonstop-foreign-call]
fail-fast: false
steps:

2
src/cold/shared.lisp
View file

@ -404,7 +404,7 @@
;; There is still hope to make multithreading on DragonFly x86-64
("(and sb-thread x86 dragonfly)"
":SB-THREAD not supported on selected architecture")
("(and nonstop-foreign-call (not (and arm64 sb-thread (not sb-safepoint))))"
("(and nonstop-foreign-call (not (and (or arm64 x86-64) sb-thread (not sb-safepoint))))"
":NONSTOP-FOREIGN-CALL not supported with this combination of features")))
(failed-test-descriptions nil))
(dolist (test feature-compatibility-tests)

16
src/compiler/x86-64/c-call.lisp
View file

@ -277,7 +277,7 @@
(inst mov res (static-constant-ea alien-linkage-table))
(inst mov res (ea (make-fixup foreign-symbol :foreign-dataref) res))))))
#+sb-safepoint
#+(or sb-safepoint nonstop-foreign-call)
(defconstant thread-saved-csp-offset -1)
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
@ -285,9 +285,9 @@
;; Safepoints do not save interrupt contexts to be scanned during
;; GCing, it only looks at the stack, so if a register isn't
;; spilled it won't be visible to the GC.
#+sb-safepoint
#+(or sb-safepoint nonstop-foreign-call)
'((:save-p t))
#-sb-safepoint
#-(or sb-safepoint nonstop-foreign-call)
(let ((gprs (list '#:rcx '#:rdx #-win32 '#:rsi #-win32 '#:rdi
'#:r8 '#:r9 '#:r10 '#:r11))
(vars))
@ -379,8 +379,10 @@
'float-registers))))
;; Store SP in thread struct, unless the enclosing block says not to
#+sb-safepoint
(when (policy (sb-c::vop-node vop) (/= sb-c:insert-safepoints 0))
#+(or sb-safepoint nonstop-foreign-call)
(when (and #+sb-safepoint
(policy (sb-c::vop-node vop) (/= sb-c:insert-safepoints 0)))
(inst mov (thread-slot-ea thread-saved-csp-offset) rsp-tn))
#+win32 (inst sub rsp-tn #x20) ;MS_ABI: shadow zone
@ -429,7 +431,9 @@
;; Zero the saved CSP, unless this code shouldn't ever stop for GC
#+sb-safepoint
(when (policy (sb-c::vop-node vop) (/= sb-c:insert-safepoints 0))
(inst xor (thread-slot-ea thread-saved-csp-offset) rsp-tn)))
(inst xor (thread-slot-ea thread-saved-csp-offset) rsp-tn))
#+nonstop-foreign-call
(inst mov :qword (thread-slot-ea thread-saved-csp-offset) 0))
(define-vop (alloc-number-stack-space)
(:info amount)

1
src/runtime/alloc.c
View file

@ -712,6 +712,7 @@ alloc_thread_struct(void* spaces) {
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
gc_assert(!pthread_mutex_init(&extra_data->foreign_exit_lock, NULL));
extra_data->gc_inhibited = 0;
#endif
#if defined LISP_FEATURE_UNIX && defined LISP_FEATURE_SB_THREAD

20
src/runtime/arena.c
View file

@ -604,14 +604,24 @@ int find_dynspace_to_arena_ptrs(lispobj arena, lispobj result_buffer)
th->control_stack_end,
th->lisp_thread);
} else {
lispobj *sp;
#ifdef LISP_FEATURE_SB_SAFEPOINT
lispobj *sp = os_get_csp(th);
sp = os_get_csp(th);
#else
int ici = fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX, th));
if (ici == 0) lose("can't find interrupt context");
lispobj sp = *os_context_register_addr(nth_interrupt_context(ici-1, th), reg_SP);
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
lispobj* csp = th->control_stack_pointer;
if (csp) {
sp = csp;
}
else
#endif
scan_thread_control_stack((lispobj*)sp, th->control_stack_end, th->lisp_thread);
{
int ici = fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX, th));
if (ici == 0) lose("can't find interrupt context");
sp = (lispobj*)*os_context_register_addr(nth_interrupt_context(ici-1, th), reg_SP);
}
#endif
scan_thread_control_stack(sp, th->control_stack_end, th->lisp_thread);
}
#endif
scan_thread_words((lispobj*)th->binding_stack_start,

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

@ -263,7 +263,7 @@ Lno_args:
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
ldr x3, [sp],#16
cbz x3, 1f
str reg_CSP, [reg_THREAD, THREAD_SAVED_CSP_OFFSET]
str x3, [reg_THREAD, THREAD_SAVED_CSP_OFFSET]
1:
#endif
#else

7
src/runtime/gencgc.c
View file

@ -3217,6 +3217,13 @@ conservative_stack_scan(struct thread* th,
}
# endif
# elif defined(LISP_FEATURE_SB_THREAD)
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
lispobj* csp = th->control_stack_pointer;
if (csp)
esp = (void*) csp;
#endif
int i;
/* fprintf(stderr, "Thread %p, ici=%d stack[%p:%p] (%dw)",
th, fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX,th)),

14
src/runtime/interrupt.c
View file

@ -1517,12 +1517,15 @@ handle_foreign_call_trigger (os_context_t *context, os_vm_address_t fault_addres
/* gc_stop_the_world has left this thread untouched,
wait for gc_start_the_world */
pthread_mutex_t *exit_lock = &thread_extra_data(th)->foreign_exit_lock;
mutex_acquire(exit_lock);
mutex_release(exit_lock);
gc_assert(mutex_acquire(exit_lock));
gc_assert(mutex_release(exit_lock));
}
else {
/* gc_stop_the_world has either already sent a signal
or will send it soon, wait for it. */
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
th->control_stack_pointer = (lispobj*)*os_context_register_addr(context, reg_SP);
#endif
sigfillset(&mask);
sigdelset(&mask, SIG_STOP_FOR_GC);
sigsuspend(&mask);
@ -1534,10 +1537,13 @@ handle_foreign_call_trigger (os_context_t *context, os_vm_address_t fault_addres
if (exiting) {
pthread_mutex_t *exit_lock = &thread_extra_data(th)->foreign_exit_lock;
write_TLS(STOP_FOR_GC_PENDING, LISP_T, th);
mutex_acquire(exit_lock);
mutex_release(exit_lock);
gc_assert(mutex_acquire(exit_lock));
gc_assert(mutex_release(exit_lock));
} else {
if (read_TLS(STOP_FOR_GC_PENDING, th) == NIL) {
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
th->control_stack_pointer = (lispobj*)*os_context_register_addr(context, reg_SP);
#endif
sigfillset(&mask);
sigdelset(&mask, SIG_STOP_FOR_GC);
sigsuspend(&mask);

7
src/runtime/pmrgc.c
View file

@ -649,6 +649,13 @@ conservative_stack_scan(struct thread* th,
}
# endif
# elif defined(LISP_FEATURE_SB_THREAD)
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
lispobj* csp = th->control_stack_pointer;
if (csp)
esp = (void*) csp;
#endif
int i;
for (i = fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX,th))-1; i>=0; i--) {
os_context_t *c = nth_interrupt_context(i, th);

44
src/runtime/thread.c
View file

@ -1023,7 +1023,8 @@ void gc_stop_the_world()
struct extra_thread_data *semaphores = thread_extra_data(th);
bool foreign = 0;
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
gc_assert(mutex_acquire(&semaphores->foreign_exit_lock));
pthread_mutex_t *exit_lock = &semaphores->foreign_exit_lock;
gc_assert(mutex_acquire(exit_lock));
foreign = set_thread_foreign_call_trigger(th, 0);
#endif
@ -1039,6 +1040,16 @@ void gc_stop_the_world()
// See comment in 'interr.h' about that.
(void*)th->os_thread, rc, strerror(rc));
}
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
else if (read_TLS(GC_INHIBIT,th) != NIL) {
/* It's a foreign call but inside without-gcing,
handle_foreign_call_trigger will set
*stop-for-gc-pending*, need to unlock the exit
lock to reach the end of without-gcing* */
semaphores->gc_inhibited = 1;
gc_assert(mutex_release(exit_lock));
}
#endif
}
os_sem_post(&semaphores->state_sem);
}
@ -1046,18 +1057,12 @@ void gc_stop_the_world()
for_each_thread(th) {
if (th != me) {
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
if (csp_around_foreign_call(th))
lispobj csp = csp_around_foreign_call(th);
if (csp && !thread_extra_data(th)->gc_inhibited)
{
if (read_TLS(GC_INHIBIT,th) != NIL) {
/* It's a foreign call but inside without-gcing,
handle_foreign_call_trigger will set
*stop-for-gc-pending*, need to unlock the exit
lock to reach the end of without-gcing* */
pthread_mutex_t *exit_lock = &thread_extra_data(th)->foreign_exit_lock;
mutex_release(exit_lock);
thread_wait_until_not(STATE_RUNNING, th);
mutex_acquire(exit_lock);
}
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
th->control_stack_pointer = (lispobj*)csp;
#endif
}
else
#endif
@ -1104,8 +1109,19 @@ void gc_start_the_world()
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
bool foreign = csp_around_foreign_call(th);
set_thread_foreign_call_trigger(th, 1);
gc_assert(mutex_release(&thread_extra_data(th)->foreign_exit_lock));
if (!foreign)
if (thread_extra_data(th)->gc_inhibited)
/* The lock is already released */
thread_extra_data(th)->gc_inhibited = 0;
else
gc_assert(mutex_release(&thread_extra_data(th)->foreign_exit_lock));
if (foreign) {
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
th->control_stack_pointer = 0;
#endif
}
else
#endif
{
if (state != STATE_DEAD) {

1
src/runtime/thread.h
View file

@ -66,6 +66,7 @@ struct extra_thread_data
#endif
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
pthread_mutex_t foreign_exit_lock;
int gc_inhibited;
#endif
#if defined LISP_FEATURE_SB_THREAD && defined LISP_FEATURE_UNIX

6
src/runtime/traceroot.c
View file

@ -240,8 +240,14 @@ static os_context_t* get_register_context(struct thread* th)
static lispobj* get_stackptr(struct thread* th)
{
if (th == get_sb_vm_thread()) return (lispobj*)cur_thread_stackptr_at_entry;
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
lispobj* csp = th->control_stack_pointer;
if (csp) return csp;
#endif
os_context_t* context = get_register_context(th);
if (context) return (lispobj*)(uword_t)*os_context_sp_addr(context);
lose("No stack pointer for %p", th);
}

21
src/runtime/x86-64-assem.S
View file

@ -72,6 +72,8 @@
#define THREAD_BASE_REG %r13
#define reg_NULL %r12
#define THREAD_SAVED_CSP_OFFSET (- N_WORD_BYTES)
#ifdef LISP_FEATURE_WIN32
#define CARG1 %rcx
#define CARG2 %rdx
@ -191,8 +193,15 @@ Ltwo: mov 8(%rbx),%rdi # arg1
Lone: mov 0(%rbx),%rdx # arg0
Lzero:
shl $(N_FIXNUM_TAG_BITS),%rcx # (fixnumize num-args)
/* Registers rax, rcx, rdx, rdi, and rsi are now live. */
xor %rbx,%rbx # available
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
mov THREAD_SAVED_CSP_OFFSET(THREAD_BASE_REG), %r8
push %r8
test %r8, %r8
je 1f
movq $0, THREAD_SAVED_CSP_OFFSET(THREAD_BASE_REG)
1:
#endif
/* Alloc new frame. */
push %rbp # Dummy for return address
@ -209,6 +218,14 @@ Lcall:
mov %rbx, %rsp
LsingleValue:
#ifdef LISP_FEATURE_NONSTOP_FOREIGN_CALL
pop %r8
test %r8, %r8
je 1f
movq %r8, THREAD_SAVED_CSP_OFFSET(THREAD_BASE_REG)
1:
#endif
POP_C_NONVOLATILE_REGS
/* FIXME Restore the NPX state. */

1
tests/call-into-lisp.impure.lisp
View file

@ -68,6 +68,7 @@
(mov ,rdi-tn ,(get-lisp-obj-address #'monkeybiz)) ; C arg 0 = Lisp function
(mov ,rsi-tn ,rsp-tn) ; C arg 1 = argv
(mov ,rdx-tn :ARGC) ; C arg 2 = argc
(mov ,rcx-tn ,thread-tn) ; C arg 3 = thread
(mov ,rax-tn ,(sap-int
(alien-value-sap
(extern-alien "call_into_lisp"