X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;h=0bedaba118645875f718a10ce0c613aea90a0368;hb=ca267caa3bdb897a93a1e69ae7300ba3ba5d391f;hp=b2fe232c51e03a238193db6effd0c90c1a687e5d;hpb=d0511d2a94e7d2d346e2f4acc38ff84cd99a74b1;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index b2fe232..0bedaba 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -58,7 +58,7 @@
 (declaim (inline waitqueue-data-address mutex-value-address))
 
 (defstruct waitqueue
-  (name nil :type (or null simple-base-string))
+  (name nil :type (or null simple-string))
   (lock 0)
   (data nil))
 
@@ -265,20 +265,22 @@ time we reacquire LOCK and return to the caller."
 	      ;; in time we'll move some of the binding presently done in C
 	      ;; here too
 	      (let ((sb!kernel::*restart-clusters* nil)
+		    (sb!kernel::*handler-clusters* nil)
+		    (sb!kernel::*condition-restarts* nil)
 		    (sb!impl::*descriptor-handlers* nil) ; serve-event
 		    (sb!impl::*available-buffers* nil)) ;for fd-stream
 		;; 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)
 		(sb!sys:enable-interrupt sb!unix:sigint :ignore)
-		(sb!unix:unix-exit
-		 (catch 'sb!impl::%end-of-the-world 
-		   (with-simple-restart 
-		       (destroy-thread
-			(format nil "~~@<Destroy this thread (~A)~~@:>"
-				(current-thread-id)))
-		     (funcall real-function))
-		   0))))))))
+		(catch 'sb!impl::%end-of-the-world 
+		  (with-simple-restart 
+		      (destroy-thread
+		       (format nil "~~@<Destroy this thread (~A)~~@:>"
+			       (current-thread-id)))
+		    (funcall real-function))
+		  0))
+	      (values))))))
     (with-mutex ((session-lock *session*))
       (pushnew tid (session-threads *session*)))
     tid))
@@ -349,7 +351,8 @@ SB-EXT:QUIT - the usual cleanup forms will be evaluated"
   "Call FUNCTION once for each known thread, giving it the thread structure as argument"
   (let ((function (coerce function 'function)))
     (loop for thread = (alien-sap (extern-alien "all_threads" (* t)))
-	  then  (sb!sys:sap-ref-sap thread (* 4 sb!vm::thread-next-slot))
+	  then  (sb!sys:sap-ref-sap thread (* sb!vm:n-word-bytes
+					      sb!vm::thread-next-slot))
 	  until (sb!sys:sap= thread (sb!sys:int-sap 0))
 	  collect (funcall function thread))))
 
@@ -357,9 +360,11 @@ SB-EXT:QUIT - the usual cleanup forms will be evaluated"
   (let ((thread (alien-sap (extern-alien "all_threads" (* t)))))
     (loop 
      (when (sb!sys:sap= thread (sb!sys:int-sap 0)) (return nil))
-     (let ((pid (sb!sys:sap-ref-32 thread (* 4 sb!vm::thread-pid-slot))))
+     (let ((pid (sb!sys:sap-ref-32 thread (* sb!vm:n-word-bytes
+					     sb!vm::thread-pid-slot))))
        (when (= pid id) (return thread))
-       (setf thread (sb!sys:sap-ref-sap thread (* 4 sb!vm::thread-next-slot)))))))
+       (setf thread (sb!sys:sap-ref-sap thread (* sb!vm:n-word-bytes
+						  sb!vm::thread-next-slot)))))))
 
 ;;; internal use only.  If you think you need to use this, either you
 ;;; are an SBCL developer, are doing something that you should discuss
@@ -369,7 +374,8 @@ SB-EXT:QUIT - the usual cleanup forms will be evaluated"
   (let ((thread (thread-sap-from-id thread-id)))
     (when thread
       (let* ((index (sb!vm::symbol-tls-index symbol))
-	     (tl-val (sb!sys:sap-ref-32 thread (* 4 index))))
+	     (tl-val (sb!sys:sap-ref-word thread
+					  (* sb!vm:n-word-bytes index))))
 	(if (eql tl-val sb!vm::unbound-marker-widetag)
 	    (sb!vm::symbol-global-value symbol)
 	    (sb!kernel:make-lisp-obj tl-val))))))