mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 15:36:41 -04:00
Revert "Remove non-pauseless-threadstart code"
This reverts commit 869f2acd62.
This commit is contained in:
Douglas Katzman
parent
fb92538e31
commit
15f2ccc551
|
|
@ -350,7 +350,7 @@ not supported."
|
|||
;; Dead threads aren't pruned from *ALL-THREADS* until the Pthread join.
|
||||
;; Do that now so that the forked process has only the main thread
|
||||
;; in *ALL-THREADS* and nothing in *JOINABLE-THREADS*.
|
||||
#+sb-thread (sb-thread::%dispose-thread-structs)
|
||||
#+pauseless-threadstart (sb-thread::join-pthread-joinables #'identity)
|
||||
(when (let ((avltree sb-thread::*all-threads*))
|
||||
(or (sb-thread::avlnode-left avltree)
|
||||
(sb-thread::avlnode-right avltree)))
|
||||
|
|
|
|||
|
|
@ -293,6 +293,7 @@ the alien callback for that function with the given alien type."
|
|||
#+sb-thread
|
||||
(defun enter-foreign-callback (index return arguments)
|
||||
(let ((thread (init-thread-local-storage (make-foreign-thread))))
|
||||
#+pauseless-threadstart
|
||||
(dx-let ((startup-info (vector nil ; trampoline is n/a
|
||||
nil ; cell in *STARTING-THREADS* is n/a
|
||||
#'sb-alien::enter-alien-callback
|
||||
|
|
@ -301,4 +302,7 @@ the alien callback for that function with the given alien type."
|
|||
(copy-primitive-thread-fields thread)
|
||||
(setf (thread-startup-info thread) startup-info)
|
||||
(update-all-threads (thread-primitive-thread thread) thread)
|
||||
(run))))
|
||||
(run))
|
||||
#-pauseless-threadstart
|
||||
(dx-let ((args (list index return arguments)))
|
||||
(run thread nil #'sb-alien::enter-alien-callback args))))
|
||||
|
|
|
|||
|
|
@ -361,12 +361,14 @@ Examples:
|
|||
;;; *ALL-THREADS*, then it may be blocked on the mutex. Can we terminate it?
|
||||
;;; - During save, acquire the *MAKE-THREAD-LOCK* to get a consistent view of
|
||||
;;; which threads are starting and running.
|
||||
;;; - new threads are added to *ALL-THREADS* before starting the posix thread.
|
||||
;;; We could look there.
|
||||
;;; - the :pauseless-threadstart code adds new threads to *ALL-THREADS*
|
||||
;;; before starting the posix thread. We could look there.
|
||||
;;; The important thing is to avoid thinking that there is a thread running
|
||||
;;; when it doesn't have a posix thread ID yet.
|
||||
;;; - Does acquiring the *MAKE-THREAD-LOCK* before assigning *FINALIZER-THREAD*
|
||||
;;; help anything? Perhaps.
|
||||
;;; But first I'd like to entirely eliminate the non-pauseless-threadstart code
|
||||
;;; so that we don't have to reason about two totally different solutions.
|
||||
(defun finalizer-thread-stop ()
|
||||
#+sb-thread
|
||||
(let ((thread *finalizer-thread*))
|
||||
|
|
|
|||
|
|
@ -308,7 +308,7 @@ sufficiently motivated to do lengthy fixes."
|
|||
;; user-supplied code that might not even work in later steps of deinit.
|
||||
;; See also the comment at definition of THREAD-EPHEMERAL-P.
|
||||
(finalizer-thread-stop)
|
||||
(sb-thread::%dispose-thread-structs)
|
||||
#+pauseless-threadstart (sb-thread::join-pthread-joinables #'identity)
|
||||
(let ((threads (sb-thread:list-all-threads)))
|
||||
;; Despite calling FINALIZER-THREAD-STOP, an unlucky thread schedule
|
||||
;; courtesy of the OS might notionally start the finalizer thread but not
|
||||
|
|
|
|||
|
|
@ -279,7 +279,7 @@ created and old ones may exit at any time."
|
|||
|
||||
(sb-ext:define-load-time-global *initial-thread* nil)
|
||||
|
||||
;;; *JOINABLE-THREADS* is a list of THREAD instances.
|
||||
;;; *JOINABLE-THREADS* is a list of THREAD instances used only if #+pauseless-threadstart
|
||||
;;; I had attempted to construct the list using the thread's memory to create cons
|
||||
;;; cells but that turned out to be flawed- the cells must be freshly heap-allocated,
|
||||
;;; because ATOMIC-POP is vulnerable to the A/B/A problem if cells are reused.
|
||||
|
|
@ -1385,7 +1385,7 @@ on this semaphore, then N of them is woken up."
|
|||
;; This AVER failed when I messed up deletion from *STARTING-THREADS*.
|
||||
;; That in turn caused a failure in GC because a fixnum is not a legal value
|
||||
;; for the startup info when observed by GC.
|
||||
(aver (not (memq thread *starting-threads*)))
|
||||
#+pauseless-threadstart (aver (not (memq thread *starting-threads*)))
|
||||
;; Stash the primitive thread SAP for reuse, but clobber the PRIMITIVE-THREAD
|
||||
;; slot which makes ALIVE-P return NIL.
|
||||
;; A minor TODO: can this lock acquire/release be moved to where we actually
|
||||
|
|
@ -1404,9 +1404,7 @@ on this semaphore, then N of them is woken up."
|
|||
(when *session*
|
||||
(%delete-thread-from-session thread))
|
||||
(cond
|
||||
;; If possible, logically remove from *ALL-THREADS* by flipping a bit.
|
||||
;; Foreign threads remove themselves. They don't have an exit semaphore,
|
||||
;; so that's how we know which is which.
|
||||
#+pauseless-threadstart ; If possible, logically remove from *ALL-THREADS*
|
||||
(sem
|
||||
;; Tree pruning is the responsibility of thread creators, not dying threads.
|
||||
;; Creators have to manipulate the tree anyway, and they need access to the old
|
||||
|
|
@ -1416,7 +1414,8 @@ on this semaphore, then N of them is woken up."
|
|||
(aver (eql old 1)))
|
||||
(sb-ext:atomic-push thread *joinable-threads*))
|
||||
(t ; otherwise, physically remove from *ALL-THREADS*
|
||||
;; The memory allocation/deallocation is handled in C.
|
||||
;; With #+pauseless-threadstart, this occurs for FOREIGN-THREAD because
|
||||
;; the memory allocation/deallocation is handled in C.
|
||||
;; I would like to combine the recycle bin for foreign and lisp threads though.
|
||||
(delete-from-all-threads (get-lisp-obj-address c-thread))))
|
||||
(when sem
|
||||
|
|
@ -1632,16 +1631,11 @@ session."
|
|||
|
||||
;;;; The beef
|
||||
|
||||
#+sb-thread
|
||||
#+pauseless-threadstart ; new way
|
||||
(progn
|
||||
;;; Return T if the thread was created
|
||||
(defun os-thread-create (thread thread-sap)
|
||||
(defun pthread-create (thread thread-sap)
|
||||
(aver (memq thread *starting-threads*))
|
||||
#+win32
|
||||
(/= 0 (alien-funcall (extern-alien "create_thread"
|
||||
(function unsigned system-area-pointer))
|
||||
thread-sap))
|
||||
#-win32
|
||||
(let ((attr (foreign-symbol-sap "new_lisp_thread_attr" t))
|
||||
(c-tramp
|
||||
(foreign-symbol-sap #+os-thread-stack "new_thread_trampoline_switch_stack"
|
||||
|
|
@ -1688,18 +1682,10 @@ session."
|
|||
(setf (thread-startup-info thread) 0)
|
||||
;; Clean up *ALL-THREADS*
|
||||
(delete-from-all-threads (sap-int c-thread))
|
||||
;; Release the OS and/or pthread resources
|
||||
#+win32
|
||||
(with-alien ((wait (function unsigned unsigned unsigned) :extern "WaitForSingleObject")
|
||||
(close (function int unsigned) :extern "CloseHandle"))
|
||||
(let ((os-thread (sap-ref-word c-thread
|
||||
(ash sb-vm::thread-os-thread-slot sb-vm::word-shift))))
|
||||
(alien-funcall wait os-thread #xffffffff)
|
||||
(alien-funcall close os-thread)))
|
||||
#-win32
|
||||
(with-alien ((join (function int unsigned unsigned) :extern "pthread_join"))
|
||||
(alien-funcall join (thread-os-thread thread) 0) ; no result pointer
|
||||
(setf (thread-os-thread thread) 0))
|
||||
;; Free the pthread resources
|
||||
(alien-funcall (extern-alien "pthread_join" (function int unsigned unsigned))
|
||||
(thread-os-thread thread) 0) ; no result pointer
|
||||
(setf (thread-os-thread thread) 0)
|
||||
(cond (dispose
|
||||
(free-thread-struct c-thread)
|
||||
nil)
|
||||
|
|
@ -1713,9 +1699,9 @@ session."
|
|||
;;; Heuristic decides when to stop trying to free. Passing in #'IDENTITY means that
|
||||
;;; all joinables should be processed. Passing in #'CDR or #'CDDR returns early if there
|
||||
;;; are not at least 1 or 2 threads respectively that could be joined.
|
||||
(export '%dispose-thread-structs)
|
||||
(defun %dispose-thread-structs (&key (retain 0))
|
||||
(loop (unless (nthcdr retain *joinable-threads*) (return))
|
||||
(export 'join-pthread-joinables)
|
||||
(defun join-pthread-joinables (heuristic)
|
||||
(loop (unless (funcall heuristic *joinable-threads*) (return))
|
||||
(let ((item (sb-ext:atomic-pop *joinable-threads*)))
|
||||
(if item (primitive-join item t) (return)))))
|
||||
|
||||
|
|
@ -1739,11 +1725,12 @@ session."
|
|||
;; If there is more than 1 more joinable, join all but 1.
|
||||
;; Two threads could both find > 1 thread to join, and both do
|
||||
;; a join, leaving 0 to join. That's ok.
|
||||
(%dispose-thread-structs :retain 1)
|
||||
(join-pthread-joinables #'cdr)
|
||||
(let ((thread-sap (alien-funcall (extern-alien "alloc_thread_struct"
|
||||
(function system-area-pointer
|
||||
system-area-pointer))
|
||||
(or reuse (int-sap 0)))))
|
||||
system-area-pointer unsigned))
|
||||
(or reuse (int-sap 0))
|
||||
sb-vm:no-tls-value-marker-widetag)))
|
||||
(when (and (not reuse) (/= (sap-int thread-sap) 0))
|
||||
;; these would have been done already if reusing the memory
|
||||
;; of a completed thread.
|
||||
|
|
@ -1783,14 +1770,26 @@ session."
|
|||
(sb-unix::unblock-deferrable-signals)))))
|
||||
;; notinline keeps array off the call stack by getting it out of the curent frame
|
||||
(declare (notinline unmask-signals))
|
||||
;; The semaphore works around some sort of race condition with sb-safepoint
|
||||
;; (which doesn't occur for linux + safepoint)
|
||||
#+win32 (awhen (thread-semaphore *current-thread*) (signal-semaphore it))
|
||||
;; Signals other than stop-for-GC are masked. The WITH/WITHOUT noise is
|
||||
;; pure cargo-cultism.
|
||||
(without-interrupts (with-local-interrupts ,@body))))))
|
||||
) ; end PROGN
|
||||
|
||||
#-pauseless-threadstart
|
||||
(defmacro thread-trampoline-defining-macro (&body body) ; OLD WAY
|
||||
`(defun run (thread setup-sem function arguments)
|
||||
(macrolet ((unmask-signals () '(sb-unix::unblock-deferrable-signals))
|
||||
(apply-real-function () '(apply function arguments)))
|
||||
(copy-primitive-thread-fields thread)
|
||||
(update-all-threads (thread-primitive-thread thread) thread)
|
||||
(sb-ext:atomic-push thread (session-new-enrollees *session*))
|
||||
(when setup-sem
|
||||
(signal-semaphore setup-sem)
|
||||
;; setup-sem was dx-allocated, set it to NIL so that the
|
||||
;; backtrace doesn't get confused
|
||||
(setf setup-sem nil))
|
||||
,@body)))
|
||||
|
||||
;;; All threads other than the initial thread start via this function.
|
||||
#+sb-thread
|
||||
(thread-trampoline-defining-macro
|
||||
|
|
@ -1889,7 +1888,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
|
|||
|
||||
;;; This is the faster variant of RUN-THREAD that does not wait for the new
|
||||
;;; thread to start executing before returning.
|
||||
#+sb-thread
|
||||
#+pauseless-threadstart
|
||||
(defun start-thread (thread function arguments)
|
||||
(let* ((trampoline
|
||||
(lambda (arg)
|
||||
|
|
@ -1920,11 +1919,6 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
|
|||
(run)))
|
||||
(saved-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
|
||||
:element-type 'bit :initial-element 0))
|
||||
;; Due to a probable bug in the safepoint state machine affecting win32
|
||||
;; (but not linux), we have to prevent this function from returning
|
||||
;; until the created thread adds itself to 'all_threads' (the C one).
|
||||
;; The exit semaphore can be used for this purpose.
|
||||
#+win32 (semaphore (thread-semaphore thread))
|
||||
(created))
|
||||
(declare (truly-dynamic-extent saved-sigmask))
|
||||
;; Block deferrables to ensure that the new thread is unaffected by signals
|
||||
|
|
@ -1972,7 +1966,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
|
|||
(setf (sap-ref-lispobj thread-sap (ash sb-vm::thread-lisp-thread-slot
|
||||
sb-vm:word-shift))
|
||||
thread)
|
||||
(setq created (os-thread-create thread thread-sap))
|
||||
(setq created (pthread-create thread thread-sap))
|
||||
(cond (created
|
||||
;; Still holding the MAKE-THREAD-LOCK, expose the thread in *all-threads*.
|
||||
;; In this manner, anyone who acquires the MAKE-THREAD-LOCK can be sure that
|
||||
|
|
@ -1989,9 +1983,48 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
|
|||
(free-thread-struct thread-sap)))
|
||||
(with-pinned-objects (saved-sigmask)
|
||||
(pthread-sigmask sb-unix::SIG_SETMASK saved-sigmask nil))
|
||||
#+win32 (when created (wait-on-semaphore semaphore))
|
||||
(if created thread (error "Could not create new OS thread."))))
|
||||
|
||||
#+(and sb-thread (not pauseless-threadstart))
|
||||
(defun start-thread (thread function arguments)
|
||||
(let* ((setup-sem (make-semaphore :name "Thread setup semaphore"))
|
||||
#+(or win32 darwin freebsd)
|
||||
(fp-modes (dpb 0 sb-vm:float-sticky-bits ;; clear accrued bits
|
||||
(sb-vm:floating-point-modes))))
|
||||
(declare (dynamic-extent setup-sem))
|
||||
(dx-flet ((start-routine ()
|
||||
;; Inherit parent thread's FP modes
|
||||
#+(or win32 darwin)
|
||||
(setf (sb-vm:floating-point-modes) fp-modes)
|
||||
;; As it is, this lambda must not cons until we are
|
||||
;; ready to run GC. Be careful.
|
||||
(init-thread-local-storage thread)
|
||||
;; I literally don't know what these WITH/WITHOUT wrappings are for,
|
||||
;; but tests fail when removed.
|
||||
;; It's the body of CALL-WITH-MUTEX omitting the grab and release.
|
||||
(without-interrupts
|
||||
(with-local-interrupts
|
||||
(run thread setup-sem function arguments)))))
|
||||
;; Holding mutexes or waiting on sempahores inside WITHOUT-GCING will lock up
|
||||
(aver (not *gc-inhibit*))
|
||||
;; Keep INITIAL-FUNCTION in the dynamic extent until the child
|
||||
;; thread is initialized properly. Wrap the whole thing in
|
||||
;; WITHOUT-INTERRUPTS (via WITH-SYSTEM-MUTEX) because we pass
|
||||
;; INITIAL-FUNCTION to another thread.
|
||||
;; (Does WITHOUT-INTERRUPTS really matter now that it's DXed?)
|
||||
(with-system-mutex (*make-thread-lock*)
|
||||
(with-alien ((create-thread (function unsigned unsigned unsigned)
|
||||
:extern "create_thread"))
|
||||
(with-pinned-objects (thread #'start-routine)
|
||||
(if (eql (alien-funcall create-thread
|
||||
(- (get-lisp-obj-address thread)
|
||||
sb-vm:instance-pointer-lowtag)
|
||||
(get-lisp-obj-address #'start-routine))
|
||||
0)
|
||||
(setq thread nil)
|
||||
(wait-on-semaphore setup-sem)))))))
|
||||
(or thread (error "Could not create a new thread.")))
|
||||
|
||||
(defun join-thread (thread &key (default nil defaultp) timeout)
|
||||
"Suspend current thread until THREAD exits. Return the result values
|
||||
of the thread function.
|
||||
|
|
@ -2025,9 +2058,9 @@ subject to change."
|
|||
|
||||
;; First, free up the pthread resources of any thread(s), not necessarily
|
||||
;; one we're tryinng to join.
|
||||
#+sb-thread
|
||||
#+pauseless-threadstart
|
||||
(when (cddr *joinable-threads*) ; if strictly > 2 are joinable,
|
||||
(without-interrupts (%dispose-thread-structs :retain 2)))
|
||||
(without-interrupts (join-pthread-joinables #'cddr)))
|
||||
;; No result semaphore indicates that there's nothing to wait for-
|
||||
;; the thread is either a foreign-thread, or finished running.
|
||||
(let* ((semaphore (thread-semaphore thread))
|
||||
|
|
|
|||
|
|
@ -246,6 +246,8 @@
|
|||
;; Win32 conditionally adds :sb-futex in grovel-features.sh
|
||||
(when (featurep '(:and :sb-thread :linux) target-feature-list)
|
||||
(pushnew :sb-futex target-feature-list))
|
||||
(when (featurep '(:and :sb-thread (:not :win32)) target-feature-list)
|
||||
(push :pauseless-threadstart target-feature-list))
|
||||
(when (featurep '(:and :sb-thread (:or :darwin :openbsd)) target-feature-list)
|
||||
(push :os-thread-stack target-feature-list))
|
||||
(when (and (member :x86 target-feature-list)
|
||||
|
|
@ -292,6 +294,8 @@
|
|||
(let ((feature-compatibility-tests
|
||||
'(("(and sb-thread (not gencgc))"
|
||||
":SB-THREAD requires :GENCGC")
|
||||
("(and pauseless-threadstart (not sb-thread))"
|
||||
":PAUSELESS-THREADSTART requires :SB-THREAD")
|
||||
("(and sb-safepoint (not sb-thread))" ":SB-SAFEPOINT requires :SB-THREAD")
|
||||
("(and sb-thruption (not sb-safepoint))" ":SB-THRUPTION requires :SB-SAFEPOINT")
|
||||
("(and unix sb-safepoint-strictly)"
|
||||
|
|
|
|||
|
|
@ -213,15 +213,15 @@ static int get_nonzero_tid()
|
|||
return tid;
|
||||
}
|
||||
|
||||
// Because creation is synchronized by *MAKE-THREAD-LOCK*
|
||||
// we need only a single 'attributes' object.
|
||||
// Only a single 'attributes' object is used if #+pauseless-threadstart.
|
||||
// This is ok because creation is synchronized by *MAKE-THREAD-LOCK*.
|
||||
#if defined LISP_FEATURE_SB_THREAD && !defined LISP_FEATURE_WIN32
|
||||
pthread_attr_t new_lisp_thread_attr;
|
||||
#define init_shared_attr_object() (pthread_attr_init(&new_lisp_thread_attr)==0)
|
||||
#else
|
||||
#define init_shared_attr_object() (1)
|
||||
#endif
|
||||
struct thread *alloc_thread_struct(void*);
|
||||
struct thread *alloc_thread_struct(void*,lispobj);
|
||||
|
||||
#ifdef LISP_FEATURE_WIN32
|
||||
#define ASSOCIATE_OS_THREAD(thread) \
|
||||
|
|
@ -260,7 +260,7 @@ void create_main_lisp_thread(lispobj function) {
|
|||
InitializeCriticalSection(&recyclebin_lock);
|
||||
InitializeCriticalSection(&in_gc_lock);
|
||||
#endif
|
||||
struct thread *th = alloc_thread_struct(0);
|
||||
struct thread *th = alloc_thread_struct(0, NO_TLS_VALUE_MARKER_WIDETAG);
|
||||
if (!th || arch_os_thread_init(th)==0 || !init_shared_attr_object())
|
||||
lose("can't create initial thread");
|
||||
#if defined LISP_FEATURE_SB_THREAD && !defined LISP_FEATURE_GCC_TLS && !defined LISP_FEATURE_WIN32
|
||||
|
|
@ -433,6 +433,7 @@ unregister_thread(struct thread *th,
|
|||
#endif
|
||||
|
||||
#if defined(LISP_FEATURE_WIN32)
|
||||
CloseHandle((HANDLE)th->os_thread);
|
||||
int i;
|
||||
for (i = 0; i<
|
||||
(int) (sizeof(th->private_events.events)/
|
||||
|
|
@ -467,6 +468,7 @@ void* new_thread_trampoline(void* arg)
|
|||
struct thread* th = arg;
|
||||
ASSOCIATE_OS_THREAD(th);
|
||||
|
||||
#ifdef LISP_FEATURE_PAUSELESS_THREADSTART
|
||||
#ifdef LISP_FEATURE_SB_SAFEPOINT
|
||||
init_thread_data scribble;
|
||||
// This "scribble" thing is really quite pointless because the original sigset_t
|
||||
|
|
@ -553,6 +555,22 @@ void* new_thread_trampoline(void* arg)
|
|||
// Close the GC region and unlink from all_threads
|
||||
unregister_thread(th, SCRIBBLE);
|
||||
|
||||
#else // !PAUSELESS_THREADSTART
|
||||
|
||||
th->os_kernel_tid = get_nonzero_tid();
|
||||
init_thread_data scribble;
|
||||
|
||||
lispobj function = th->no_tls_value_marker;
|
||||
th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
|
||||
init_new_thread(th, &scribble,
|
||||
GUARD_CONTROL_STACK|GUARD_BINDING_STACK|GUARD_ALIEN_STACK);
|
||||
funcall0(function);
|
||||
unregister_thread(th, &scribble);
|
||||
#ifdef LISP_FEATURE_WIN32
|
||||
free_thread_struct(th); // no recycling of 'struct thread'
|
||||
#endif
|
||||
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
@ -616,7 +634,8 @@ static void attach_os_thread(init_thread_data *scribble)
|
|||
block_deferrable_signals(&scribble->oldset);
|
||||
#endif
|
||||
void* recycled_memory = get_recyclebin_item();
|
||||
struct thread *th = alloc_thread_struct(recycled_memory);
|
||||
struct thread *th = alloc_thread_struct(recycled_memory,
|
||||
NO_TLS_VALUE_MARKER_WIDETAG);
|
||||
|
||||
#ifndef LISP_FEATURE_SB_SAFEPOINT
|
||||
/* new-lisp-thread-trampoline doesn't like when the GC signal is blocked */
|
||||
|
|
@ -681,9 +700,6 @@ static void detach_os_thread(init_thread_data *scribble)
|
|||
{
|
||||
struct thread *th = arch_os_get_current_thread();
|
||||
|
||||
#ifdef LISP_FEATURE_WIN32
|
||||
CloseHandle((HANDLE)th->os_thread);
|
||||
#endif
|
||||
unregister_thread(th, scribble);
|
||||
|
||||
/* We have to clear a STOP_FOR_GC signal if pending. Consider:
|
||||
|
|
@ -819,7 +835,7 @@ callback_wrapper_trampoline(
|
|||
*/
|
||||
|
||||
struct thread *
|
||||
alloc_thread_struct(void* spaces) {
|
||||
alloc_thread_struct(void* spaces, lispobj start_routine) {
|
||||
#if defined(LISP_FEATURE_SB_THREAD) || defined(LISP_FEATURE_WIN32)
|
||||
unsigned int i;
|
||||
#endif
|
||||
|
|
@ -866,7 +882,6 @@ alloc_thread_struct(void* spaces) {
|
|||
th->lisp_thread = 0; // force it to be always-thread-local, of course
|
||||
th->tls_size = dynamic_values_bytes;
|
||||
#endif
|
||||
|
||||
#if defined LISP_FEATURE_X86_64 && defined LISP_FEATURE_LINUX
|
||||
tls[THREAD_MSAN_XOR_CONSTANT_SLOT] = 0x500000000000;
|
||||
#endif
|
||||
|
|
@ -935,7 +950,6 @@ alloc_thread_struct(void* spaces) {
|
|||
// to the end of the safepoint page. The slot should probably be named
|
||||
// csp_around_foreign_call_ptr, but why even bother storing a constant at all?
|
||||
th->csp_around_foreign_call = (lispobj *)th - 1;
|
||||
*th->csp_around_foreign_call = 0;
|
||||
#endif
|
||||
|
||||
struct nonpointer_thread_data *nonpointer_data = nonpointer_data(th);
|
||||
|
|
@ -1017,6 +1031,7 @@ alloc_thread_struct(void* spaces) {
|
|||
# define INITIALIZE_TLS(sym,val) SYMBOL(sym)->value = val
|
||||
#endif
|
||||
#include "genesis/thread-init.inc"
|
||||
th->no_tls_value_marker = start_routine;
|
||||
|
||||
#if defined(LISP_FEATURE_WIN32)
|
||||
for (i = 0; i<sizeof(th->private_events.events)/
|
||||
|
|
@ -1030,20 +1045,54 @@ alloc_thread_struct(void* spaces) {
|
|||
}
|
||||
#ifdef LISP_FEATURE_SB_THREAD
|
||||
#ifdef LISP_FEATURE_WIN32
|
||||
uword_t create_thread(struct thread* th)
|
||||
/* Allocate a thread structure, call CreateThread(),
|
||||
* and return 1 for success, 0 for failure */
|
||||
uword_t create_thread(struct thread_instance* instance, lispobj start_routine)
|
||||
{
|
||||
struct thread *th;
|
||||
|
||||
/* Must defend against async unwinds. */
|
||||
if (read_TLS(INTERRUPTS_ENABLED, arch_os_get_current_thread()) != NIL)
|
||||
lose("create_thread is not safe when interrupts are enabled.");
|
||||
|
||||
/* Assuming that a fresh thread struct has no lisp objects in it,
|
||||
* linking it to all_threads can be left to the thread itself
|
||||
* without fear of gc lossage. 'start_routine' violates this
|
||||
* assumption and must stay pinned until the child starts up. */
|
||||
th = alloc_thread_struct(0, start_routine);
|
||||
if (!th) return 0;
|
||||
|
||||
/* The new thread inherits the restrictive signal mask set here,
|
||||
* and enables signals again when it is set up properly. */
|
||||
sigset_t oldset;
|
||||
|
||||
/* Blocking deferrable signals is enough, no need to block
|
||||
* SIG_STOP_FOR_GC because the child process is not linked onto
|
||||
* all_threads until it's ready. */
|
||||
block_deferrable_signals(&oldset);
|
||||
unsigned int tid;
|
||||
// Theoretically you should tell the new thread a signal mask to restore
|
||||
// after it finishes any uninterruptable setup code, but the way this worked
|
||||
// on windows is that we passed the mask of blocked signals in the parent
|
||||
// *after* blocking deferrables. It's immaterial what mask is passed
|
||||
// because the thread will unblock all deferrables,
|
||||
// and we don't really have posix signals anyway.
|
||||
struct nonpointer_thread_data *data = nonpointer_data(th);
|
||||
data->blocked_signal_set = deferrable_sigset;
|
||||
data->pending_signal_set = 0;
|
||||
// It's somewhat customary in the win32 API to start threads as suspended.
|
||||
th->os_thread =
|
||||
_beginthreadex(NULL, thread_control_stack_size, new_thread_trampoline, th,
|
||||
CREATE_SUSPENDED, &tid);
|
||||
boolean success = th->os_thread != 0;
|
||||
if (success) {
|
||||
instance->primitive_thread = (lispobj)th;
|
||||
th->os_kernel_tid = tid;
|
||||
ResumeThread((HANDLE)th->os_thread);
|
||||
} else {
|
||||
free_thread_struct(th);
|
||||
}
|
||||
thread_sigmask(SIG_SETMASK,&oldset,0);
|
||||
return success;
|
||||
}
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -51,6 +51,8 @@
|
|||
(let ((born 0)
|
||||
(running 0)
|
||||
(died 0))
|
||||
#-pauseless-thread-start (setq running (sb-thread::avl-count tree))
|
||||
#+pauseless-thread-start
|
||||
(sb-int:dx-flet ((mapfun (node)
|
||||
(ecase (sb-thread::thread-%visible (sb-thread::avlnode-data node))
|
||||
(0 (incf born)) ; "can't happen" ?
|
||||
|
|
|
|||
|
|
@ -1,23 +1,23 @@
|
|||
(in-package "SB-THREAD")
|
||||
|
||||
;;; Test out-of-memory (or something) that goes wrong in pthread_create
|
||||
#+sb-thread ; missing symbols otherwise
|
||||
#+pauseless-threadstart ; no SB-THREAD::PTHREAD-CREATE symbol if not
|
||||
(test-util:with-test (:name :failed-thread-creation)
|
||||
(let ((encapsulation
|
||||
(compile nil
|
||||
'(lambda (realfun thread sap)
|
||||
'(lambda (realfun thread stack-base)
|
||||
(if (string= (sb-thread:thread-name thread) "finalizer")
|
||||
(funcall realfun thread sap)
|
||||
(funcall realfun thread stack-base)
|
||||
nil))))
|
||||
(success))
|
||||
(assert (null sb-thread::*starting-threads*))
|
||||
(unwind-protect
|
||||
(progn (sb-int:encapsulate 'sb-thread::os-thread-create 'test encapsulation)
|
||||
(progn (sb-int:encapsulate 'sb-thread::pthread-create 'test encapsulation)
|
||||
(handler-case (sb-thread:make-thread #'list :name "thisfails")
|
||||
(error (e)
|
||||
(setq success (string= (write-to-string e)
|
||||
"Could not create new OS thread.")))))
|
||||
(sb-int:unencapsulate 'sb-thread::os-thread-create 'test))
|
||||
(sb-int:unencapsulate 'sb-thread::pthread-create 'test))
|
||||
(assert (equal sb-thread::*starting-threads* nil))
|
||||
(assert (equal (sb-thread::avltree-list sb-thread::*all-threads*)
|
||||
(list sb-thread::*initial-thread*)))))
|
||||
|
|
@ -125,8 +125,7 @@
|
|||
;;; In fact, assert something stronger: there are no young objects
|
||||
;;; between the current SP and end of stack.
|
||||
(test-util:with-test (:name :expected-gc-roots
|
||||
:skipped-on (or :interpreter (not :sb-thread))
|
||||
:fails-on :win32)
|
||||
:skipped-on (or :interpreter (not :pauseless-threadstart)))
|
||||
(let ((list (tryit :print nil)))
|
||||
;; should be not many things pointed to by the stack
|
||||
(assert (< (length list) #+x86 38 ; more junk, I don't know why
|
||||
|
|
@ -140,7 +139,7 @@
|
|||
|
||||
;; lp#1595699
|
||||
(test-util:with-test (:name :start-thread-in-without-gcing
|
||||
:skipped-on (not :sb-thread))
|
||||
:skipped-on (not :pauseless-threadstart))
|
||||
(assert (eq (sb-thread:join-thread
|
||||
(sb-sys:without-gcing
|
||||
(sb-thread:make-thread (lambda () 'hi))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue