Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23481/src/code
Modified Files:
target-thread.lisp
Log Message:
0.9.4.1: thread allocation
* *CURRENT-THREAD* is now properly unbound (don't do bind_variable
without unbind), the workaround from 0.9.3.75 is removed
* also *CURRENT-THREAD* is temporarily bound to nil in the parent
thread to avoid the child inheriting the value from the parent
that could unnecessarily keep the parent thread object around
until the child exited
* free threads' interrupt_data when necessary
* made all_threads_lock a mutex instead of a spinlock to speed
start_the_world up
* minor cleanups
Index: target-thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-thread.lisp,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- target-thread.lisp 22 Aug 2005 10:19:44 -0000 1.43
+++ target-thread.lisp 26 Aug 2005 19:01:36 -0000 1.44
@@ -93,7 +93,7 @@
system-area-pointer
(lisp-fun-address unsigned-long))
- (define-alien-routine "block_deferrable_signals_and_inhibit_gc"
+ (define-alien-routine "block_blockable_signals"
void)
(define-alien-routine reap-dead-thread void
@@ -467,43 +467,47 @@
(setup-p nil)
(real-function (coerce function 'function))
(thread-sap
- (%create-thread
- (sb!kernel:get-lisp-obj-address
- (lambda ()
- ;; FIXME: use semaphores?
- (loop until setup-p)
- ;; in time we'll move some of the binding presently done in C
- ;; here too
- (let ((*current-thread* thread)
- (sb!kernel::*restart-clusters* nil)
- (sb!kernel::*handler-clusters* nil)
- (sb!kernel::*condition-restarts* nil)
- (sb!impl::*descriptor-handlers* nil)) ; serve-event
- ;; can't use handling-end-of-the-world, because that flushes
- ;; output streams, and we don't necessarily have any (or we
- ;; could be sharing them)
- (unwind-protect
- (catch 'sb!impl::toplevel-catcher
- (catch 'sb!impl::%end-of-the-world
- (with-simple-restart
- (terminate-thread
- (format nil "~~@<Terminate this thread (~A)~~@:>"
- *current-thread*))
- ;; now that most things have a chance to work
- ;; properly without messing up other threads, it's
- ;; time to enable signals
- (sb!unix::reset-signal-mask)
- (unwind-protect
- (funcall real-function)
- ;; we're going down, can't handle
- ;; interrupts sanely anymore
- (block-deferrable-signals-and-inhibit-gc)))))
- ;; and remove what can be the last references to the
- ;; thread object
- (handle-thread-exit thread)
- (setq *current-thread* nil)
- 0))
- (values))))))
+ ;; don't let the child inherit *CURRENT-THREAD* because that
+ ;; can prevent gc'ing this thread while the child runs
+ (let ((*current-thread* nil))
+ (%create-thread
+ (sb!kernel:get-lisp-obj-address
+ (lambda ()
+ ;; FIXME: use semaphores?
+ (loop until setup-p)
+ ;; in time we'll move some of the binding presently done in C
+ ;; here too
+ (let ((*current-thread* thread)
+ (sb!kernel::*restart-clusters* nil)
+ (sb!kernel::*handler-clusters* nil)
+ (sb!kernel::*condition-restarts* nil)
+ (sb!impl::*descriptor-handlers* nil)) ; serve-event
+ ;; can't use handling-end-of-the-world, because that flushes
+ ;; output streams, and we don't necessarily have any (or we
+ ;; could be sharing them)
+ (unwind-protect
+ (catch 'sb!impl::toplevel-catcher
+ (catch 'sb!impl::%end-of-the-world
+ (with-simple-restart
+ (terminate-thread
+ (format nil
+ "~~@<Terminate this thread (~A)~~@:>"
+ *current-thread*))
+ ;; now that most things have a chance to
+ ;; work properly without messing up other
+ ;; threads, it's time to enable signals
+ (sb!unix::reset-signal-mask)
+ (unwind-protect
+ (funcall real-function)
+ ;; we're going down, can't handle
+ ;; interrupts sanely anymore
+ (let ((sb!impl::*gc-inhibit* t))
+ (block-blockable-signals)
+ ;; and remove what can be the last
+ ;; reference to this thread
+ (handle-thread-exit thread))))))
+ 0))
+ (values)))))))
(when (sb!sys:sap= thread-sap (sb!sys:int-sap 0))
(error "Can't create a new thread"))
(setf (thread-%sap thread) thread-sap)
|