* Stop threads for GC at safepoints only.
* Replaces use of SIG_STOP_FOR_GC.
* Currently not used by default. Users need to set feature
SB-SAFEPOINT to enable this code. SB-SAFEPOINT should only be set
when SB-THREAD is also enabled.
* ISA support: Each architecture needs VOP support, and changes to
foreign call-out assembly; only x86 and x86-64 implemented at this
point.
* OS support: Minor changes to signal handling required, currently
implemented for Linux and Solaris.
* Performance note: Does not currently replace pseudo-atomic entirely,
except on Windows. Only once further work has been done to reduce
use of signals will pseudo-atomic become truly redundant. Therefore
use of safepoints on POSIX currently still implies the combined
performance overhead of both mechanisms.
* Design alternatives exist for some choices made here. In particular,
this commit places the safepoint trap page into the SBCL binary for
simplicity. It is likely that future changes to allow slam-free
runtime changes will have to go back to a hand-crafted address
parameter.
* This feature has been extracted from work related to Windows
support and backported to POSIX.
Credits: Uses the CSP-based stop-the-world protocol by Anton Kovalenko,
based on the safepoint and threading work by Dmitry Kalyanov. Use of
safepoints for SBCL originally researched by Paul Khuong.
"HALT"
"IF-EQ"
"IMMEDIATE-TN-P"
+ "INHIBIT-SAFEPOINTS"
"INLINE-SYNTACTIC-CLOSURE-LAMBDA"
"INSERT-STEP-CONDITIONS"
"IR2-COMPONENT-CONSTANTS" "IR2-CONVERT"
"CONTEXT-FLOATING-POINT-MODES" "CONTEXT-FLOAT-REGISTER"
"CONTEXT-PC" "CONTEXT-REGISTER"
"CONTROL-STACK-SC-NUMBER" "COUNT-NO-OPS"
+ #!+sb-safepoint "CSP-SAFEPOINT-TRAP"
"*CURRENT-CATCH-BLOCK*"
"CURRENT-FLOAT-TRAP" "DEFINE-FOR-EACH-PRIMITIVE-OBJECT"
"DESCRIPTOR-REG-SC-NUMBER" "DESCRIPTOR-VS-NON-DESCRIPTOR-STORAGE"
"GENCGC-RELEASE-GRANULARITY"
#!+ppc "PSEUDO-ATOMIC-INTERRUPTED-FLAG"
#!+ppc "PSEUDO-ATOMIC-FLAG"
+ #!+sb-safepoint "GLOBAL-SAFEPOINT-TRAP"
"GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER"
"IMMEDIATE-CHARACTER-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
"IMMEDIATE-SC-NUMBER"
sb!unix::*unblock-deferrables-on-enabling-interrupts-p*
*interrupts-enabled*
*interrupt-pending*
+ #!+sb-safepoint *gc-safe*
+ #!+sb-safepoint *in-safepoint*
*free-interrupt-context-index*
sb!kernel::*gc-epoch*
sb!vm::*unwind-to-frame-function*
;; turn is a type-error.
(when (plusp run-time)
(incf *gc-run-time* run-time))))
+ #!+sb-safepoint
+ (setf *stop-for-gc-pending* nil)
(setf *gc-pending* nil
new-usage (dynamic-usage))
#!+sb-thread
sb!alien:void
(where sb!alien:unsigned-long)
(old sb!alien:unsigned-long))
+#!-sb-safepoint
(sb!alien:define-alien-routine ("unblock_gc_signals" %unblock-gc-signals)
sb!alien:void
(where sb!alien:unsigned-long)
(defun unblock-deferrable-signals ()
(%unblock-deferrable-signals 0 0))
+#!-sb-safepoint
(defun unblock-gc-signals ()
(%unblock-gc-signals 0 0))
(enable-interrupt sigpipe #'sigpipe-handler)
(enable-interrupt sigchld #'sigchld-handler)
#!+hpux (ignore-interrupt sigxcpu)
- (unblock-gc-signals)
+ #!-sb-safepoint (unblock-gc-signals)
(unblock-deferrable-signals)
(values))
\f
(with-local-interrupts
(sb!unix::unblock-deferrable-signals)
(setf (thread-result thread)
- (cons t
- (multiple-value-list
- (unwind-protect
- (catch '%return-from-thread
- (apply real-function arguments))
- (when *exit-in-process*
- (sb!impl::call-exit-hooks)))))))
+ (prog1
+ (cons t
+ (multiple-value-list
+ (unwind-protect
+ (catch '%return-from-thread
+ (apply real-function arguments))
+ (when *exit-in-process*
+ (sb!impl::call-exit-hooks)))))
+ #!+sb-safepoint
+ (sb!kernel::gc-safepoint))))
;; We're going down, can't handle interrupts
;; sanely anymore. GC remains enabled.
(block-deferrable-signals)
(defknown sb!vm:%write-barrier () (values) ())
(defknown sb!vm:%data-dependency-barrier () (values) ())
+#!+sb-safepoint
+;;; Note: This known function does not have an out-of-line definition;
+;;; and if such a definition were needed, it would not need to "call"
+;;; itself inline, but could be a no-op, because the compiler inserts a
+;;; use of the VOP in the function prologue anyway.
+(defknown sb!kernel::gc-safepoint () (values) ())
;;;; atomic ops
(defknown %compare-and-swap-svref (simple-vector index t t) t
(control-stack-pointer :c-type "lispobj *")
#!+mach-exception-handler
(mach-port-name :c-type "mach_port_name_t")
+ (nonpointer-data :c-type "struct nonpointer_thread_data *" :length #!+alpha 2 #!-alpha 1)
+ #!+(and sb-safepoint x86) (selfptr :c-type "struct thread *")
+ #!+sb-safepoint (csp-around-foreign-call :c-type "lispobj *")
+ #!+sb-safepoint (pc-around-foreign-call :c-type "lispobj *")
;; KLUDGE: On alpha, until STEPPING we have been lucky and the 32
;; bit slots came in pairs. However the C compiler will align
;; interrupt_contexts on a double word boundary. This logic should
*gc-pending*
#!-sb-thread
*stepping*
+ #!+sb-safepoint sb!impl::*gc-safe*
+ #!+sb-safepoint sb!impl::*in-safepoint*
;; threading support
#!+sb-thread *stop-for-gc-pending*
(let ((lab (gen-label)))
(setf (ir2-physenv-environment-start env) lab)
- (vop note-environment-start node block lab)))
+ (vop note-environment-start node block lab)
+ #!+sb-safepoint
+ (unless (policy fun (>= inhibit-safepoints 2))
+ (vop sb!vm::insert-safepoint node block))))
(values))
\f
2block
#!+sb-dyncount *dynamic-counts-tn* #!-sb-dyncount nil
num))))
+ #!+sb-safepoint
+ (let ((first-node (block-start-node block)))
+ (unless (or (and (bind-p first-node)
+ (xep-p (bind-lambda first-node)))
+ (and (valued-node-p first-node)
+ (node-lvar first-node)
+ (eq (lvar-fun-name
+ (node-lvar first-node))
+ '%nlx-entry)))
+ (when (and (rest (block-pred block))
+ (block-loop block)
+ (member (loop-kind (block-loop block))
+ '(:natural :strange))
+ (eq block (loop-head (block-loop block)))
+ (policy first-node (< inhibit-safepoints 2)))
+ (vop sb!vm::insert-safepoint first-node 2block))))
(ir2-convert-block block)
(incf num))))))
(values))
(define-optimization-quality store-coverage-data
0
("no" "no" "yes" "yes"))
+
+#!+sb-safepoint
+(define-optimization-quality inhibit-safepoints
+ 0
+ ("no" "no" "yes" "yes")
+ "When disabled, the compiler will insert safepoints at strategic
+points (loop edges, function prologues) to ensure that potentially
+long-running code can be interrupted.
+
+When enabled, no safepoints will be inserted explicitly. Note that
+this declaration does not prevent out-of-line function calls, which
+will encounter safepoints unless the target function has also been
+compiled with this declaration in effect.")
;;; The minimum size at which we release address ranges to the OS.
;;; This must be a multiple of the OS page size.
(def!constant gencgc-release-granularity *backend-page-bytes*)
+
+#!+sb-safepoint
+(def!constant thread-saved-csp-offset
+ (- (/ *backend-page-bytes* n-word-bytes)))
(args :more t))
(:results (results :more t))
(:temporary (:sc unsigned-reg :offset rax-offset :to :result) rax)
- (:ignore results)
+ ;; For safepoint builds: Force values of non-volatiles to the stack.
+ ;; These are the callee-saved registers in the native ABI, but
+ ;; safepoint-based GC needs to see all Lisp values on the stack. Note
+ ;; that R12-R15 are non-volatile registers, but there is no need to
+ ;; spill R12 because it is our thread-base-tn. RDI and RSI are
+ ;; non-volatile on Windows, but argument passing registers on other
+ ;; platforms.
+ #!+sb-safepoint (:temporary (:sc unsigned-reg :offset r13-offset) r13)
+ #!+sb-safepoint (:temporary (:sc unsigned-reg :offset r14-offset) r14)
+ #!+sb-safepoint (:temporary (:sc unsigned-reg :offset r15-offset) r15)
+ #!+(and sb-safepoint win32) (:temporary
+ (:sc unsigned-reg :offset rdi-offset) rdi)
+ #!+(and sb-safepoint win32) (:temporary
+ (:sc unsigned-reg :offset rsi-offset) rsi)
+ (:ignore results
+ #!+(and sb-safepoint win32) rdi
+ #!+(and sb-safepoint win32) rsi
+ #!+sb-safepoint r15
+ #!+sb-safepoint r13)
(:vop-var vop)
(:save-p t)
(:generator 0
;; ABI: Direction flag must be clear on function entry. -- JES, 2006-01-20
(inst cld)
+ #!+sb-safepoint
+ (progn
+ ;; Current PC - don't rely on function to keep it in a form that
+ ;; GC understands
+ (let ((label (gen-label)))
+ (inst lea r14 (make-fixup nil :code-object label))
+ (emit-label label)))
;; ABI: AL contains amount of arguments passed in XMM registers
;; for vararg calls.
(move-immediate rax
while tn-ref
count (eq (sb-name (sc-sb (tn-sc (tn-ref-tn tn-ref))))
'float-registers)))
+ #!+sb-safepoint
+ (progn ;Store SP and PC in thread struct
+ (storew rsp-tn thread-base-tn thread-saved-csp-offset)
+ (storew r14 thread-base-tn thread-pc-around-foreign-call-slot))
(inst call function)
+ #!+sb-safepoint
+ (progn
+ ;; Zeroing out
+ (inst xor r14 r14)
+ ;; Zero PC storage place. NB. CSP-then-PC: same sequence on
+ ;; entry/exit, is actually corrent.
+ (storew r14 thread-base-tn thread-saved-csp-offset)
+ (storew r14 thread-base-tn thread-pc-around-foreign-call-slot))
;; To give the debugger a clue. XX not really internal-error?
(note-this-location vop :internal-error)))
(error "Too many arguments in callback")))
(let* ((segment (make-segment))
(rax rax-tn)
- (rcx rcx-tn)
+ #!+(not sb-safepoint) (rcx rcx-tn)
(rdi rdi-tn)
(rsi rsi-tn)
(rdx rdx-tn)
(t
(bug "Unknown alien floating point type: ~S" type)))))
- ;; arg0 to FUNCALL3 (function)
- ;;
- ;; Indirect the access to ENTER-ALIEN-CALLBACK through
- ;; the symbol-value slot of SB-ALIEN::*ENTER-ALIEN-CALLBACK*
- ;; to ensure it'll work even if the GC moves ENTER-ALIEN-CALLBACK.
- ;; Skip any SB-THREAD TLS magic, since we don't expect anyone
- ;; to rebind the variable. -- JES, 2006-01-01
- (inst mov rdi (+ nil-value (static-symbol-offset
- 'sb!alien::*enter-alien-callback*)))
- (loadw rdi rdi symbol-value-slot other-pointer-lowtag)
- ;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index)
- (inst mov rsi (fixnumize index))
- ;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
- (inst mov rdx rsp)
- ;; add room on stack for return value
- (inst sub rsp 8)
- ;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
- (inst mov rcx rsp)
-
- ;; Make new frame
- (inst push rbp)
- (inst mov rbp rsp)
-
- ;; Call
- (inst mov rax (foreign-symbol-address "funcall3"))
- (inst call rax)
-
- ;; Back! Restore frame
- (inst mov rsp rbp)
- (inst pop rbp)
+ #!-sb-safepoint
+ (progn
+ ;; arg0 to FUNCALL3 (function)
+ ;;
+ ;; Indirect the access to ENTER-ALIEN-CALLBACK through
+ ;; the symbol-value slot of SB-ALIEN::*ENTER-ALIEN-CALLBACK*
+ ;; to ensure it'll work even if the GC moves ENTER-ALIEN-CALLBACK.
+ ;; Skip any SB-THREAD TLS magic, since we don't expect anyone
+ ;; to rebind the variable. -- JES, 2006-01-01
+ (inst mov rdi (+ nil-value (static-symbol-offset
+ 'sb!alien::*enter-alien-callback*)))
+ (loadw rdi rdi symbol-value-slot other-pointer-lowtag)
+ ;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index)
+ (inst mov rsi (fixnumize index))
+ ;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
+ (inst mov rdx rsp)
+ ;; add room on stack for return value
+ (inst sub rsp 8)
+ ;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
+ (inst mov rcx rsp)
+
+ ;; Make new frame
+ (inst push rbp)
+ (inst mov rbp rsp)
+
+ ;; Call
+ (inst mov rax (foreign-symbol-address "funcall3"))
+ (inst call rax)
+
+ ;; Back! Restore frame
+ (inst mov rsp rbp)
+ (inst pop rbp))
+
+ #!+sb-safepoint
+ (progn
+ ;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index)
+ (inst mov rdi (fixnumize index))
+ ;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
+ (inst mov rsi rsp)
+ ;; add room on stack for return value
+ (inst sub rsp 8)
+ ;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
+ (inst mov rdx rsp)
+ ;; Make new frame
+ (inst push rbp)
+ (inst mov rbp rsp)
+ ;; Call
+ (inst mov rax (foreign-symbol-address "callback_wrapper_trampoline"))
+ (inst call rax)
+ ;; Back! Restore frame
+ (inst mov rsp rbp)
+ (inst pop rbp))
;; Result now on top of stack, put it in the right register
(cond
:disp (* n-word-bytes thread-pseudo-atomic-bits-slot))
0))
+#!+sb-safepoint
+(defun emit-safepoint ()
+ (inst test al-tn (make-ea :byte
+ :disp (make-fixup "gc_safepoint_page" :foreign))))
+
#!+sb-thread
(defmacro pseudo-atomic (&rest forms)
(with-unique-names (label)
;; if PAI was set, interrupts were disabled at the same time
;; using the process signal mask.
(inst break pending-interrupt-trap)
- (emit-label ,label))))
+ (emit-label ,label)
+ #!+sb-safepoint
+ ;; In this case, when allocation thinks a GC should be done, it
+ ;; does not mark PA as interrupted, but schedules a safepoint
+ ;; trap instead. Let's take the opportunity to trigger that
+ ;; safepoint right now.
+ (emit-safepoint))))
#!-sb-thread
(defenum (:start 24)
object-not-list-trap
- object-not-instance-trap)
+ object-not-instance-trap
+ #!+sb-safepoint global-safepoint-trap
+ #!+sb-safepoint csp-safepoint-trap)
\f
;;;; static symbols
(:generator 1
(inst break pending-interrupt-trap)))
+#!+sb-safepoint
+(define-vop (insert-safepoint)
+ (:policy :fast-safe)
+ (:translate sb!kernel::gc-safepoint)
+ (:generator 0
+ (emit-safepoint)))
+
#!+sb-thread
(defknown current-thread-offset-sap ((unsigned-byte 64))
system-area-pointer (flushable))
:from :eval :to :result) ecx)
(:temporary (:sc unsigned-reg :offset edx-offset
:from :eval :to :result) edx)
- (:node-var node)
+ #!+sb-safepoint (:temporary (:sc unsigned-reg :offset esi-offset) esi)
+ #!+sb-safepoint (:temporary (:sc unsigned-reg :offset edi-offset) edi)
+ #!-sb-safepoint (:node-var node)
(:vop-var vop)
(:save-p t)
- (:ignore args ecx edx)
+ (:ignore args ecx edx
+ #!+sb-safepoint esi
+ #!+sb-safepoint edi)
(:generator 0
;; FIXME & OAOOM: This is brittle and error-prone to maintain two
;; instances of the same logic, on in arch-assem.S, and one in
;; c-call.lisp. If you modify this, modify that one too...
- (cond ((policy node (> space speed))
+ (cond ((and
+ ;; On safepoints builds, we currently use the out-of-line
+ ;; calling routine irrespectively of SPACE and SPEED policy.
+ ;; An inline version of said changes is left to the
+ ;; sufficiently motivated maintainer.
+ #!-sb-safepoint (policy node (> space speed)))
(move eax function)
(inst call (make-fixup "call_into_c" :foreign)))
(t
(inst push eax) ; arg1
(inst push (ash index 2)) ; arg0
- ;; Indirect the access to ENTER-ALIEN-CALLBACK through
- ;; the symbol-value slot of SB-ALIEN::*ENTER-ALIEN-CALLBACK*
- ;; to ensure it'll work even if the GC moves ENTER-ALIEN-CALLBACK.
- ;; Skip any SB-THREAD TLS magic, since we don't expecte anyone
- ;; to rebind the variable. -- JES, 2006-01-01
- (load-symbol-value eax sb!alien::*enter-alien-callback*)
- (inst push eax) ; function
- (inst mov eax (foreign-symbol-address "funcall3"))
- (inst call eax)
+ #!+sb-safepoint
+ (progn
+ (inst mov eax (foreign-symbol-address "callback_wrapper_trampoline"))
+ (inst call eax))
+
+ #!-sb-safepoint
+ (progn
+ ;; Indirect the access to ENTER-ALIEN-CALLBACK through
+ ;; the symbol-value slot of SB-ALIEN::*ENTER-ALIEN-CALLBACK*
+ ;; to ensure it'll work even if the GC moves ENTER-ALIEN-CALLBACK.
+ ;; Skip any SB-THREAD TLS magic, since we don't expecte anyone
+ ;; to rebind the variable. -- JES, 2006-01-01
+ (load-symbol-value eax sb!alien::*enter-alien-callback*)
+ (inst push eax) ; function
+ (inst mov eax (foreign-symbol-address "funcall3"))
+ (inst call eax))
+
;; now put the result into the right register
(cond
((and (alien-integer-type-p return-type)
(defmacro %clear-pseudo-atomic ()
'(inst mov (make-ea :dword :disp (* 4 thread-pseudo-atomic-bits-slot)) 0 :fs))
+#!+sb-safepoint
+(defun emit-safepoint ()
+ (inst test al-tn (make-ea :byte
+ :disp (make-fixup "gc_safepoint_page" :foreign))))
+
#!+sb-thread
(defmacro pseudo-atomic (&rest forms)
(with-unique-names (label)
;; if PAI was set, interrupts were disabled at the same time
;; using the process signal mask.
(inst break pending-interrupt-trap)
- (emit-label ,label))))
+ (emit-label ,label)
+ #!+sb-safepoint
+ ;; In this case, when allocation thinks a GC should be done, it
+ ;; does not mark PA as interrupted, but schedules a safepoint
+ ;; trap instead. Let's take the opportunity to trigger that
+ ;; safepoint right now.
+ (emit-safepoint))))
#!-sb-thread
(defmacro pseudo-atomic (&rest forms)
#!+win32
(progn
-
(def!constant read-only-space-start #x22000000)
(def!constant read-only-space-end #x220ff000)
(defenum (:start 24)
object-not-list-trap
- object-not-instance-trap)
+ object-not-instance-trap
+ #!+sb-safepoint global-safepoint-trap
+ #!+sb-safepoint csp-safepoint-trap)
\f
;;;; static symbols
(:generator 1
(inst break pending-interrupt-trap)))
+#!+sb-safepoint
+(define-vop (insert-safepoint)
+ (:policy :fast-safe)
+ (:translate sb!kernel::gc-safepoint)
+ (:generator 0
+ (emit-safepoint)))
+
#!+sb-thread
(defknown current-thread-offset-sap ((unsigned-byte 32))
system-area-pointer (flushable))
dynbind.c funcall.c gc-common.c globals.c interr.c interrupt.c \
largefile.c monitor.c os-common.c parse.c print.c purify.c \
pthread-futex.c \
- regnames.c run-program.c runtime.c save.c search.c \
- thread.c time.c util.c validate.c vars.c wrap.c
+ regnames.c run-program.c runtime.c safepoint.c save.c search.c \
+ thread.c time.c util.c validate.c vars.c wrap.c
C_SRC = $(COMMON_SRC) ${ARCH_SRC} ${OS_SRC} ${GC_SRC}
lispobj *result;
struct thread *th = arch_os_get_current_thread();
+#ifndef LISP_FEATURE_SB_SAFEPOINT
/* SIG_STOP_FOR_GC must be unblocked: else two threads racing here
* may deadlock: one will wait on the GC lock, and the other
* cannot stop the first one... */
check_gc_signals_unblocked_or_lose(0);
+#endif
/* FIXME: OOAO violation: see arch_pseudo_* */
set_pseudo_atomic_atomic(th);
fake_foreign_function_call(context);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
code = find_code(context);
fake_foreign_function_call(context);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
code = find_code(context);
codeptr = (struct code *)native_pointer(code);
memory_fault_handler);
#endif
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef THREADS_USING_GCSIGNAL
undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
sig_stop_for_gc_handler);
#endif
--- /dev/null
+#ifndef SBCL_INCLUDED_CPPUTIL_H
+#define SBCL_INCLUDED_CPPUTIL_H
+
+#include <stdint.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 PTR_ALIGN_UP(pointer,granularity) \
+ (typeof(pointer))ALIGN_UP((uintptr_t)pointer,granularity)
+
+#define PTR_ALIGN_DOWN(pointer,granularity) \
+ (typeof(pointer))ALIGN_DOWN((uintptr_t)pointer,granularity)
+
+#define PTR_IS_ALIGNED(pointer,granularity) \
+ IS_ALIGNED((uintptr_t)pointer,granularity)
+
+#endif /* SBCL_INCLUDED_CPPUTIL_H */
}
void
+unbind_variable(lispobj name, void *th)
+{
+ struct thread *thread=(struct thread *)th;
+ struct binding *binding;
+ lispobj symbol;
+
+ binding = ((struct binding *)get_binding_stack_pointer(thread)) - 1;
+
+ symbol = binding->symbol;
+
+ if (symbol != name)
+ lose("unbind_variable, 0x%p != 0x%p", symbol, name);
+
+ SetTlSymbolValue(symbol, binding->value,thread);
+
+ binding->symbol = 0;
+ binding->value = 0;
+
+ set_binding_stack_pointer(thread,binding);
+}
+
+void
unbind_to_here(lispobj *bsp,void *th)
{
struct thread *thread=(struct thread *)th;
extern void bind_variable(lispobj symbol, lispobj value,void *thread);
extern void unbind(void *thread);
+extern void unbind_variable(lispobj name, void *thread);
extern void unbind_to_here(lispobj *bsp,void *thread);
#endif
static inline lispobj
safe_call_into_lisp(lispobj fun, lispobj *args, int nargs)
{
+#ifndef LISP_FEATURE_SB_SAFEPOINT
/* SIG_STOP_FOR_GC needs to be enabled before we can call lisp:
* otherwise two threads racing here may deadlock: the other will
* wait on the GC lock, and the other cannot stop the first
* one... */
check_gc_signals_unblocked_or_lose(0);
+#endif
return call_into_lisp(fun, args, nargs);
}
* A kludgy alternative is to propagate the sigmask change to the
* outer context.
*/
-#ifndef LISP_FEATURE_WIN32
+#if !(defined(LISP_FEATURE_WIN32) || defined(LISP_FEATURE_SB_SAFEPOINT))
check_gc_signals_unblocked_or_lose(os_context_sigmask_addr(context));
unblock_gc_signals(0, 0);
#endif
sigset_t *context_sigmask = os_context_sigmask_addr(context);
if (!deferrables_blocked_p(context_sigmask)) {
thread_sigmask(SIG_SETMASK, context_sigmask, 0);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
check_gc_signals_unblocked_or_lose(0);
#endif
+#endif
FSHOW((stderr, "/maybe_gc: calling POST_GC\n"));
funcall0(StaticSymbolFunction(POST_GC));
#ifndef LISP_FEATURE_WIN32
for_each_thread(th) {
void **ptr;
void **esp=(void **)-1;
-#ifdef LISP_FEATURE_SB_THREAD
+ if (th->state == STATE_DEAD)
+ continue;
+# if defined(LISP_FEATURE_SB_SAFEPOINT)
+ /* Conservative collect_garbage is always invoked with a
+ * foreign C call or an interrupt handler on top of every
+ * existing thread, so the stored SP in each thread
+ * structure is valid, no matter which thread we are looking
+ * at. For threads that were running Lisp code, the pitstop
+ * and edge functions maintain this value within the
+ * interrupt or exception handler. */
+ esp = os_get_csp(th);
+ assert_on_stack(th, esp);
+
+ /* In addition to pointers on the stack, also preserve the
+ * return PC, the only value from the context that we need
+ * in addition to the SP. The return PC gets saved by the
+ * foreign call wrapper, and removed from the control stack
+ * into a register. */
+ preserve_pointer(th->pc_around_foreign_call);
+
+ /* And on platforms with interrupts: scavenge ctx registers. */
+
+ /* Disabled on Windows, because it does not have an explicit
+ * stack of `interrupt_contexts'. The reported CSP has been
+ * chosen so that the current context on the stack is
+ * covered by the stack scan. See also set_csp_from_context(). */
+# ifndef LISP_FEATURE_WIN32
+ if (th != arch_os_get_current_thread()) {
+ long k = fixnum_value(
+ SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th));
+ while (k > 0)
+ preserve_context_registers(th->interrupt_contexts[--k]);
+ }
+# endif
+# elif defined(LISP_FEATURE_SB_THREAD)
long i,free;
if(th==arch_os_get_current_thread()) {
/* Somebody is going to burn in hell for this, but casting
}
}
}
-#else
+# else
esp = (void **)((void *)&raise);
-#endif
+# endif
+ if (!esp || esp == (void*) -1)
+ lose("garbage_collect: no SP known for thread %x (OS %x)",
+ th, th->os_thread);
for (ptr = ((void **)th->control_stack_end)-1; ptr >= esp; ptr--) {
preserve_pointer(*ptr);
}
* section */
SetSymbolValue(GC_PENDING,T,thread);
if (SymbolValue(GC_INHIBIT,thread) == NIL) {
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ thread_register_gc_trigger();
+#else
set_pseudo_atomic_interrupted(thread);
#ifdef LISP_FEATURE_PPC
/* PPC calls alloc() from a trap or from pa_alloc(),
#else
maybe_save_gc_mask_and_block_deferrables(NULL);
#endif
+#endif
}
}
}
new_obj = gc_alloc_with_region(nbytes, page_type_flag, region, 0);
#ifndef LISP_FEATURE_WIN32
+ /* for sb-prof, and not supported on Windows yet */
alloc_signal = SymbolValue(ALLOC_SIGNAL,thread);
if ((alloc_signal & FIXNUM_TAG_MASK) == 0) {
if ((signed long) alloc_signal <= 0) {
extern void globals_init(void);
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+# define GC_SAFEPOINT_PAGE_ADDR ((lispobj) gc_safepoint_page)
+extern char gc_safepoint_page[];
+#endif
+
#else /* LANGUAGE_ASSEMBLY */
# ifdef LISP_FEATURE_MIPS
void
sigaddset_gc(sigset_t *sigset)
{
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef THREADS_USING_GCSIGNAL
sigaddset(sigset,SIG_STOP_FOR_GC);
#endif
}
#endif
}
+#ifndef LISP_FEATURE_SB_SAFEPOINT
#if !defined(LISP_FEATURE_WIN32)
boolean
gc_signals_blocked_p(sigset_t *sigset)
lose("gc signals unblocked\n");
#endif
}
+#endif
void
block_deferrable_signals(sigset_t *where, sigset_t *old)
#endif
}
+#ifndef LISP_FEATURE_SB_SAFEPOINT
void
block_gc_signals(sigset_t *where, sigset_t *old)
{
block_signals(&gc_sigset, where, old);
#endif
}
+#endif
void
unblock_deferrable_signals(sigset_t *where, sigset_t *old)
#ifndef LISP_FEATURE_WIN32
if (interrupt_handler_pending_p())
lose("unblock_deferrable_signals: losing proposition\n");
+#ifndef LISP_FEATURE_SB_SAFEPOINT
check_gc_signals_unblocked_or_lose(where);
+#endif
unblock_signals(&deferrable_sigset, where, old);
#endif
}
#endif
}
+#ifndef LISP_FEATURE_SB_SAFEPOINT
void
unblock_gc_signals(sigset_t *where, sigset_t *old)
{
unblock_signals(&gc_sigset, where, old);
#endif
}
+#endif
void
unblock_signals_in_context_and_maybe_warn(os_context_t *context)
{
#ifndef LISP_FEATURE_WIN32
sigset_t *sigset = os_context_sigmask_addr(context);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
if (all_signals_blocked_p(sigset, &gc_sigset, "gc")) {
corruption_warning_and_maybe_lose(
"Enabling blocked gc signals to allow returning to Lisp without risking\n\
they are not safe to interrupt at all, this is a pretty severe occurrence.\n");
unblock_gc_signals(sigset, 0);
}
+#endif
if (!interrupt_handler_pending_p()) {
unblock_deferrable_signals(sigset, 0);
}
* The purpose is to avoid losing the pending gc signal if a
* deferrable interrupt async unwinds between clearing the pseudo
* atomic and trapping to GC.*/
+#ifndef LISP_FEATURE_SB_SAFEPOINT
void
maybe_save_gc_mask_and_block_deferrables(sigset_t *sigset)
{
thread_sigmask(SIG_SETMASK,&oldset,0);
#endif
}
+#endif
/* Are we leaving WITH-GCING and already running with interrupts
* enabled, without the protection of *GC-INHIBIT* T and there is gc
check_deferrables_blocked_or_lose(sigset);
else {
check_deferrables_unblocked_or_lose(sigset);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
/* If deferrables are unblocked then we are open to signals
* that run lisp code. */
check_gc_signals_unblocked_or_lose(sigset);
+#endif
}
#endif
}
/* Allocate the SAP object while the interrupts are still
* disabled. */
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
#ifndef LISP_FEATURE_WIN32
FSHOW_SIGNAL((stderr, "/entering interrupt_handle_pending\n"));
check_blockables_blocked_or_lose(0);
-
+#ifndef LISP_FEATURE_SB_SAFEPOINT
+ /*
+ * (On safepoint builds, there is no gc_blocked_deferrables nor
+ * SIG_STOP_FOR_GC.)
+ */
/* If GC/SIG_STOP_FOR_GC struck during PA and there was no pending
* handler, then the pending mask was saved and
* gc_blocked_deferrables set. Hence, there can be no pending
#endif
data->gc_blocked_deferrables = 0;
}
+#endif
if (SymbolValue(GC_INHIBIT,thread)==NIL) {
void *original_pending_handler = data->pending_handler;
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ /* handles the STOP_FOR_GC_PENDING case */
+ thread_pitstop(context);
+#elif defined(LISP_FEATURE_SB_THREAD)
if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) {
/* STOP_FOR_GC_PENDING and GC_PENDING are cleared by
* the signal handler if it actually stops us. */
* that should be handled on the spot. */
if (SymbolValue(GC_PENDING,thread) != NIL)
lose("GC_PENDING after doing gc.");
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef THREADS_USING_GCSIGNAL
if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL)
lose("STOP_FOR_GC_PENDING after doing gc.");
#endif
lispobj info_sap, context_sap;
/* Leave deferrable signals blocked, the handler itself will
* allow signals again when it sees fit. */
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
info_sap = alloc_sap(info);
FSHOW_SIGNAL((stderr,"/calling Lisp-level handler\n"));
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ WITH_GC_AT_SAFEPOINTS_ONLY()
+#endif
funcall3(handler.lisp,
make_fixnum(signal),
info_sap,
}
#endif
-#ifdef LISP_FEATURE_SB_THREAD
+#ifdef THREADS_USING_GCSIGNAL
/* This function must not cons, because that may trigger a GC. */
void
extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
extern void post_signal_tramp(void);
extern void call_into_lisp_tramp(void);
+
void
-arrange_return_to_lisp_function(os_context_t *context, lispobj function)
+arrange_return_to_c_function(os_context_t *context,
+ call_into_lisp_lookalike funptr,
+ lispobj function)
{
-#ifndef LISP_FEATURE_WIN32
+#if !(defined(LISP_FEATURE_WIN32) || defined(LISP_FEATURE_SB_SAFEPOINT))
check_gc_signals_unblocked_or_lose
(os_context_sigmask_addr(context));
#endif
*(register_save_area + 8) = *context_eflags_addr(context);
*os_context_pc_addr(context) =
- (os_context_register_t) call_into_lisp_tramp;
+ (os_context_register_t) funptr;
*os_context_register_addr(context,reg_ECX) =
(os_context_register_t) register_save_area;
#else
#ifdef LISP_FEATURE_X86
#if !defined(LISP_FEATURE_DARWIN)
- *os_context_pc_addr(context) = (os_context_register_t)call_into_lisp;
+ *os_context_pc_addr(context) = (os_context_register_t)funptr;
*os_context_register_addr(context,reg_ECX) = 0;
*os_context_register_addr(context,reg_EBP) = (os_context_register_t)(sp-2);
#ifdef __NetBSD__
#endif /* LISP_FEATURE_DARWIN */
#elif defined(LISP_FEATURE_X86_64)
- *os_context_pc_addr(context) = (os_context_register_t)call_into_lisp;
+ *os_context_pc_addr(context) = (os_context_register_t)funptr;
*os_context_register_addr(context,reg_RCX) = 0;
*os_context_register_addr(context,reg_RBP) = (os_context_register_t)(sp-2);
*os_context_register_addr(context,reg_RSP) = (os_context_register_t)(sp-18);
(long)function));
}
+void
+arrange_return_to_lisp_function(os_context_t *context, lispobj function)
+{
+#if defined(LISP_FEATURE_DARWIN)
+ arrange_return_to_c_function(context, call_into_lisp_tramp, function);
+#else
+ arrange_return_to_c_function(context, call_into_lisp, function);
+#endif
+}
+
/* KLUDGE: Theoretically the approach we use for undefined alien
* variables should work for functions as well, but on PPC/Darwin
* we get bus error at bogus addresses instead, hence this workaround,
sa.sa_flags = SA_SIGINFO | SA_RESTART
| (sigaction_nodefer_works ? SA_NODEFER : 0);
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
- if(signal==SIG_MEMORY_FAULT)
+ if(signal==SIG_MEMORY_FAULT) {
sa.sa_flags |= SA_ONSTACK;
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+ sigaddset(&sa.sa_mask, SIGRTMIN);
+ sigaddset(&sa.sa_mask, SIGRTMIN+1);
+# endif
+ }
#endif
sigaction(signal, &sa, NULL);
{
lispobj context_sap;
fake_foreign_function_call(context);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
unblock_gc_signals(0, 0);
+#endif
context_sap = alloc_sap(context);
#ifndef LISP_FEATURE_WIN32
thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
arch_handle_single_step_trap(context, trap);
break;
#endif
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ case trap_GlobalSafepoint:
+ fake_foreign_function_call(context);
+ thread_in_lisp_raised(context);
+ undo_fake_foreign_function_call(context);
+ arch_skip_instruction(context);
+ break;
+ case trap_CspSafepoint:
+ fake_foreign_function_call(context);
+ thread_in_safety_transition(context);
+ undo_fake_foreign_function_call(context);
+ arch_skip_instruction(context);
+ break;
+#endif
case trap_Halt:
fake_foreign_function_call(context);
lose("%%PRIMITIVE HALT called; the party is over.\n");
#endif
};
+typedef lispobj (*call_into_lisp_lookalike)(
+ lispobj fun, lispobj *args, int nargs);
+
extern boolean interrupt_handler_pending_p(void);
extern void interrupt_init(void);
extern void fake_foreign_function_call(os_context_t* context);
extern void undo_fake_foreign_function_call(os_context_t* context);
+extern void arrange_return_to_c_function(
+ os_context_t *, call_into_lisp_lookalike, lispobj);
extern void arrange_return_to_lisp_function(os_context_t *, lispobj);
extern void interrupt_handle_now(int, siginfo_t*, os_context_t*);
extern void interrupt_handle_pending(os_context_t*);
extern void lower_thread_control_stack_guard_page(struct thread *th);
extern void reset_thread_control_stack_guard_page(struct thread *th);
+#if defined(LISP_FEATURE_SB_SAFEPOINT) && !defined(LISP_FEATURE_WIN32)
+void rtmin0_handler(int signal, siginfo_t *info, os_context_t *context);
+void rtmin1_handler(int signal, siginfo_t *info, os_context_t *context);
+#endif
+
#endif
}
#endif
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ if (!handle_safepoint_violation(context, addr))
+#endif
+
#ifdef LISP_FEATURE_GENCGC
if (!gencgc_handle_wp_violation(addr))
#else
undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
sigsegv_handler);
#ifdef LISP_FEATURE_SB_THREAD
+# ifndef LISP_FEATURE_SB_SAFEPOINT
undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
sig_stop_for_gc_handler);
+# endif
#endif
}
#define thread_mutex_unlock(l) 0
#endif
+#if defined(LISP_FEATURE_SB_SAFEPOINT)
+void map_gc_page();
+void unmap_gc_page();
+int check_pending_interrupts();
+#endif
+
/* Block blockable interrupts for each SHOW, if not 0. */
#define QSHOW_SIGNAL_SAFE 1
/* Enable extra-verbose low-level debugging output for signals? (You
extern void *successful_malloc (size_t size);
extern char *copied_string (char *string);
+#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_SB_SAFEPOINT)
+# define THREADS_USING_GCSIGNAL 1
+#endif
+
#endif /* _SBCL_RUNTIME_H_ */
--- /dev/null
+/*
+ * 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 "sbcl.h"
+
+#ifdef LISP_FEATURE_SB_SAFEPOINT /* entire file */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#ifndef LISP_FEATURE_WIN32
+#include <sched.h>
+#endif
+#include <signal.h>
+#include <stddef.h>
+#include <errno.h>
+#include <sys/types.h>
+#ifndef LISP_FEATURE_WIN32
+#include <sys/wait.h>
+#endif
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+#include <mach/mach.h>
+#include <mach/mach_error.h>
+#include <mach/mach_types.h>
+#endif
+#include "runtime.h"
+#include "validate.h"
+#include "thread.h"
+#include "arch.h"
+#include "target-arch-os.h"
+#include "os.h"
+#include "globals.h"
+#include "dynbind.h"
+#include "genesis/cons.h"
+#include "genesis/fdefn.h"
+#include "interr.h"
+#include "alloc.h"
+#include "gc-internal.h"
+#include "pseudo-atomic.h"
+#include "interrupt.h"
+#include "lispregs.h"
+
+/* Temporarily, this macro is a wrapper for FSHOW_SIGNAL. Ultimately,
+ * it will be restored to its full win32 branch functionality, where it
+ * provides a very useful tracing mechanism that is configurable at
+ * runtime. */
+#define odxprint_show(what, fmt, args...) \
+ do { \
+ struct thread *__self = arch_os_get_current_thread(); \
+ FSHOW_SIGNAL((stderr, "[%p/%p:%s] " fmt "\n", \
+ __self, \
+ __self->os_thread, \
+ #what, \
+ ##args)); \
+ } while (0)
+
+#if QSHOW_SIGNALS
+# define odxprint odxprint_show
+#else
+# define odxprint(what, fmt, args...) do {} while (0)
+#endif
+
+#if !defined(LISP_FEATURE_WIN32)
+/* win32-os.c covers these, but there is no unixlike-os.c, so the normal
+ * definition goes here. Fixme: (Why) don't these work for Windows?
+ */
+void
+map_gc_page()
+{
+ odxprint(misc, "map_gc_page");
+ os_protect((void *) GC_SAFEPOINT_PAGE_ADDR,
+ 4,
+ OS_VM_PROT_READ | OS_VM_PROT_WRITE);
+}
+
+void
+unmap_gc_page()
+{
+ odxprint(misc, "unmap_gc_page");
+ os_protect((void *) GC_SAFEPOINT_PAGE_ADDR, 4, OS_VM_PROT_NONE);
+}
+#endif /* !LISP_FEATURE_WIN32 */
+
+static inline int
+thread_may_gc()
+{
+ /* Thread may gc if all of these are true:
+ * 1) GC_INHIBIT == NIL (outside of protected part of without-gcing)
+ * 2) GC_PENDING != :in-progress (outside of recursion protection)
+ * Note that we are in a safepoint here, which is always outside of PA. */
+
+ struct thread *self = arch_os_get_current_thread();
+ return (SymbolValue(GC_INHIBIT, self) == NIL
+ && (SymbolTlValue(GC_PENDING, self) == T ||
+ SymbolTlValue(GC_PENDING, self) == NIL));
+}
+
+int
+on_stack_p(struct thread *th, void *esp)
+{
+ return (void *)th->control_stack_start
+ <= esp && esp
+ < (void *)th->control_stack_end;
+}
+
+#ifndef LISP_FEATURE_WIN32
+/* (Technically, we still allocate an altstack even on Windows. Since
+ * Windows has a contiguous stack with an automatic guard page of
+ * user-configurable size instead of an alternative stack though, the
+ * SBCL-allocated altstack doesn't actually apply and won't be used.) */
+int
+on_altstack_p(struct thread *th, void *esp)
+{
+ void *start = (void *)th+dynamic_values_bytes;
+ void *end = (char *)start + 32*SIGSTKSZ;
+ return start <= esp && esp < end;
+}
+#endif
+
+void
+assert_on_stack(struct thread *th, void *esp)
+{
+ if (on_stack_p(th, esp))
+ return;
+#ifndef LISP_FEATURE_WIN32
+ if (on_altstack_p(th, esp))
+ lose("thread %p: esp on altstack: %p", th, esp);
+#endif
+ lose("thread %p: bogus esp: %p", th, esp);
+}
+
+// returns 0 if skipped, 1 otherwise
+int
+check_pending_gc(os_context_t *ctx)
+{
+ odxprint(misc, "check_pending_gc");
+ struct thread * self = arch_os_get_current_thread();
+ int done = 0;
+ sigset_t sigset;
+
+ if ((SymbolValue(IN_SAFEPOINT,self) == T) &&
+ ((SymbolValue(GC_INHIBIT,self) == NIL) &&
+ (SymbolValue(GC_PENDING,self) == NIL))) {
+ SetSymbolValue(IN_SAFEPOINT,NIL,self);
+ }
+ if (thread_may_gc() && (SymbolValue(IN_SAFEPOINT, self) == NIL)) {
+ if ((SymbolTlValue(GC_PENDING, self) == T)) {
+ lispobj gc_happened = NIL;
+
+ bind_variable(IN_SAFEPOINT,T,self);
+ block_deferrable_signals(NULL,&sigset);
+ if(SymbolTlValue(GC_PENDING,self)==T)
+ gc_happened = funcall0(StaticSymbolFunction(SUB_GC));
+ unbind_variable(IN_SAFEPOINT,self);
+ thread_sigmask(SIG_SETMASK,&sigset,NULL);
+ if (gc_happened == T) {
+ /* POST_GC wants to enable interrupts */
+ if (SymbolValue(INTERRUPTS_ENABLED,self) == T ||
+ SymbolValue(ALLOW_WITH_INTERRUPTS,self) == T) {
+ odxprint(misc, "going to call POST_GC");
+ funcall0(StaticSymbolFunction(POST_GC));
+ }
+ done = 1;
+ }
+ }
+ }
+ return done;
+}
+
+/* Several ideas on interthread signalling should be
+ tried. Implementation below was chosen for its moderate size and
+ relative simplicity.
+
+ Mutex is the only (conventional) system synchronization primitive
+ used by it. Some of the code below looks weird with this
+ limitation; rwlocks, Windows Event Objects, or perhaps pthread
+ barriers could be used to improve clarity.
+
+ No condvars here: our pthreads_win32 is great, but it doesn't
+ provide wait morphing optimization; let's avoid extra context
+ switches and extra contention. */
+
+struct gc_dispatcher {
+
+ /* Held by the first thread that decides to signal all others, for
+ the entire period while common GC safepoint page is
+ unmapped. This thread is called `STW (stop-the-world)
+ initiator' below. */
+ pthread_mutex_t mx_gpunmapped;
+
+ /* Held by STW initiator while it updates th_stw_initiator and
+ takes other locks in this structure */
+ pthread_mutex_t mx_gptransition;
+
+ /* Held by STW initiator until the world should be started (GC
+ complete, thruptions delivered). */
+ pthread_mutex_t mx_gcing;
+
+ /* Held by a SUB-GC's gc_stop_the_world() when thread in SUB-GC
+ holds the GC Lisp-level mutex, but _couldn't_ become STW
+ initiator (i.e. another thread is already stopping the
+ world). */
+ pthread_mutex_t mx_subgc;
+
+ /* First thread (at this round) that decided to stop the world */
+ struct thread *th_stw_initiator;
+
+ /* Thread running SUB-GC under the `supervision' of STW
+ initiator */
+ struct thread *th_subgc;
+
+ /* Stop counter. Nested gc-stop-the-world and gc-start-the-world
+ work without thundering herd. */
+ int stopped;
+
+} gc_dispatcher = {
+ /* mutexes lazy initialized, other data initially zeroed */
+ .mx_gpunmapped = PTHREAD_MUTEX_INITIALIZER,
+ .mx_gptransition = PTHREAD_MUTEX_INITIALIZER,
+ .mx_gcing = PTHREAD_MUTEX_INITIALIZER,
+ .mx_subgc = PTHREAD_MUTEX_INITIALIZER,
+};
+
+\f
+/* set_thread_csp_access -- alter page permissions for not-in-Lisp
+ flag (Lisp Stack Top) of the thread `p'. The flag may be modified
+ if `writable' is true.
+
+ Return true if there is a non-null value in the flag.
+
+ When a thread enters C code or leaves it, a per-thread location is
+ modified. That machine word serves as a not-in-Lisp flag; for
+ convenience, when in C, it's filled with a topmost stack location
+ that may contain Lisp data. When thread is in Lisp, the word
+ contains NULL.
+
+ GENCGC uses each thread's flag value for conservative garbage collection.
+
+ There is a full VM page reserved for this word; page permissions
+ are switched to read-only for race-free examine + wait + use
+ scenarios. */
+static inline boolean
+set_thread_csp_access(struct thread* p, boolean writable)
+{
+ os_protect((os_vm_address_t) p->csp_around_foreign_call,
+ THREAD_CSP_PAGE_SIZE,
+ writable? (OS_VM_PROT_READ|OS_VM_PROT_WRITE)
+ : (OS_VM_PROT_READ));
+ return !!*p->csp_around_foreign_call;
+}
+
+\f
+/* maybe_become_stw_initiator -- if there is no stop-the-world action
+ in progress, begin it by unmapping GC page, and record current
+ thread as STW initiator.
+
+ Return true if current thread becomes a GC initiator, or already
+ _is_ a STW initiator.
+
+ Unlike gc_stop_the_world and gc_start_the_world (that should be
+ used in matching pairs), maybe_become_stw_initiator is idempotent
+ within a stop-restart cycle. With this call, a thread may `reserve
+ the right' to stop the world as early as it wants. */
+
+static inline boolean
+maybe_become_stw_initiator()
+{
+ struct thread* self = arch_os_get_current_thread();
+
+ /* Double-checked locking. Possible word tearing on some
+ architectures, FIXME FIXME, but let's think of it when GENCGC
+ and threaded SBCL is ported to them. */
+ if (!gc_dispatcher.th_stw_initiator) {
+ odxprint(misc,"NULL STW BEFORE GPTRANSITION");
+ pthread_mutex_lock(&gc_dispatcher.mx_gptransition);
+ /* We hold mx_gptransition. Is there no STW initiator yet? */
+ if (!gc_dispatcher.th_stw_initiator) {
+ odxprint(misc,"NULL STW IN GPTRANSITION, REPLACING");
+ /* Then we are... */
+ gc_dispatcher.th_stw_initiator = self;
+
+ /* hold mx_gcing until we restart the world */
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+
+ /* and mx_gpunmapped until we remap common GC page */
+ pthread_mutex_lock(&gc_dispatcher.mx_gpunmapped);
+
+ /* we unmap it; other threads running Lisp code will now
+ trap. */
+ unmap_gc_page();
+
+ /* stop counter; the world is not stopped yet. */
+ gc_dispatcher.stopped = 0;
+ }
+ pthread_mutex_unlock(&gc_dispatcher.mx_gptransition);
+ }
+ return gc_dispatcher.th_stw_initiator == self;
+}
+
+\f
+/* maybe_let_the_world_go -- if current thread is a STW initiator,
+ unlock internal GC structures, and return true. */
+static inline boolean
+maybe_let_the_world_go()
+{
+ struct thread* self = arch_os_get_current_thread();
+ if (gc_dispatcher.th_stw_initiator == self) {
+ pthread_mutex_lock(&gc_dispatcher.mx_gptransition);
+ if (gc_dispatcher.th_stw_initiator == self) {
+ gc_dispatcher.th_stw_initiator = NULL;
+ }
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ pthread_mutex_unlock(&gc_dispatcher.mx_gptransition);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+\f
+/* gc_stop_the_world -- become STW initiator (waiting for other GCs to
+ complete if necessary), and make sure all other threads are either
+ stopped or gc-safe (i.e. running foreign calls).
+
+ If GC initiator already exists, gc_stop_the_world() either waits
+ for its completion, or cooperates with it: e.g. concurrent pending
+ thruption handler allows (SUB-GC) to complete under its
+ `supervision'.
+
+ Code sections bounded by gc_stop_the_world and gc_start_the_world
+ may be nested; inner calls don't stop or start threads,
+ decrementing or incrementing the stop counter instead. */
+void
+gc_stop_the_world()
+{
+ struct thread* self = arch_os_get_current_thread(), *p;
+ if (SymbolTlValue(GC_INHIBIT,self)!=T) {
+ /* If GC is enabled, this thread may wait for current STW
+ initiator without causing deadlock. */
+ if (!maybe_become_stw_initiator()) {
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+ maybe_become_stw_initiator();
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ }
+ /* Now _this thread_ should be STW initiator */
+ gc_assert(self == gc_dispatcher.th_stw_initiator);
+ } else {
+ /* GC inhibited; e.g. we are inside SUB-GC */
+ if (!maybe_become_stw_initiator()) {
+ /* Some trouble. Inside SUB-GC, holding the Lisp-side
+ mutex, but some other thread is stopping the world. */
+ {
+ /* In SUB-GC, holding mutex; other thread wants to
+ GC. */
+ if (gc_dispatcher.th_subgc == self) {
+ /* There is an outer gc_stop_the_world() by _this_
+ thread, running subordinately to initiator.
+ Just increase stop counter. */
+ ++gc_dispatcher.stopped;
+ return;
+ }
+ /* Register as subordinate collector thread: take
+ mx_subgc */
+ pthread_mutex_lock(&gc_dispatcher.mx_subgc);
+ ++gc_dispatcher.stopped;
+
+ /* Unlocking thread's own thread_qrl() designates
+ `time to examine me' to other threads. */
+ pthread_mutex_unlock(thread_qrl(self));
+
+ /* STW (GC) initiator thread will see our thread needs
+ to finish GC. It will stop the world and itself,
+ and unlock its qrl. */
+ pthread_mutex_lock(thread_qrl(gc_dispatcher.th_stw_initiator));
+ return;
+ }
+ }
+ }
+ if (!gc_dispatcher.stopped++) {
+ /* Outermost stop: signal other threads */
+ pthread_mutex_lock(&all_threads_lock);
+ /* Phase 1: ensure all threads are aware of the need to stop,
+ or locked in the foreign code. */
+ for_each_thread(p) {
+ pthread_mutex_t *p_qrl = thread_qrl(p);
+ if (p==self)
+ continue;
+
+ /* Read-protect p's flag */
+ if (!set_thread_csp_access(p,0)) {
+ odxprint(safepoints,"taking qrl %p of %p", p_qrl, p);
+ /* Thread is in Lisp, so it should trap (either in
+ Lisp or in Lisp->FFI transition). Trap handler
+ unlocks thread_qrl(p); when it happens, we're safe
+ to examine that thread. */
+ pthread_mutex_lock(p_qrl);
+ odxprint(safepoints,"taken qrl %p of %p", p_qrl, p);
+ /* Mark thread for the future: should we collect, or
+ wait for its final permission? */
+ if (SymbolTlValue(GC_INHIBIT,p)!=T) {
+ SetTlSymbolValue(GC_SAFE,T,p);
+ } else {
+ SetTlSymbolValue(GC_SAFE,NIL,p);
+ }
+ pthread_mutex_unlock(p_qrl);
+ } else {
+ /* In C; we just disabled writing. */
+ {
+ if (SymbolTlValue(GC_INHIBIT,p)==T) {
+ /* GC inhibited there */
+ SetTlSymbolValue(STOP_FOR_GC_PENDING,T,p);
+ /* Enable writing. Such threads trap by
+ pending thruption when WITHOUT-GCING
+ section ends */
+ set_thread_csp_access(p,1);
+ SetTlSymbolValue(GC_SAFE,NIL,p);
+ } else {
+ /* Thread allows concurrent GC. It runs in C
+ (not a mutator), its in-Lisp flag is
+ read-only (so it traps on return). */
+ SetTlSymbolValue(GC_SAFE,T,p);
+ }
+ }
+ }
+ }
+ /* All threads are ready (GC_SAFE == T) or notified (GC_SAFE == NIL). */
+ map_gc_page();
+ pthread_mutex_unlock(&gc_dispatcher.mx_gpunmapped);
+ /* Threads with GC inhibited -- continued */
+ odxprint(safepoints,"after remapping GC page %p",self);
+
+ SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,self);
+ {
+ struct thread* priority_gc = NULL;
+ for_each_thread(p) {
+ if (p==self)
+ continue;
+ if (SymbolTlValue(GC_SAFE,p)!=T) {
+ /* Wait for thread to `park'. NB it _always_ does
+ it with a pending interrupt trap, so CSP locking is
+ not needed */
+ odxprint(safepoints,"waiting final parking %p (qrl %p)",p, thread_qrl(p));
+ WITH_STATE_SEM(p) {
+ pthread_mutex_lock(thread_qrl(p));
+ if (SymbolTlValue(GC_INHIBIT,p)==T) {
+ /* Concurrent GC invoked manually */
+ gc_assert(!priority_gc); /* Should be at most one at a time */
+ priority_gc = p;
+ }
+ pthread_mutex_unlock(thread_qrl(p));
+ }
+ }
+ if (!os_get_csp(p))
+ lose("gc_stop_the_world: no SP in parked thread: %p", p);
+ }
+ if (priority_gc) {
+ /* This thread is managing the entire process, so it
+ has to allow manually-invoked GC to complete */
+ if (!set_thread_csp_access(self,1)) {
+ /* Create T.O.S. */
+ *self->csp_around_foreign_call = (lispobj)__builtin_frame_address(0);
+ /* Unlock myself */
+ pthread_mutex_unlock(thread_qrl(self));
+ /* Priority GC should take over, holding
+ mx_subgc until it's done. */
+ pthread_mutex_lock(&gc_dispatcher.mx_subgc);
+ /* Lock myself */
+ pthread_mutex_lock(thread_qrl(self));
+ *self->csp_around_foreign_call = 0;
+ SetTlSymbolValue(GC_PENDING,NIL,self);
+ pthread_mutex_unlock(&gc_dispatcher.mx_subgc);
+ } else {
+ /* Unlock myself */
+ pthread_mutex_unlock(thread_qrl(self));
+ /* Priority GC should take over, holding
+ mx_subgc until it's done. */
+ pthread_mutex_lock(&gc_dispatcher.mx_subgc);
+ /* Lock myself */
+ pthread_mutex_lock(thread_qrl(self));
+ /* Unlock sub-gc */
+ pthread_mutex_unlock(&gc_dispatcher.mx_subgc);
+ }
+ }
+ }
+ }
+}
+
+\f
+/* gc_start_the_world() -- restart all other threads if the call
+ matches the _outermost_ gc_stop_the_world(), or decrement the stop
+ counter. */
+void
+gc_start_the_world()
+{
+ struct thread* self = arch_os_get_current_thread(), *p;
+ if (gc_dispatcher.th_stw_initiator != self) {
+ odxprint(misc,"Unmapper %p self %p",gc_dispatcher.th_stw_initiator,self);
+ gc_assert (gc_dispatcher.th_subgc == self);
+ if (--gc_dispatcher.stopped == 1) {
+ gc_dispatcher.th_subgc = NULL;
+ pthread_mutex_unlock(&gc_dispatcher.mx_subgc);
+ /* GC initiator may continue now */
+ pthread_mutex_unlock(thread_qrl(gc_dispatcher.th_stw_initiator));
+ }
+ return;
+ }
+
+ gc_assert(gc_dispatcher.th_stw_initiator == self);
+
+ if (!--gc_dispatcher.stopped) {
+ for_each_thread(p) {
+ {
+ SetTlSymbolValue(STOP_FOR_GC_PENDING,NIL,p);
+ SetTlSymbolValue(GC_PENDING,NIL,p);
+ }
+ set_thread_csp_access(p,1);
+ }
+ pthread_mutex_unlock(&all_threads_lock);
+ /* Release everyone */
+ maybe_let_the_world_go();
+ }
+}
+
+\f
+/* in_race_p() -- return TRUE if no other thread is inside SUB-GC with
+ GC-PENDING :IN-PROGRESS. Used to prevent deadlock between manual
+ SUB-GC, auto-gc and thruption. */
+static inline boolean
+in_race_p()
+{
+ struct thread* self = arch_os_get_current_thread(), *p;
+ boolean result = 0;
+ pthread_mutex_lock(&all_threads_lock);
+ for_each_thread(p) {
+ if (p!=self &&
+ SymbolTlValue(GC_PENDING,p)!=T &&
+ SymbolTlValue(GC_PENDING,p)!=NIL) {
+ result = 1;
+ break;
+ }
+ }
+ pthread_mutex_unlock(&all_threads_lock);
+ if (result) {
+ map_gc_page();
+ pthread_mutex_unlock(&gc_dispatcher.mx_gpunmapped);
+ maybe_let_the_world_go();
+ }
+ return result;
+}
+\f
+static void
+set_csp_from_context(struct thread *self, os_context_t *ctx)
+{
+ void **sp = (void **) *os_context_register_addr(ctx, reg_SP);
+ gc_assert((void **)self->control_stack_start
+ <= sp && sp
+ < (void **)self->control_stack_end);
+ *self->csp_around_foreign_call = (lispobj) sp;
+}
+
+void
+thread_pitstop(os_context_t *ctxptr)
+{
+ struct thread* self = arch_os_get_current_thread();
+ boolean inhibitor = (SymbolTlValue(GC_INHIBIT,self)==T);
+
+ odxprint(safepoints,"pitstop [%p]", ctxptr);
+ if (inhibitor) {
+ SetTlSymbolValue(STOP_FOR_GC_PENDING,T,self);
+ /* Free qrl to let know we're ready... */
+ WITH_STATE_SEM(self) {
+ pthread_mutex_unlock(thread_qrl(self));
+ pthread_mutex_lock(&gc_dispatcher.mx_gpunmapped);
+ pthread_mutex_lock(thread_qrl(self));
+ pthread_mutex_unlock(&gc_dispatcher.mx_gpunmapped);
+ }
+ /* Enable FF-CSP recording (not hurt: will gc at pit-stop, and
+ pit-stop always waits for GC end) */
+ set_thread_csp_access(self,1);
+ } else {
+ if (self == gc_dispatcher.th_stw_initiator && gc_dispatcher.stopped) {
+ set_thread_csp_access(self,1);
+ check_pending_gc(ctxptr);
+ return;
+ }
+ if ((SymbolTlValue(GC_PENDING,self)!=NIL) &&
+ maybe_become_stw_initiator() && !in_race_p()) {
+ gc_stop_the_world();
+ set_thread_csp_access(self,1);
+ check_pending_gc(ctxptr);
+ gc_start_the_world();
+ } else {
+ /* An innocent thread which is not an initiator _and_ is
+ not objecting. */
+ odxprint(safepoints,"pitstop yielding [%p]", ctxptr);
+ if (!set_thread_csp_access(self,1)) {
+ if (os_get_csp(self))
+ lose("thread_pitstop: would lose csp");
+ set_csp_from_context(self, ctxptr);
+ pthread_mutex_unlock(thread_qrl(self));
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+ *self->csp_around_foreign_call = 0;
+ pthread_mutex_lock(thread_qrl(self));
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ } else {
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+ set_thread_csp_access(self,1);
+ WITH_GC_AT_SAFEPOINTS_ONLY() {
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ }
+ return;
+ }
+ }
+ }
+}
+
+static inline void
+thread_edge(os_context_t *ctxptr)
+{
+ struct thread *self = arch_os_get_current_thread();
+ set_thread_csp_access(self,1);
+ if (os_get_csp(self)) {
+ if (!self->pc_around_foreign_call)
+ return; /* trivialize */
+ odxprint(safepoints,"edge leaving [%p]", ctxptr);
+ if (SymbolTlValue(GC_INHIBIT,self)!=T) {
+ {
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+ odxprint(safepoints,"edge leaving [%p] took gcing", ctxptr);
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ odxprint(safepoints,"edge leaving [%p] released gcing", ctxptr);
+ }
+ }
+ } else {
+ /* Entering. */
+ odxprint(safepoints,"edge entering [%p]", ctxptr);
+ if (os_get_csp(self))
+ lose("thread_edge: would lose csp");
+ set_csp_from_context(self, ctxptr);
+ if (SymbolTlValue(GC_INHIBIT,self)!=T) {
+ pthread_mutex_unlock(thread_qrl(self));
+ pthread_mutex_lock(&gc_dispatcher.mx_gcing);
+ *self->csp_around_foreign_call = 0;
+ pthread_mutex_lock(thread_qrl(self));
+ pthread_mutex_unlock(&gc_dispatcher.mx_gcing);
+ } else {
+ SetTlSymbolValue(STOP_FOR_GC_PENDING,T,self);
+ pthread_mutex_unlock(thread_qrl(self));
+ pthread_mutex_lock(&gc_dispatcher.mx_gpunmapped);
+ *self->csp_around_foreign_call = 0;
+ pthread_mutex_lock(thread_qrl(self));
+ pthread_mutex_unlock(&gc_dispatcher.mx_gpunmapped);
+ }
+ }
+}
+
+\f
+/* thread_register_gc_trigger --
+
+ Called by GENCGC in each thread where GC_PENDING becomes T because
+ allocated memory size has crossed the threshold in
+ auto_gc_trigger. For the new collective GC sequence, its first call
+ marks a process-wide beginning of GC.
+*/
+void
+thread_register_gc_trigger()
+{
+ odxprint(misc, "/thread_register_gc_trigger");
+ struct thread* self = arch_os_get_current_thread();
+ /* This function should be called instead of former
+ set_pseudo_atomic_interrupted(), e.g. never with true
+ GC_INHIBIT */
+ gc_assert(SymbolTlValue(GC_INHIBIT,self)!=T);
+
+ /* unmap GC page, signal other threads... */
+ maybe_become_stw_initiator();
+}
+
+
+\f
+void
+thread_in_safety_transition(os_context_t *ctx)
+{
+ FSHOW_SIGNAL((stderr, "thread_in_safety_transition\n"));
+ thread_edge(ctx);
+}
+
+void
+thread_in_lisp_raised(os_context_t *ctx)
+{
+ FSHOW_SIGNAL((stderr, "thread_in_lisp_raised\n"));
+ thread_pitstop(ctx);
+}
+
+void**
+os_get_csp(struct thread* th)
+{
+ FSHOW_SIGNAL((stderr, "Thread %p has CSP *(%p) == %p, stack [%p,%p]\n",
+ th,
+ th->csp_around_foreign_call,
+ *(void***)th->csp_around_foreign_call,
+ th->control_stack_start,
+ th->control_stack_end));
+ return *(void***)th->csp_around_foreign_call;
+}
+
+
+#ifndef LISP_FEATURE_WIN32
+
+/* Designed to be of the same type as call_into_lisp. Ignores its
+ * arguments. */
+lispobj
+handle_global_safepoint_violation(lispobj fun, lispobj *args, int nargs)
+{
+#if trap_GlobalSafepoint != 0x1a
+# error trap_GlobalSafepoint mismatch
+#endif
+ asm("int3; .byte 0x1a;");
+ return 0;
+}
+
+lispobj
+handle_csp_safepoint_violation(lispobj fun, lispobj *args, int nargs)
+{
+#if trap_CspSafepoint != 0x1b
+# error trap_CspSafepoint mismatch
+#endif
+ asm("int3; .byte 0x1b;");
+ return 0;
+}
+
+int
+handle_safepoint_violation(os_context_t *ctx, os_vm_address_t fault_address)
+{
+ FSHOW_SIGNAL((stderr, "fault_address = %p, sp = %p, &csp = %p\n",
+ fault_address,
+ GC_SAFEPOINT_PAGE_ADDR,
+ arch_os_get_current_thread()->csp_around_foreign_call));
+
+ struct thread *self = arch_os_get_current_thread();
+
+ if (fault_address == (os_vm_address_t) GC_SAFEPOINT_PAGE_ADDR) {
+ /* We're on the altstack and don't want to run Lisp code. */
+ arrange_return_to_c_function(ctx, handle_global_safepoint_violation, 0);
+ return 1;
+ }
+
+ if (fault_address == (os_vm_address_t) self->csp_around_foreign_call) {
+ arrange_return_to_c_function(ctx, handle_csp_safepoint_violation, 0);
+ return 1;
+ }
+
+ /* not a safepoint */
+ return 0;
+}
+#endif /* LISP_FEATURE_WIN32 */
+
+void
+callback_wrapper_trampoline(lispobj arg0, lispobj arg1, lispobj arg2)
+{
+ struct thread* th = arch_os_get_current_thread();
+ if (!th)
+ lose("callback invoked in non-lisp thread. Sorry, that is not supported yet.");
+
+ WITH_GC_AT_SAFEPOINTS_ONLY()
+ funcall3(SymbolValue(ENTER_ALIEN_CALLBACK, 0), arg0, arg1, arg2);
+}
+
+#endif /* LISP_FEATURE_SB_SAFEPOINT -- entire file */
{
void* fault_addr = (void*)info->si_addr;
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ if (handle_safepoint_violation(context, fault_addr))
+ return;
+#endif
+
if (!gencgc_handle_wp_violation(fault_addr))
if(!handle_guard_page_triggered(context, fault_addr))
lisp_memory_fault_error(context, fault_addr);
sigsegv_handler);
#ifdef LISP_FEATURE_SB_THREAD
+# ifndef LISP_FEATURE_SB_SAFEPOINT
undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC,
sig_stop_for_gc_handler);
+# endif
#endif
}
#include "interr.h" /* for lose() */
#include "alloc.h"
#include "gc-internal.h"
+#include "cpputil.h"
+#include "pseudo-atomic.h"
+#include "interrupt.h"
+#include "lispregs.h"
#ifdef LISP_FEATURE_WIN32
/*
#ifdef LISP_FEATURE_SB_THREAD
pthread_setspecific(lisp_thread, (void *)1);
#endif
-#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_PPC)
+#if defined(THREADS_USING_GCSIGNAL) && defined(LISP_FEATURE_PPC)
/* SIG_STOP_FOR_GC defaults to blocked on PPC? */
unblock_gc_signals(0,0);
#endif
function = th->no_tls_value_marker;
th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
if(arch_os_thread_init(th)==0) return 1;
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ pthread_mutex_lock(thread_qrl(th));
+#endif
link_thread(th);
th->os_thread=thread_self();
#ifndef LISP_FEATURE_WIN32
}
#ifdef LISP_FEATURE_SB_THREAD
-#define THREAD_STATE_LOCK_SIZE \
- ((sizeof(os_sem_t))+(sizeof(os_sem_t))+(sizeof(os_sem_t)))
-#else
-#define THREAD_STATE_LOCK_SIZE 0
-#endif
-
-#define THREAD_STRUCT_SIZE (thread_control_stack_size + BINDING_STACK_SIZE + \
- ALIEN_STACK_SIZE + \
- THREAD_STATE_LOCK_SIZE + \
- dynamic_values_bytes + \
- 32 * SIGSTKSZ + \
- THREAD_ALIGNMENT_BYTES)
-
-#ifdef LISP_FEATURE_SB_THREAD
/* THREAD POST MORTEM CLEANUP
*
* Memory allocated for the thread stacks cannot be reclaimed while
FSHOW((stderr,"/creating thread %lu\n", thread_self()));
check_deferrables_blocked_or_lose(0);
+#ifndef LISP_FEATURE_SB_SAFEPOINT
check_gc_signals_unblocked_or_lose(0);
+#endif
pthread_setspecific(lisp_thread, (void *)1);
function = th->no_tls_value_marker;
th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
* list and we're just adding this thread to it, there is no
* danger of deadlocking even with SIG_STOP_FOR_GC blocked (which
* it is not). */
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ *th->csp_around_foreign_call = (lispobj)&function;
+ pthread_mutex_lock(thread_qrl(th));
+#endif
lock_ret = pthread_mutex_lock(&all_threads_lock);
gc_assert(lock_ret == 0);
link_thread(th);
lock_ret = pthread_mutex_unlock(&all_threads_lock);
gc_assert(lock_ret == 0);
+ /* Kludge: Changed the order of some steps between the safepoint/
+ * non-safepoint versions of this code. Can we unify this more?
+ */
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ WITH_GC_AT_SAFEPOINTS_ONLY() {
+ result = funcall0(function);
+ block_blockable_signals(0, 0);
+ gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
+ }
+ lock_ret = pthread_mutex_lock(&all_threads_lock);
+ gc_assert(lock_ret == 0);
+ unlink_thread(th);
+ lock_ret = pthread_mutex_unlock(&all_threads_lock);
+ gc_assert(lock_ret == 0);
+ pthread_mutex_unlock(thread_qrl(th));
+ set_thread_state(th,STATE_DEAD);
+#else
result = funcall0(function);
/* Block GC */
unlink_thread(th);
pthread_mutex_unlock(&all_threads_lock);
gc_assert(lock_ret == 0);
+#endif
if(th->tls_cookie>=0) arch_os_thread_cleanup(th);
os_sem_destroy(th->state_sem);
aligned_spaces = (void *)((((unsigned long)(char *)spaces)
+ THREAD_ALIGNMENT_BYTES-1)
&~(unsigned long)(THREAD_ALIGNMENT_BYTES-1));
- per_thread=(union per_thread_data *)
+ void* csp_page=
(aligned_spaces+
thread_control_stack_size+
BINDING_STACK_SIZE+
- ALIEN_STACK_SIZE +
- THREAD_STATE_LOCK_SIZE);
+ ALIEN_STACK_SIZE);
+ per_thread=(union per_thread_data *)
+ (csp_page + THREAD_CSP_PAGE_SIZE);
+ struct nonpointer_thread_data *nonpointer_data
+ = (void *) &per_thread->dynamic_values[TLS_SIZE];
#ifdef LISP_FEATURE_SB_THREAD
for(i = 0; i < (dynamic_values_bytes / sizeof(lispobj)); i++)
set_binding_stack_pointer(th,th->binding_stack_start);
th->this=th;
th->os_thread=0;
+
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ th->pc_around_foreign_call = 0;
+ th->csp_around_foreign_call = csp_page;
+#endif
+
#ifdef LISP_FEATURE_SB_THREAD
+ /* Contrary to the "allocate all the spaces at once" comment above,
+ * the os_attr is allocated separately. We cannot put it into the
+ * nonpointer data, because it's used for post_mortem and freed
+ * separately */
th->os_attr=malloc(sizeof(pthread_attr_t));
- th->state_sem=(os_sem_t *)((void *)th->alien_stack_start + ALIEN_STACK_SIZE);
- th->state_not_running_sem=(os_sem_t *)
- ((void *)th->state_sem + (sizeof(os_sem_t)));
- th->state_not_stopped_sem=(os_sem_t *)
- ((void *)th->state_not_running_sem + (sizeof(os_sem_t)));
+ th->nonpointer_data = nonpointer_data;
+ th->state_sem=&nonpointer_data->state_sem;
+ th->state_not_running_sem=&nonpointer_data->state_not_running_sem;
+ th->state_not_stopped_sem=&nonpointer_data->state_not_stopped_sem;
th->state_not_running_waitcount = 0;
th->state_not_stopped_waitcount = 0;
os_sem_init(th->state_sem, 1);
os_sem_init(th->state_not_running_sem, 0);
os_sem_init(th->state_not_stopped_sem, 0);
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+ pthread_mutex_init(thread_qrl(th), NULL);
+# endif
#endif
th->state=STATE_RUNNING;
#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
#ifdef LISP_FEATURE_SB_THREAD
bind_variable(STOP_FOR_GC_PENDING,NIL,th);
#endif
+#if defined(LISP_FEATURE_SB_SAFEPOINT)
+ bind_variable(GC_SAFE,NIL,th);
+ bind_variable(IN_SAFEPOINT,NIL,th);
+#endif
#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
access_control_stack_pointer(th)=th->control_stack_start;
#endif
* the usual pseudo-atomic checks (we don't want to stop a thread while
* it's in the middle of allocation) then waits for another SIG_STOP_FOR_GC.
*/
+/*
+ * (With SB-SAFEPOINT, see the definitions in safepoint.c instead.)
+ */
+#ifndef LISP_FEATURE_SB_SAFEPOINT
/* To avoid deadlocks when gc stops the world all clients of each
* mutex must enable or disable SIG_STOP_FOR_GC for the duration of
FSHOW_SIGNAL((stderr,"/gc_start_the_world:end\n"));
}
-#endif
+
+#endif /* !LISP_FEATURE_SB_SAFEPOINT */
+#endif /* !LISP_FEATURE_SB_THREAD */
int
thread_yield()
#ifdef LISP_FEATURE_SB_THREAD
sigset_t oldset;
struct thread *thread;
+ /* Frequent special case: resignalling to self. The idea is
+ * that leave_region safepoint will acknowledge the signal, so
+ * there is no need to take locks, roll thread to safepoint
+ * etc. */
+ /* Kludge (on safepoint builds): At the moment, this isn't just
+ * an optimization; rather it masks the fact that
+ * gc_stop_the_world() grabs the all_threads mutex without
+ * releasing it, and since we're not using recursive pthread
+ * mutexes, the pthread_mutex_lock() around the all_threads loop
+ * would go wrong. Why are we running interruptions while
+ * stopping the world though? Test case is (:ASYNC-UNWIND
+ * :SPECIALS), especially with s/10/100/ in both loops. */
+ if (os_thread == pthread_self()) {
+ pthread_kill(os_thread, signal);
+ return 0;
+ }
+
/* pthread_kill is not async signal safe and we don't want to be
* interrupted while holding the lock. */
block_deferrable_signals(0, &oldset);
#include "genesis/thread.h"
#include "genesis/fdefn.h"
#include "interrupt.h"
+#include "validate.h" /* for BINDING_STACK_SIZE etc */
#define STATE_RUNNING MAKE_FIXNUM(1)
#define STATE_STOPPED MAKE_FIXNUM(2)
#define STATE_DEAD MAKE_FIXNUM(3)
+#if defined(LISP_FEATURE_SB_SAFEPOINT)
+# define STATE_SUSPENDED_BRIEFLY MAKE_FIXNUM(4)
+# define STATE_GC_BLOCKER MAKE_FIXNUM(5)
+# define STATE_PHASE1_BLOCKER MAKE_FIXNUM(5)
+# define STATE_PHASE2_BLOCKER MAKE_FIXNUM(6)
+# define STATE_INTERRUPT_BLOCKER MAKE_FIXNUM(7)
+#endif
#ifdef LISP_FEATURE_SB_THREAD
lispobj thread_state(struct thread *thread);
void set_thread_state(struct thread *thread, lispobj state);
void wait_for_thread_state_change(struct thread *thread, lispobj state);
+
+#if defined(LISP_FEATURE_SB_SAFEPOINT)
+enum threads_suspend_reason {
+ SUSPEND_REASON_NONE,
+ SUSPEND_REASON_GC,
+ SUSPEND_REASON_INTERRUPT,
+ SUSPEND_REASON_GCING
+};
+
+struct threads_suspend_info {
+ int suspend;
+ pthread_mutex_t world_lock;
+ pthread_mutex_t lock;
+ enum threads_suspend_reason reason;
+ int phase;
+ struct thread * gc_thread;
+ struct thread * interrupted_thread;
+ int blockers;
+ int used_gc_page;
+};
+
+struct suspend_phase {
+ int suspend;
+ enum threads_suspend_reason reason;
+ int phase;
+ struct suspend_phase *next;
+};
+
+extern struct threads_suspend_info suspend_info;
+
+struct gcing_safety {
+ lispobj csp_around_foreign_call;
+ lispobj* pc_around_foreign_call;
+};
+
+int handle_safepoint_violation(os_context_t *context, os_vm_address_t addr);
+void** os_get_csp(struct thread* th);
+void alloc_gc_page();
+void assert_on_stack(struct thread *th, void *esp);
+#endif /* defined(LISP_FEATURE_SB_SAFEPOINT) */
+
extern pthread_key_t lisp_thread;
#endif
lispobj dynamic_values[1]; /* actually more like 4000 or so */
};
+/* A helper structure for data local to a thread, which is not pointer-sized.
+ *
+ * Originally, all layouting of these fields was done manually in C code
+ * with pointer arithmetic. We let the C compiler figure it out now.
+ *
+ * (Why is this not part of `struct thread'? Because that structure is
+ * declared using genesis, and we would run into issues with fields that
+ * are of unknown length.)
+ */
+struct nonpointer_thread_data
+{
+#ifdef LISP_FEATURE_SB_THREAD
+ os_sem_t state_sem;
+ os_sem_t state_not_running_sem;
+ os_sem_t state_not_stopped_sem;
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+ /* For safepoint-based builds, together with thread's
+ * csp_around_foreign_call pointer target, thread_qrl(thread) makes
+ * `quickly revokable lock'. Unlike most mutexes, this one is
+ * normally locked; by convention, other thread may read and use the
+ * thread's FFI-CSP location _either_ when the former holds the
+ * lock(mutex) _or_ when page permissions for FFI-CSP location were
+ * set to read-only.
+ *
+ * Combined semantic of QRL is not the same as the semantic of mutex
+ * returned by this function; rather, the mutex, when released by the
+ * owning thread, provides an edge-triggered notification of QRL
+ * release, which is represented by writing non-null
+ * csp_around_foreign_call.
+ *
+ * When owner thread is `in Lisp' (i.e. a heap mutator), its FFI-CSP
+ * contains null, otherwise it points to the top of C stack that
+ * should be preserved by GENCGC. If another thread needs to wait for
+ * mutator state change with `in Lisp => in C' direction, it disables
+ * FFI-CSP overwrite using page protection, and takes the mutex
+ * returned by thread_qrl(). Page fault handler normally ends up in a
+ * routine releasing this mutex and waiting for some appropriate
+ * event to take it back.
+ *
+ * This way, each thread may modify its own FFI-CSP content freely
+ * without memory barriers (paying with exception handling overhead
+ * whenever a contention happens). */
+ pthread_mutex_t qrl_lock;
+# endif
+#else
+ /* An unused field follows, to ensure that the struct in non-empty
+ * for non-GCC compilers. */
+ int unused;
+#endif
+};
+
extern struct thread *all_threads;
extern int dynamic_values_bytes;
extern __thread struct thread *current_thread;
#endif
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+# define THREAD_CSP_PAGE_SIZE BACKEND_PAGE_BYTES
+#else
+# define THREAD_CSP_PAGE_SIZE 0
+#endif
+
+#define THREAD_STRUCT_SIZE (thread_control_stack_size + BINDING_STACK_SIZE + \
+ ALIEN_STACK_SIZE + \
+ sizeof(struct nonpointer_thread_data) + \
+ dynamic_values_bytes + \
+ 32 * SIGSTKSZ + \
+ THREAD_ALIGNMENT_BYTES + \
+ THREAD_CSP_PAGE_SIZE)
+
/* This is clearly per-arch and possibly even per-OS code, but we can't
* put it somewhere sensible like x86-linux-os.c because it needs too
* much stuff like struct thread and all_threads to be defined, which
extern kern_return_t mach_lisp_thread_destroy(struct thread *thread);
#endif
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+void thread_in_safety_transition(os_context_t *ctx);
+void thread_in_lisp_raised(os_context_t *ctx);
+void thread_pitstop(os_context_t *ctxptr);
+extern void thread_register_gc_trigger();
+
+#define thread_qrl(th) (&(th)->nonpointer_data->qrl_lock)
+
+static inline
+void push_gcing_safety(struct gcing_safety *into)
+{
+ struct thread* th = arch_os_get_current_thread();
+ asm volatile ("");
+ if ((into->csp_around_foreign_call =
+ *th->csp_around_foreign_call)) {
+ *th->csp_around_foreign_call = 0;
+ asm volatile ("");
+ into->pc_around_foreign_call = th->pc_around_foreign_call;
+ th->pc_around_foreign_call = 0;
+ asm volatile ("");
+ } else {
+ into->pc_around_foreign_call = 0;
+ }
+}
+
+static inline
+void pop_gcing_safety(struct gcing_safety *from)
+{
+ struct thread* th = arch_os_get_current_thread();
+ if (from->csp_around_foreign_call) {
+ asm volatile ("");
+ *th->csp_around_foreign_call = from->csp_around_foreign_call;
+ asm volatile ("");
+ th->pc_around_foreign_call = from->pc_around_foreign_call;
+ asm volatile ("");
+ }
+}
+
+/* Even with just -O1, gcc optimizes the jumps in this "loop" away
+ * entirely, giving the ability to define WITH-FOO-style macros. */
+#define RUN_BODY_ONCE(prefix, finally_do) \
+ int prefix##done = 0; \
+ for (; !prefix##done; finally_do, prefix##done = 1)
+
+#define WITH_GC_AT_SAFEPOINTS_ONLY_hygenic(var) \
+ struct gcing_safety var; \
+ push_gcing_safety(&var); \
+ RUN_BODY_ONCE(var, pop_gcing_safety(&var))
+
+#define WITH_GC_AT_SAFEPOINTS_ONLY() \
+ WITH_GC_AT_SAFEPOINTS_ONLY_hygenic(sbcl__gc_safety)
+
+#define WITH_STATE_SEM_hygenic(var, thread) \
+ os_sem_wait((thread)->state_sem, "thread_state"); \
+ RUN_BODY_ONCE(var, os_sem_post((thread)->state_sem, "thread_state"))
+
+#define WITH_STATE_SEM(thread) \
+ WITH_STATE_SEM_hygenic(sbcl__state_sem, thread)
+
+#endif
+
+extern boolean is_some_thread_local_addr(os_vm_address_t addr);
extern void create_initial_thread(lispobj);
+#ifdef LISP_FEATURE_SB_THREAD
+extern pthread_mutex_t all_threads_lock;
+#endif
+
#endif /* _INCLUDE_THREAD_H_ */
case trap_FunEndBreakpoint: /* not tested */
break;
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ case trap_GlobalSafepoint:
+ case trap_CspSafepoint:
+#endif
case trap_PendingInterrupt:
case trap_Halt:
case trap_SingleStepAround:
#define align_8byte 8
#define align_16byte 16
#define align_32byte 32
+#define align_page 32768
#else
#define align_4byte 2
#define align_8byte 3
#define align_16byte 4
+#define align_page 15
#endif
/*
ret
SIZE(GNAME(arch_scrub_control_stack))
\f
+ .globl GNAME(gc_safepoint_page)
+ .data
+ .align align_page
+GNAME(gc_safepoint_page):
+ .fill 32768
+\f
END()
case trap_FunEndBreakpoint: /* not tested */
break;
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ case trap_GlobalSafepoint:
+ case trap_CspSafepoint:
+#endif
case trap_PendingInterrupt:
case trap_Halt:
case trap_SingleStepAround:
#define align_4byte 4
#define align_8byte 8
#define align_16byte 16
+#define align_page 4096
#else
#define align_4byte 2
#define align_8byte 3
#define align_16byte 4
+#define align_page 12
#endif
/*
#define SIZE(name)
#endif
+/* Helper macros for access to thread-locals slots for both OS types:
+ * ------------------------------------------------------------------------
+ *
+ * Windows TEB block
+ * ================== __________
+ * | Win32 %FS base | ----> | | 0
+ * ================== | | 1
+ * z z
+ * TLS slots start here> |XXXXXXXX| e10 = TEB_STATIC_TLS_SLOTS_OFFSET
+ * |XXXXXXXX| e11
+ * z ... z
+ * |XXXXXXXX| e4e
+ * TLS ends here> ,- |XXXXXXXX| e4f = TEB_STATIC_TLS_SLOTS_OFFSET+63
+ * / z z
+ * | ----------
+ * |
+ * | big blob of SBCL-specific thread-local data
+ * | |----------------------------------------|
+ * | | CONTROL, BINDING, ALIEN STACK |
+ * | z z
+ * ================== | |----------------------------------------|
+ * | Linux %FS base | -->| | FFI stack pointer |
+ * ================== | | (extra page for mprotect) |
+ * \ |----------------------------------------|
+ * (union p_t_d) -----> \-> | struct thread { | dynamic_values[0] |
+ * . | ... | [1] |
+ * . z ... z ... z
+ * [tls data begins] | } | ... | <-
+ * [declared end of p_t_d] |----------------------------------------| . |
+ * . | ... | . |
+ * . | [TLS_SIZE-1] | <-|
+ * [tls data actually ends] |----------------------------------------| |
+ * . | ALTSTACK | |
+ * . |----------------------------------------| |
+ * . | struct nonpointer_thread_data { } | |
+ * . ------------------------------------------ |
+ * [blob actually ends] |
+ * /
+ * /
+ * /
+ * ______________________ /
+ * | struct symbol { | /
+ * z ... z /
+ * | fixnum tls_index; // fixnum value relative to union /
+ * | } | (< TLS_SIZE = 4096)
+ * ---------------------|
+ */
+#ifdef LISP_FEATURE_WIN32
+# define TEB_STATIC_TLS_SLOTS_OFFSET 0xE10
+# define TEB_SBCL_THREAD_BASE_OFFSET (TEB_STATIC_TLS_SLOTS_OFFSET+(63*4))
+# define SBCL_THREAD_BASE_EA %fs:TEB_SBCL_THREAD_BASE_OFFSET
+# define MAYBE_FS(addr) addr
+# define LoadTlSymbolValueAddress(symbol,reg) ; \
+ movl SBCL_THREAD_BASE_EA, reg ; \
+ addl (symbol+SYMBOL_TLS_INDEX_OFFSET), reg ;
+# define LoadCurrentThreadSlot(offset,reg); \
+ movl SBCL_THREAD_BASE_EA, reg ; \
+ movl offset(reg), reg ;
+#elif defined(LISP_FEATURE_LINUX) || defined(LISP_FEATURE_SUNOS)
+ /* see comment in arch_os_thread_init */
+# define SBCL_THREAD_BASE_EA %fs:THREAD_SELFPTR_OFFSET
+# define MAYBE_FS(addr) addr
+#else
+ /* perhaps there's an OS out there that actually supports %fs without
+ * jumping through hoops, so just in case, here a default definition: */
+# define SBCL_THREAD_BASE_EA $0
+# define MAYBE_FS(addr) %fs:addr
+#endif
+
+/* gas can't parse 4096LU; redefine */
+#if BACKEND_PAGE_BYTES == 4096
+# undef BACKEND_PAGE_BYTES
+# define BACKEND_PAGE_BYTES 4096
+#elif BACKEND_PAGE_BYTES == 32768
+# undef BACKEND_PAGE_BYTES
+# define BACKEND_PAGE_BYTES 32768
+#else
+# error BACKEND_PAGE_BYTES mismatch
+#endif
+
+/* OAOOM because we don't have the C headers here */
+#define THREAD_CSP_PAGE_SIZE BACKEND_PAGE_BYTES
+
+/* the CSP page sits right before the thread */
+#define THREAD_SAVED_CSP_OFFSET (-THREAD_CSP_PAGE_SIZE)
+
/*
* x86/darwin (as of MacOS X 10.4.5) doesn't reliably file signal
* handlers (SIGTRAP or Mach exception handlers) for 0xCC, wo we have
* FIXME & OAOOM: This duplicates call-out in src/compiler/x86/c-call.lisp,
* so if you tweak this, change that too!
*/
+/*
+ * Note on sections specific to LISP_FEATURE_SB_SAFEPOINT:
+ *
+ * The code below is essential to safepoint-based garbage collection,
+ * and several details need to be considered for correct implementation.
+ *
+ * The stack spilling approach:
+ * On SB-SAFEPOINT platforms, the CALL-OUT vop is defined to spill all
+ * live Lisp TNs to the stack to provide information for conservative
+ * GC cooperatively (avoiding the need to retrieve register values
+ * from POSIX signal contexts or Windows GetThreadContext()).
+ *
+ * Finding the SP at all:
+ * The main remaining value needed by GC is the stack pointer (SP) at
+ * the moment of entering the foreign function. For this purpose, a
+ * thread-local field for the SP is used. Two stores to that field
+ * are done for each C call, one to save the SP before calling out and
+ * and one to undo that store afterwards.
+ *
+ * Stores as synchronization points:
+ * These two stores delimit the C call: While the SP is set, our
+ * thread is known not to run Lisp code: During GC, memory protection
+ * ensures that no thread proceeds across stores.
+ *
+ * The return PC issue:
+ * (Note that CALL-OUT has, in principle, two versions: Inline
+ * assembly in the VOP -or- alternatively the out-of-line version you
+ * are currently reading. In reality, safepoint builds currently
+ * lack the inline code entirely.)
+ *
+ * Both versions need to take special care with the return PC:
+ * - In the inline version of the code (if it existed), the two stores
+ * would be done directly in the CALL-OUT vop. In that theoretical
+ * implementation, there is a time interval between return of the
+ * actual C call and a second SP store during which the return
+ * address might not be on the stack anymore.
+ * - In this out-of-line version, the stores are done during
+ * call_into_c's frame, but an equivalent problem arises: In order
+ * to present the stack of arguments as our foreign function expects
+ * them, call_into_c has to pop the Lisp return address into a
+ * register first; this register has to be preserved by GENCGC
+ * separately: our return address is not in the stack anymore.
+ * In both case, stack scanning alone is not sufficient to pin
+ * the return address, and we communicate it to GC explicitly
+ * in addition to the SP.
+ *
+ * Note on look-alike accessor macros with vastly different behaviour:
+ * THREAD_PC_AROUND_FOREIGN_CALL_OFFSET is an "ordinary" field of the
+ * struct thread, whereas THREAD_SAVED_CSP_OFFSET is a synchronization
+ * point on a potentially write-protected page.
+*/
+
.text
.align align_16byte,0x90
.globl GNAME(call_into_c)
popl %ebx
/* Setup the NPX for C */
+ /* The VOP says regarding CLD: "Clear out DF: Darwin, Windows,
+ * and Solaris at least require this, and it should not hurt
+ * others either." call_into_c didn't have it, but better safe than
+ * sorry. */
+ cld
fstp %st(0)
fstp %st(0)
fstp %st(0)
fstp %st(0)
fstp %st(0)
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ /* enter safe region: store SP and return PC */
+ movl SBCL_THREAD_BASE_EA,%edi
+ movl %esp,MAYBE_FS(THREAD_SAVED_CSP_OFFSET(%edi))
+ movl %ebx,MAYBE_FS(THREAD_PC_AROUND_FOREIGN_CALL_OFFSET(%edi))
+#endif
+
+ /* foreign call, preserving ESI, EDI, and EBX */
call *%eax # normal callout using Lisp stack
- movl %eax,%ecx # remember integer return value
+ /* return values now in eax/edx OR st(0) */
+
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ /* leave region: clear the SP! (Also unpin the return PC.) */
+ xorl %ecx,%ecx
+ movl %ecx,MAYBE_FS(THREAD_SAVED_CSP_OFFSET(%edi))
+ movl %ecx,MAYBE_FS(THREAD_PC_AROUND_FOREIGN_CALL_OFFSET(%edi))
+#endif
+
+ movl %eax,%ecx # remember integer return value
/* Check for a return FP value. */
fxam
/* We don't need to restore eax, because the result is in st(0). */
-/* Return. FIXME: It would be nice to restructure this to use RET. */
+/* Return. FIXME: It would be nice to restructure this to use RET. */
jmp *%ebx
SIZE(GNAME(call_into_c))
GNAME(call_into_lisp):
pushl %ebp # Save old frame pointer.
movl %esp,%ebp # Establish new frame.
+
Lstack:
/* Save the NPX state */
fwait # Catch any pending NPX exceptions.
* to fast_bzero_detect if OS supports SSE. */
.long GNAME(fast_bzero_base)
\f
+ .globl GNAME(gc_safepoint_page)
+ .data
+ .align align_page
+GNAME(gc_safepoint_page):
+ .fill BACKEND_PAGE_BYTES
+\f
.text
.align align_16byte,0x90
.globl GNAME(fast_bzero)
thread->tls_cookie=n;
pthread_mutex_unlock(&modify_ldt_lock);
+ /* now %fs:0 refers to the current thread. Useful! Less usefully,
+ * Linux/x86 isn't capable of reporting a faulting si_addr on a
+ * segment as defined above (whereas faults on the segment that %gs
+ * usually points are reported just fine...). As a special
+ * workaround, we store each thread structure's absolute address as
+ * as slot in itself, so that within the thread,
+ * movl %fs:SELFPTR_OFFSET,x
+ * stores the absolute address of %fs:0 into x.
+ */
+#ifdef LISP_FEATURE_SB_SAFEPOINT
+ thread->selfptr = thread;
+#endif
+
if(n<0) return 0;
#ifdef LISP_FEATURE_GCC_TLS
current_thread = thread;
thread->tls_cookie = sel;
pthread_setspecific(specials,thread);
+
+# ifdef LISP_FEATURE_SB_SAFEPOINT
+ thread->selfptr = thread;
+# endif
#endif
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
projects / sbcl.git / commitdiff