From 402958f92506b9d3de852601b8c1ccb99b5ee558 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Sat, 3 Jun 2006 20:26:52 +0000 Subject: [PATCH] 0.9.13.22: Implement SB-THREAD mutexes and waitqueues using only pthread functionality on platforms that don't support Linux futexes. New platforms that can be compiled with SB-THREAD: * Solaris/x86 (seems to be as stable as SBCL threads on Linux) * OS X/x86 (some known stability problems, but doesn't fail on the thread regression tests every time) * FreeBSD/x86 (reportedly "flat-out broken", tends to cause kernel panics) While I (Juho) am doing the final merge from lutex-branch to HEAD, much of the work was done by Cyrus Harmon, based on an initial implementation by Nathan Froyd. The Solaris work was funded by Tellme Networks, Inc. --- NEWS | 2 + base-target-features.lisp-expr | 16 ++ make-config.sh | 11 +- package-data-list.lisp-expr | 2 + src/code/pred.lisp | 2 + src/code/target-thread.lisp | 195 ++++++++++++++----- src/code/thread.lisp | 5 +- src/cold/defun-load-or-cload-xcompiler.lisp | 5 +- src/compiler/generic/early-objdef.lisp | 5 +- src/compiler/generic/genesis.lisp | 2 + src/compiler/generic/late-type-vops.lisp | 4 + src/compiler/generic/objdef.lisp | 14 ++ src/compiler/generic/vm-fndb.lisp | 7 + src/runtime/Config.x86-darwin | 2 +- src/runtime/Config.x86-freebsd | 3 + src/runtime/Config.x86-sunos | 4 +- src/runtime/GNUmakefile | 4 +- src/runtime/bsd-os.c | 50 ++--- src/runtime/bsd-os.h | 23 +-- src/runtime/coreparse.c | 41 ++++ src/runtime/darwin-os.c | 2 + src/runtime/darwin-os.h | 32 ++++ src/runtime/gencgc.c | 267 ++++++++++++++++++++++++++- src/runtime/interrupt.c | 116 ++++++++++-- src/runtime/interrupt.h | 1 + src/runtime/linux-os.c | 8 +- src/runtime/linux-os.h | 2 +- src/runtime/pthread-lutex.c | 161 ++++++++++++++++ src/runtime/purify.c | 8 + src/runtime/save.c | 100 ++++++++++ src/runtime/sunos-os.c | 15 +- src/runtime/sunos-os.h | 5 + src/runtime/thread.c | 150 +++++++++++++-- src/runtime/thread.h | 15 +- src/runtime/x86-arch.c | 5 +- src/runtime/x86-arch.h | 16 ++ src/runtime/x86-assem.S | 55 ++++++ src/runtime/x86-bsd-os.c | 108 ++++++++++- src/runtime/x86-bsd-os.h | 10 + src/runtime/x86-darwin-os.c | 92 +++++++++ src/runtime/x86-darwin-os.h | 8 + src/runtime/x86-sunos-os.c | 103 ++++++++++- tests/threads.impure.lisp | 50 ++++- version.lisp-expr | 2 +- 44 files changed, 1558 insertions(+), 170 deletions(-) create mode 100644 src/runtime/darwin-os.h create mode 100644 src/runtime/pthread-lutex.c create mode 100644 src/runtime/x86-darwin-os.c diff --git a/NEWS b/NEWS index 4696a39..8a04c42 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,7 @@ ;;;; -*- coding: utf-8; -*- changes in sbcl-0.9.14 relative to sbcl-0.9.13: + * feature: thread support on Solaris/x86, and experimental thread support + on OS X/x86. * minor incompatible change: prevent the user from specializing the new-value argument to SB-MOP:SLOT-VALUE-USING-CLASS. It's somewhat counter to the intent of the protocol, I (CSR) think, and diff --git a/base-target-features.lisp-expr b/base-target-features.lisp-expr index 8867d5e..a351693 100644 --- a/base-target-features.lisp-expr +++ b/base-target-features.lisp-expr @@ -162,6 +162,22 @@ ;; so caveat executor. ; :sb-thread + ;; lutex support + ;; + ;; While on linux we are able to use futexes for our locking + ;; primitive, on other platforms we don't have this luxury. NJF's + ;; lutexes present a locking API similar to the futex-based API that + ;; allows for sb-thread support on x86 OS X, Solaris and + ;; FreeBSD. + ;; + ; :sb-lutex + + ;; On some operating systems the FS segment register (used for SBCL's + ;; thread local storage) is not reliably preserved in signal + ;; handlers, so we need to restore its value from the pthread thread + ;; local storage. + ; :restore-tls-segment-register-from-tls + ;; Support for detection of unportable code (when applied to the ;; COMMON-LISP package, or SBCL-internal pacakges) or bad-neighbourly ;; code (when applied to user-level packages), relating to material diff --git a/make-config.sh b/make-config.sh index c925c58..0e57022 100644 --- a/make-config.sh +++ b/make-config.sh @@ -184,6 +184,9 @@ case "$sbcl_os" in freebsd) printf ' :elf' >> $ltf printf ' :freebsd' >> $ltf + if [ $sbcl_arch = "x86" ]; then + printf ' :sb-lutex :restore-tls-segment-register-from-tls' >> $ltf + fi link_or_copy Config.$sbcl_arch-freebsd Config ;; openbsd) @@ -205,14 +208,20 @@ case "$sbcl_os" in darwin) printf ' :mach-o' >> $ltf printf ' :bsd' >> $ltf + printf ' :darwin' >> $ltf + if [ $sbcl_arch = "x86" ]; then + printf ' :sb-lutex :restore-fs-segment-register-from-tls' >> $ltf + fi link_or_copy $sbcl_arch-darwin-os.h target-arch-os.h link_or_copy bsd-os.h target-os.h - printf ' :darwin' >> $ltf link_or_copy Config.$sbcl_arch-darwin Config ;; sunos) printf ' :elf' >> $ltf printf ' :sunos' >> $ltf + if [ $sbcl_arch = "x86" ]; then + printf ' :sb-lutex' >> $ltf + fi link_or_copy Config.$sbcl_arch-sunos Config link_or_copy $sbcl_arch-sunos-os.h target-arch-os.h link_or_copy sunos-os.h target-os.h diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index e93a222..f9289ef 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -538,6 +538,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "INITIAL-FUN-CORE-ENTRY-TYPE-CODE" "*!LOAD-TIME-VALUES*" "LOAD-TYPE-PREDICATE" + #!+(and sb-thread sb-lutex) "LUTEX-TABLE-CORE-ENTRY-TYPE-CODE" "NEW-DIRECTORY-CORE-ENTRY-TYPE-CODE" "OPEN-FASL-OUTPUT" "PAGE-TABLE-CORE-ENTRY-TYPE-CODE" "READ-ONLY-CORE-SPACE-ID" @@ -2201,6 +2202,7 @@ structure representations" #!+long-float "LONG-STACK-SC-NUMBER" "LOWTAG-LIMIT" "LOWTAG-MASK" "LRA-SAVE-OFFSET" + #!+(and sb-thread sb-lutex) "LUTEX-WIDETAG" "MEMORY-USAGE" "MOST-POSITIVE-COST" "N-LOWTAG-BITS" "N-FIXNUM-TAG-BITS" diff --git a/src/code/pred.lisp b/src/code/pred.lisp index 0d34b48..76286c4 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -74,6 +74,8 @@ (def-type-predicate-wrapper integerp) (def-type-predicate-wrapper listp) (def-type-predicate-wrapper long-float-p) + #!+(and sb-thread sb-lutex) + (def-type-predicate-wrapper lutexp) (def-type-predicate-wrapper lra-p) (def-type-predicate-wrapper null) (def-type-predicate-wrapper numberp) diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 3edfb7d..c77d056 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -73,6 +73,7 @@ in future versions." (sb!vm::current-thread-offset-sap sb!vm::thread-os-thread-slot))) (defun init-initial-thread () + (/show0 "Entering INIT-INITIAL-THREAD") (let ((initial-thread (%make-thread :name "initial thread" :%alive-p t :os-thread (current-thread-sap-id)))) @@ -99,13 +100,60 @@ in future versions." (define-alien-routine "block_blockable_signals" void) - (declaim (inline futex-wait futex-wake)) - - (sb!alien:define-alien-routine "futex_wait" - int (word unsigned-long) (old-value unsigned-long)) - - (sb!alien:define-alien-routine "futex_wake" - int (word unsigned-long) (n unsigned-long))) + #!+sb-lutex + (progn + (declaim (inline %lutex-init %lutex-wait %lutex-wake + %lutex-lock %lutex-unlock)) + + (sb!alien:define-alien-routine ("lutex_init" %lutex-init) + int (lutex unsigned-long)) + + (sb!alien:define-alien-routine ("lutex_wait" %lutex-wait) + int (queue-lutex unsigned-long) (mutex-lutex unsigned-long)) + + (sb!alien:define-alien-routine ("lutex_wake" %lutex-wake) + int (lutex unsigned-long) (n int)) + + (sb!alien:define-alien-routine ("lutex_lock" %lutex-lock) + int (lutex unsigned-long)) + + (sb!alien:define-alien-routine ("lutex_unlock" %lutex-unlock) + int (lutex unsigned-long)) + + (sb!alien:define-alien-routine ("lutex_destroy" %lutex-destroy) + int (lutex unsigned-long)) + + ;; FIXME: Defining a whole bunch of alien-type machinery just for + ;; passing primitive lutex objects directly to foreign functions + ;; doesn't seem like fun right now. So instead we just manually + ;; pin the lutex, get its address, and let the callee untag it. + (defmacro with-lutex-address ((name lutex) &body body) + `(let ((,name ,lutex)) + (with-pinned-objects (,name) + (let ((,name (sb!kernel:get-lisp-obj-address ,name))) + ,@body)))) + + (defun make-lutex () + (/show0 "Entering MAKE-LUTEX") + ;; Suppress GC until the lutex has been properly registered with + ;; the GC. + (without-gcing + (let ((lutex (sb!vm::%make-lutex))) + (/show0 "LUTEX=..") + (/hexstr lutex) + (with-lutex-address (lutex lutex) + (%lutex-init lutex)) + lutex)))) + + #!-sb-lutex + (progn + (declaim (inline futex-wait futex-wake)) + + (sb!alien:define-alien-routine "futex_wait" + int (word unsigned-long) (old-value unsigned-long)) + + (sb!alien:define-alien-routine "futex_wake" + int (word unsigned-long) (n unsigned-long)))) ;;; used by debug-int.lisp to access interrupt contexts #!-(and sb-fluid sb-thread) (declaim (inline sb!vm::current-thread-offset-sap)) @@ -159,15 +207,15 @@ in future versions." (sb!kernel:fdocumentation 'mutex-value 'function) "The value of the mutex. NIL if the mutex is free. Setfable.") -#!+sb-thread -(declaim (inline mutex-value-address)) -#!+sb-thread -(defun mutex-value-address (mutex) - (declare (optimize (speed 3))) - (sb!ext:truly-the - sb!vm:word - (+ (sb!kernel:get-lisp-obj-address mutex) - (- (* 3 sb!vm:n-word-bytes) sb!vm:instance-pointer-lowtag)))) +#!+(and sb-thread (not sb-lutex)) +(progn + (declaim (inline mutex-value-address)) + (defun mutex-value-address (mutex) + (declare (optimize (speed 3))) + (sb!ext:truly-the + sb!vm:word + (+ (sb!kernel:get-lisp-obj-address mutex) + (- (* 3 sb!vm:n-word-bytes) sb!vm:instance-pointer-lowtag))))) (defun get-mutex (mutex &optional (new-value *current-thread*) (wait-p t)) #!+sb-doc @@ -175,6 +223,7 @@ in future versions." value if NIL. If WAIT-P is non-NIL and the mutex is in use, sleep until it is available" (declare (type mutex mutex) (optimize (speed 3))) + (/show0 "Entering GET-MUTEX") (unless new-value (setq new-value *current-thread*)) #!-sb-thread @@ -186,29 +235,44 @@ until it is available" (setf (mutex-value mutex) new-value) t) #!+sb-thread - (let (old) + (progn (when (eql new-value (mutex-value mutex)) (warn "recursive lock attempt ~S~%" mutex) (format *debug-io* "Thread: ~A~%" *current-thread*) (sb!debug:backtrace most-positive-fixnum *debug-io*) (force-output *debug-io*)) - (loop - (unless - (setf old (sb!vm::%instance-set-conditional mutex 2 nil new-value)) - (return t)) - (unless wait-p (return nil)) - (with-pinned-objects (mutex old) - (futex-wait (mutex-value-address mutex) - (sb!kernel:get-lisp-obj-address old)))))) + ;; FIXME: sb-lutex and (not wait-p) + #!+sb-lutex + (when wait-p + (with-lutex-address (lutex (mutex-lutex mutex)) + (%lutex-lock lutex)) + (setf (mutex-value mutex) new-value)) + #!-sb-lutex + (let (old) + (loop + (unless + (setf old (sb!vm::%instance-set-conditional mutex 2 nil + new-value)) + (return t)) + (unless wait-p (return nil)) + (with-pinned-objects (mutex old) + (futex-wait (mutex-value-address mutex) + (sb!kernel:get-lisp-obj-address old))))))) (defun release-mutex (mutex) #!+sb-doc "Release MUTEX by setting it to NIL. Wake up threads waiting for this mutex." (declare (type mutex mutex)) + (/show0 "Entering RELEASE-MUTEX") (setf (mutex-value mutex) nil) #!+sb-thread - (futex-wake (mutex-value-address mutex) 1)) + (progn + #!+sb-lutex + (with-lutex-address (lutex (mutex-lutex mutex)) + (%lutex-unlock lutex)) + #!-sb-lutex + (futex-wake (mutex-value-address mutex) 1))) ;;;; waitqueues/condition variables @@ -216,6 +280,9 @@ this mutex." #!+sb-doc "Waitqueue type." (name nil :type (or null simple-string)) + #!+(and sb-lutex sb-thread) + (lutex (make-lutex)) + #!-sb-lutex (data nil)) (defun make-waitqueue (&key name) @@ -227,15 +294,15 @@ this mutex." (setf (sb!kernel:fdocumentation 'waitqueue-name 'function) "The name of the waitqueue. Setfable.") -#!+sb-thread -(declaim (inline waitqueue-data-address)) -#!+sb-thread -(defun waitqueue-data-address (waitqueue) - (declare (optimize (speed 3))) - (sb!ext:truly-the - sb!vm:word - (+ (sb!kernel:get-lisp-obj-address waitqueue) - (- (* 3 sb!vm:n-word-bytes) sb!vm:instance-pointer-lowtag)))) +#!+(and sb-thread (not sb-lutex)) +(progn + (declaim (inline waitqueue-data-address)) + (defun waitqueue-data-address (waitqueue) + (declare (optimize (speed 3))) + (sb!ext:truly-the + sb!vm:word + (+ (sb!kernel:get-lisp-obj-address waitqueue) + (- (* 3 sb!vm:n-word-bytes) sb!vm:instance-pointer-lowtag))))) (defun condition-wait (queue mutex) #!+sb-doc @@ -247,6 +314,15 @@ time we reacquire MUTEX and return to the caller." #!-sb-thread (error "Not supported in unithread builds.") #!+sb-thread (let ((value (mutex-value mutex))) + (/show0 "CONDITION-WAITing") + #!+sb-lutex + (progn + (setf (mutex-value mutex) nil) + (with-lutex-address (queue-lutex-address (waitqueue-lutex queue)) + (with-lutex-address (mutex-lutex-address (mutex-lutex mutex)) + (%lutex-wait queue-lutex-address mutex-lutex-address))) + (setf (mutex-value mutex) value)) + #!-sb-lutex (unwind-protect (let ((me *current-thread*)) ;; XXX we should do something to ensure that the result of this setf @@ -274,21 +350,32 @@ time we reacquire MUTEX and return to the caller." #!-sb-thread (error "Not supported in unithread builds.") #!+sb-thread (declare (type (and fixnum (integer 1)) n)) + (/show0 "Entering CONDITION-NOTIFY") #!+sb-thread - (let ((me *current-thread*)) + (progn + #!+sb-lutex + (with-lutex-address (lutex (waitqueue-lutex queue)) + (%lutex-wake lutex n)) ;; no problem if >1 thread notifies during the comment in ;; condition-wait: as long as the value in queue-data isn't the ;; waiting thread's id, it matters not what it is ;; XXX we should do something to ensure that the result of this setf ;; is visible to all CPUs - (setf (waitqueue-data queue) me) - (with-pinned-objects (queue) - (futex-wake (waitqueue-data-address queue) n)))) + #!-sb-lutex + (let ((me *current-thread*)) + (progn + (setf (waitqueue-data queue) me) + (with-pinned-objects (queue) + (futex-wake (waitqueue-data-address queue) n)))))) (defun condition-broadcast (queue) #!+sb-doc "Notify all threads waiting on QUEUE." - (condition-notify queue most-positive-fixnum)) + (condition-notify queue + ;; On a 64-bit platform truncating M-P-F to an int results + ;; in -1, which wakes up only one thread. + (ldb (byte 29 0) + most-positive-fixnum))) ;;;; semaphores @@ -347,15 +434,17 @@ this semaphore, then N of them is woken up." `(locally ,@body) #!+sb-thread `(without-interrupts - (with-mutex ((session-lock ,session)) - ,@body))) + (with-mutex ((session-lock ,session)) + ,@body))) (defun new-session () (make-session :threads (list *current-thread*) :interactive-threads (list *current-thread*))) (defun init-job-control () - (setf *session* (new-session))) + (/show0 "Entering INIT-JOB-CONTROL") + (setf *session* (new-session)) + (/show0 "Exiting INIT-JOB-CONTROL")) (defun %delete-thread-from-session (thread session) (with-session-lock (session) @@ -379,6 +468,12 @@ this semaphore, then N of them is woken up." #!+sb-thread (defun handle-thread-exit (thread) (with-mutex (*all-threads-lock*) + (/show0 "HANDLING THREAD EXIT") + #!+sb-lutex + (when (thread-interruptions-lock thread) + (/show0 "FREEING MUTEX LUTEX") + (with-lutex-address (lutex (mutex-lutex (thread-interruptions-lock thread))) + (%lutex-destroy lutex))) (setq *all-threads* (delete thread *all-threads*))) (when *session* (%delete-thread-from-session thread *session*))) @@ -420,6 +515,7 @@ interactive." #!+sb-thread (let ((was-foreground t)) (loop + (/show0 "Looping in GET-FOREGROUND") (with-session-lock (*session*) (let ((int-t (session-interactive-threads *session*))) (when (eq (car int-t) *current-thread*) @@ -463,7 +559,7 @@ have the foreground next." (sb!unix::unix-setsid) (let* ((sb!impl::*stdin* (make-fd-stream in :input t :buffering :line - :dual-channel-p t)) + :dual-channel-p t)) (sb!impl::*stdout* (make-fd-stream out :output t :buffering :line :dual-channel-p t)) @@ -572,10 +668,13 @@ returns the thread exits." ;; Called from the signal handler. (defun run-interruption () (in-interruption () - (let ((interruption (with-interruptions-lock (*current-thread*) - (pop (thread-interruptions *current-thread*))))) - (with-interrupts - (funcall interruption))))) + (loop + (let ((interruption (with-interruptions-lock (*current-thread*) + (pop (thread-interruptions *current-thread*))))) + (if interruption + (with-interrupts + (funcall interruption)) + (return)))))) ;; The order of interrupt execution is peculiar. If thread A ;; interrupts thread B with I1, I2 and B for some reason receives I1 diff --git a/src/code/thread.lisp b/src/code/thread.lisp index 378fb4b..37e89ac 100644 --- a/src/code/thread.lisp +++ b/src/code/thread.lisp @@ -15,7 +15,9 @@ #!+sb-doc "Mutex type." (name nil :type (or null simple-string)) - (value nil)) + (value nil) + #!+(and sb-lutex sb-thread) + (lutex (make-lutex))) (def!struct spinlock #!+sb-doc @@ -34,6 +36,7 @@ and the mutex is in use, sleep until it is available" (with-unique-names (got mutex1) `(let ((,mutex1 ,mutex) ,got) + (/show0 "WITH-MUTEX") (unwind-protect ;; FIXME: async unwind in SETQ form (when (setq ,got (get-mutex ,mutex1 ,value ,wait-p)) diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp index b3e8e2e..66182a7 100644 --- a/src/cold/defun-load-or-cload-xcompiler.lisp +++ b/src/cold/defun-load-or-cload-xcompiler.lisp @@ -174,6 +174,9 @@ ;; (in the ordinary build procedure anyway) essentially everything ;; which is reachable at this point will remain reachable for the ;; entire run. - #+sbcl (sb-ext:purify) + ;; + ;; (Except that purifying actually slows down GENCGC). -- JES, 2006-05-30 + #+(and sbcl (not gencgc)) + (sb-ext:purify) (values)) diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index 46bd930..1ed5325 100644 --- a/src/compiler/generic/early-objdef.lisp +++ b/src/compiler/generic/early-objdef.lisp @@ -146,7 +146,10 @@ fdefn ; 01010110 no-tls-value-marker ; 01011010 - unused01 ; 01011110 + #!-sb-lutex + unused01 + #!+sb-lutex + lutex ; 01011110 unused02 ; 01100010 unused03 ; 01100110 unused04 ; 01101010 diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index f703646..d6a427d 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -2925,6 +2925,8 @@ initially undefined function references:~2%") (defconstant new-directory-core-entry-type-code 3861) (defconstant initial-fun-core-entry-type-code 3863) (defconstant page-table-core-entry-type-code 3880) +#!+sb-lutex +(defconstant lutex-table-core-entry-type-code 3887) (defconstant end-core-entry-type-code 3840) (declaim (ftype (function (sb!vm:word) sb!vm:word) write-word)) diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp index 74ff6ed..ae5cee1 100644 --- a/src/compiler/generic/late-type-vops.lisp +++ b/src/compiler/generic/late-type-vops.lisp @@ -106,6 +106,10 @@ (!define-type-vops fdefn-p nil nil nil (fdefn-widetag)) +#!+(and sb-thread sb-lutex) +(!define-type-vops lutexp nil nil nil + (lutex-widetag)) + (!define-type-vops funcallable-instance-p nil nil nil (funcallable-instance-header-widetag)) diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index 88dc800..2d80149 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -395,6 +395,20 @@ (real :c-type "double" :length #!-x86-64 2 #!+x86-64 1) (imag :c-type "double" :length #!-x86-64 2 #!+x86-64 1)) +#!+(and sb-thread sb-lutex) +(define-primitive-object (lutex + :lowtag other-pointer-lowtag + :widetag lutex-widetag + :alloc-trans %make-lutex) + (gen :c-type "long" :length 1) + (live :c-type "long" :length 1) + (next :c-type "struct lutex *" :length 1) + (prev :c-type "struct lutex *" :length 1) + (mutex :c-type "pthread_mutex_t *" + :length 1) + (condition-variable :c-type "pthread_cond_t *" + :length 1)) + ;;; this isn't actually a lisp object at all, it's a c structure that lives ;;; in c-land. However, we need sight of so many parts of it from Lisp that ;;; it makes sense to define it here anyway, so that the GENESIS machinery diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index f38a36a..9c9f5bf 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -216,6 +216,13 @@ (defknown make-value-cell (t) t (flushable movable)) +;;;; threading + +#!+(and sb-thread sb-lutex) +(progn + (defknown sb!vm::%make-lutex () sb!vm::lutex ()) + (defknown sb!vm::lutexp (t) boolean (foldable flushable))) + (defknown (dynamic-space-free-pointer binding-stack-pointer-sap control-stack-pointer-sap) () system-area-pointer diff --git a/src/runtime/Config.x86-darwin b/src/runtime/Config.x86-darwin index 5261009..1937452 100644 --- a/src/runtime/Config.x86-darwin +++ b/src/runtime/Config.x86-darwin @@ -10,7 +10,7 @@ # files for more information. CFLAGS = -g -Wall -O2 -fdollars-in-identifiers -OS_SRC = bsd-os.c x86-bsd-os.c darwin-os.c ppc-darwin-dlshim.c x86-darwin-langinfo.c +OS_SRC = bsd-os.c x86-bsd-os.c darwin-os.c x86-darwin-os.c ppc-darwin-dlshim.c x86-darwin-langinfo.c OS_LIBS = -lSystem -lc -ldl OS_OBJS = x86-darwin-rospace.o diff --git a/src/runtime/Config.x86-freebsd b/src/runtime/Config.x86-freebsd index 65d2be5..423dc5a 100644 --- a/src/runtime/Config.x86-freebsd +++ b/src/runtime/Config.x86-freebsd @@ -18,3 +18,6 @@ ASSEM_SRC += ldso-stubs.S # dlopen() etc., which in turn depend on dynamic linking of the # runtime. LINKFLAGS += -dynamic -export-dynamic +LINKFLAGS += $(shell if grep LISP_FEATURE_SB_THREAD genesis/config.h \ + > /dev/null 2>&1; \ + then echo "-lpthread"; fi) diff --git a/src/runtime/Config.x86-sunos b/src/runtime/Config.x86-sunos index 5a3ee1b..5093355 100644 --- a/src/runtime/Config.x86-sunos +++ b/src/runtime/Config.x86-sunos @@ -1,6 +1,6 @@ CC=gcc -CFLAGS = -O2 -Wall -DSVR4 -ASFLAGS = -Wall -DSVR4 +CFLAGS = -g3 -O2 -Wall -D__EXTENSIONS__ -D_POSIX_C_SOURCE=199506L -DSVR4 +ASFLAGS = -Wall LD = ld NM = nm -xgp GREP = ggrep diff --git a/src/runtime/GNUmakefile b/src/runtime/GNUmakefile index ac24da3..e74b5af 100644 --- a/src/runtime/GNUmakefile +++ b/src/runtime/GNUmakefile @@ -38,9 +38,9 @@ include Config COMMON_SRC = alloc.c backtrace.c breakpoint.c coreparse.c \ dynbind.c gc-common.c globals.c interr.c interrupt.c \ - monitor.c os-common.c parse.c print.c purify.c \ + monitor.c os-common.c parse.c print.c purify.c pthread-lutex.c \ regnames.c run-program.c runtime.c save.c search.c \ - thread.c time.c util.c validate.c vars.c wrap.c + thread.c time.c util.c validate.c vars.c wrap.c C_SRC = $(COMMON_SRC) ${ARCH_SRC} ${OS_SRC} ${GC_SRC} diff --git a/src/runtime/bsd-os.c b/src/runtime/bsd-os.c index f9cf70c..10c2fd4 100644 --- a/src/runtime/bsd-os.c +++ b/src/runtime/bsd-os.c @@ -23,6 +23,7 @@ #include #include #include +#include #include "sbcl.h" #include "./signal.h" #include "os.h" @@ -194,13 +195,14 @@ memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context) os_context_t *context = arch_os_get_context(&void_context); void *fault_addr = arch_get_bad_addr(signal, siginfo, context); -#if defined(MEMORY_FAULT_DEBUG) - fprintf(stderr, "Memory fault at: %p, PC: %x\n", fault_addr, *os_context_pc_addr(context)); -#if defined(ARCH_HAS_STACK_POINTER) - fprintf(stderr, "Stack pointer: %x\n", *os_context_sp_addr(context)); -#endif +#if defined(LISP_FEATURE_RESTORE_TLS_SEGMENT_REGISTER_FROM_CONTEXT) + FSHOW_SIGNAL((stderr, "/ TLS: restoring fs: %p in memory_fault_handler\n", + *CONTEXT_ADDR_FROM_STEM(fs))); + os_restore_tls_segment_register(context); #endif + FSHOW((stderr, "Memory fault at: %p, PC: %x\n", fault_addr, *os_context_pc_addr(context))); + if (!gencgc_handle_wp_violation(fault_addr)) if(!handle_guard_page_triggered(context,fault_addr)) { #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK @@ -227,10 +229,22 @@ os_install_interrupt_handlers(void) undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT2, memory_fault_handler); #endif + +#ifdef LISP_FEATURE_SB_THREAD + undoably_install_low_level_interrupt_handler(SIG_INTERRUPT_THREAD, + interrupt_thread_handler); + undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC, + sig_stop_for_gc_handler); +#ifdef SIG_RESUME_FROM_GC + undoably_install_low_level_interrupt_handler(SIG_RESUME_FROM_GC, + sig_stop_for_gc_handler); +#endif +#endif + SHOW("leaving os_install_interrupt_handlers()"); } -#else /* Currently Darwin only */ +#else /* Currently PPC/Darwin/Cheney only */ static void sigsegv_handler(int signal, siginfo_t *info, void* void_context) @@ -321,30 +335,6 @@ static void freebsd_init() #endif /* LISP_FEATURE_X86 */ } #endif /* __FreeBSD__ */ - -/* threads */ - -/* no threading in any *BSD variant on any CPU (yet? in sbcl-0.8.0 anyway) */ -#ifdef LISP_FEATURE_SB_THREAD -#error "Define threading support functions" -#else -int arch_os_thread_init(struct thread *thread) { - stack_t sigstack; -#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK - /* Signal handlers are run on the control stack, so if it is exhausted - * we had better use an alternate stack for whatever signal tells us - * we've exhausted it */ - sigstack.ss_sp=((void *) thread)+dynamic_values_bytes; - sigstack.ss_flags=0; - sigstack.ss_size = 32*SIGSTKSZ; - sigaltstack(&sigstack,0); -#endif - return 1; /* success */ -} -int arch_os_thread_cleanup(struct thread *thread) { - return 1; /* success */ -} -#endif #ifdef LISP_FEATURE_DARWIN /* defined in ppc-darwin-os.c instead */ diff --git a/src/runtime/bsd-os.h b/src/runtime/bsd-os.h index 4f72a66..b8a503f 100644 --- a/src/runtime/bsd-os.h +++ b/src/runtime/bsd-os.h @@ -65,6 +65,10 @@ typedef ucontext_t os_context_t; */ #define SIG_MEMORY_FAULT2 SIGBUS +#define SIG_INTERRUPT_THREAD (SIGINFO) +#define SIG_STOP_FOR_GC (SIGUSR1) +#define SIG_RESUME_FROM_GC (SIGUSR2) + #elif defined __OpenBSD__ typedef struct sigcontext os_context_t; @@ -77,24 +81,7 @@ typedef ucontext_t os_context_t; #define SIG_MEMORY_FAULT SIGSEGV #elif defined LISP_FEATURE_DARWIN - /* man pages claim that the third argument is a sigcontext struct, - but ucontext_t is defined, matches sigcontext where sensible, - offers better access to mcontext, and is of course the SUSv2- - mandated type of the third argument, so we use that instead. - If Apple is going to break ucontext_t out of spite, I'm going - to be cross with them ;) -- PRM */ - -#if defined(LISP_FEATURE_X86) -#include -#include -typedef struct ucontext os_context_t; -#else -#include -typedef ucontext_t os_context_t; -#endif - -#define SIG_MEMORY_FAULT SIGBUS - +#include "darwin-os.h" #else #error unsupported BSD variant #endif diff --git a/src/runtime/coreparse.c b/src/runtime/coreparse.c index 354040b..0ed38c5 100644 --- a/src/runtime/coreparse.c +++ b/src/runtime/coreparse.c @@ -35,6 +35,12 @@ #include "validate.h" #include "gc-internal.h" +/* lutex stuff */ +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) +#include "genesis/sap.h" +#endif + + unsigned char build_id[] = #include "../../output/build-id.tmp" ; @@ -285,6 +291,41 @@ load_core_file(char *file, os_vm_offset_t file_offset) initial_function = (lispobj)*ptr; break; +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + case LUTEX_TABLE_CORE_ENTRY_TYPE_CODE: + SHOW("LUTEX_TABLE_CORE_ENTRY_TYPE_CODE case"); + { + size_t n_lutexes = *ptr; + size_t fdoffset = (*(ptr + 1) + 1) * (os_vm_page_size); + size_t data_length = n_lutexes * sizeof(struct sap *); + struct lutex **lutexes_to_resurrect = malloc(data_length); + long bytes_read; + + lseek(fd, fdoffset + file_offset, SEEK_SET); + + FSHOW((stderr, "attempting to read %ld lutexes from core\n", n_lutexes)); + bytes_read = read(fd, lutexes_to_resurrect, data_length); + + /* XXX */ + if (bytes_read != data_length) { + lose("Could not read the lutex table"); + } + else { + int i; + + for (i=0; i #include #include "bsd-os.h" +#include char * os_get_runtime_executable_path() @@ -36,3 +37,4 @@ os_get_runtime_executable_path() return copied_string(path); } + diff --git a/src/runtime/darwin-os.h b/src/runtime/darwin-os.h new file mode 100644 index 0000000..b93fa2b --- /dev/null +++ b/src/runtime/darwin-os.h @@ -0,0 +1,32 @@ +#ifndef _DARWIN_OS_H +#define _DARWIN_OS_H + +/* this is meant to be included from bsd-os.h */ + +#include +#include + +/* man pages claim that the third argument is a sigcontext struct, + but ucontext_t is defined, matches sigcontext where sensible, + offers better access to mcontext, and is of course the SUSv2- + mandated type of the third argument, so we use that instead. + If Apple is going to break ucontext_t out of spite, I'm going + to be cross with them ;) -- PRM */ + +#if defined(LISP_FEATURE_X86) +#include +#include +typedef struct ucontext os_context_t; + +#else +#include +typedef ucontext_t os_context_t; +#endif + +#define SIG_MEMORY_FAULT SIGBUS + +#define SIG_INTERRUPT_THREAD (SIGINFO) +#define SIG_STOP_FOR_GC (SIGUSR1) +#define SIG_RESUME_FROM_GC (SIGUSR2) + +#endif /* _DARWIN_OS_H */ diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index a4f5f7c..66f181b 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -49,6 +49,10 @@ #include "genesis/instance.h" #include "genesis/layout.h" +#ifdef LUTEX_WIDETAG +#include "genesis/lutex.h" +#endif + /* forward declarations */ page_index_t gc_find_freeish_pages(long *restart_page_ptr, long nbytes, int unboxed); @@ -234,6 +238,14 @@ struct generation { * prevent a GC when a large number of new live objects have been * added, in which case a GC could be a waste of time */ double min_av_mem_age; + + /* A linked list of lutex structures in this generation, used for + * implementing lutex finalization. */ +#ifdef LUTEX_WIDETAG + struct lutex *lutexes; +#else + void *lutexes; +#endif }; /* an array of generation structures. There needs to be one more @@ -580,6 +592,7 @@ gc_alloc_new_region(long nbytes, int unboxed, struct alloc_region *alloc_region) page_index_t last_page; long bytes_found; page_index_t i; + int ret; /* FSHOW((stderr, @@ -591,7 +604,8 @@ gc_alloc_new_region(long nbytes, int unboxed, struct alloc_region *alloc_region) gc_assert((alloc_region->first_page == 0) && (alloc_region->last_page == -1) && (alloc_region->free_pointer == alloc_region->end_addr)); - thread_mutex_lock(&free_pages_lock); + ret = thread_mutex_lock(&free_pages_lock); + gc_assert(ret == 0); if (unboxed) { first_page = generations[gc_alloc_generation].alloc_unboxed_start_page; @@ -652,7 +666,8 @@ gc_alloc_new_region(long nbytes, int unboxed, struct alloc_region *alloc_region) /* do we only want to call this on special occasions? like for boxed_region? */ set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES)); } - thread_mutex_unlock(&free_pages_lock); + ret = thread_mutex_unlock(&free_pages_lock); + gc_assert(ret == 0); /* we can do this after releasing free_pages_lock */ if (gencgc_zero_check) { @@ -794,6 +809,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) long orig_first_page_bytes_used; long region_size; long byte_cnt; + int ret; first_page = alloc_region->first_page; @@ -804,7 +820,8 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) next_page = first_page+1; - thread_mutex_lock(&free_pages_lock); + ret = thread_mutex_lock(&free_pages_lock); + gc_assert(ret == 0); if (alloc_region->free_pointer != alloc_region->start_addr) { /* some bytes were allocated in the region */ orig_first_page_bytes_used = page_table[first_page].bytes_used; @@ -908,7 +925,9 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) page_table[next_page].allocated = FREE_PAGE_FLAG; next_page++; } - thread_mutex_unlock(&free_pages_lock); + ret = thread_mutex_unlock(&free_pages_lock); + gc_assert(ret == 0); + /* alloc_region is per-thread, we're ok to do this unlocked */ gc_set_region_empty(alloc_region); } @@ -926,8 +945,10 @@ gc_alloc_large(long nbytes, int unboxed, struct alloc_region *alloc_region) int more; long bytes_used; page_index_t next_page; + int ret; - thread_mutex_lock(&free_pages_lock); + ret = thread_mutex_lock(&free_pages_lock); + gc_assert(ret == 0); if (unboxed) { first_page = @@ -1027,7 +1048,8 @@ gc_alloc_large(long nbytes, int unboxed, struct alloc_region *alloc_region) last_free_page = last_page+1; set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES)); } - thread_mutex_unlock(&free_pages_lock); + ret = thread_mutex_unlock(&free_pages_lock); + gc_assert(ret == 0); #ifdef READ_PROTECT_FREE_PAGES os_protect(page_address(first_page), @@ -2042,6 +2064,179 @@ scav_vector(lispobj *where, lispobj object) /* + * Lutexes. Using the normal finalization machinery for finalizing + * lutexes is tricky, since the finalization depends on working lutexes. + * So we track the lutexes in the GC and finalize them manually. + */ + +#if defined(LUTEX_WIDETAG) + +/* + * Start tracking LUTEX in the GC, by adding it to the linked list of + * lutexes in the nursery generation. The caller is responsible for + * locking, and GCs must be inhibited until the registration is + * complete. + */ +void +gencgc_register_lutex (struct lutex *lutex) { + int index = find_page_index(lutex); + generation_index_t gen; + struct lutex *head; + + /* This lutex is in static space, so we don't need to worry about + * finalizing it. + */ + if (index == -1) + return; + + gen = page_table[index].gen; + + gc_assert(gen >= 0); + gc_assert(gen < NUM_GENERATIONS); + + head = generations[gen].lutexes; + + lutex->gen = gen; + lutex->next = head; + lutex->prev = NULL; + if (head) + head->prev = lutex; + generations[gen].lutexes = lutex; +} + +/* + * Stop tracking LUTEX in the GC by removing it from the appropriate + * linked lists. This will only be called during GC, so no locking is + * needed. + */ +void +gencgc_unregister_lutex (struct lutex *lutex) { + if (lutex->prev) { + lutex->prev->next = lutex->next; + } else { + generations[lutex->gen].lutexes = lutex->next; + } + + if (lutex->next) { + lutex->next->prev = lutex->prev; + } + + lutex->next = NULL; + lutex->prev = NULL; + lutex->gen = -1; +} + +/* + * Mark all lutexes in generation GEN as not live. + */ +static void +unmark_lutexes (generation_index_t gen) { + struct lutex *lutex = generations[gen].lutexes; + + while (lutex) { + lutex->live = 0; + lutex = lutex->next; + } +} + +/* + * Finalize all lutexes in generation GEN that have not been marked live. + */ +static void +reap_lutexes (generation_index_t gen) { + struct lutex *lutex = generations[gen].lutexes; + + while (lutex) { + struct lutex *next = lutex->next; + if (!lutex->live) { + lutex_destroy(lutex); + gencgc_unregister_lutex(lutex); + } + lutex = next; + } +} + +/* + * Mark LUTEX as live. + */ +static void +mark_lutex (lispobj tagged_lutex) { + struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); + + lutex->live = 1; +} + +/* + * Move all lutexes in generation FROM to generation TO. + */ +static void +move_lutexes (generation_index_t from, generation_index_t to) { + struct lutex *tail = generations[from].lutexes; + + /* Nothing to move */ + if (!tail) + return; + + /* Change the generation of the lutexes in FROM. */ + while (tail->next) { + tail->gen = to; + tail = tail->next; + } + tail->gen = to; + + /* Link the last lutex in the FROM list to the start of the TO list */ + tail->next = generations[to].lutexes; + + /* And vice versa */ + if (generations[to].lutexes) { + generations[to].lutexes->prev = tail; + } + + /* And update the generations structures to match this */ + generations[to].lutexes = generations[from].lutexes; + generations[from].lutexes = NULL; +} + +static long +scav_lutex(lispobj *where, lispobj object) +{ + mark_lutex((lispobj) where); + + return CEILING(sizeof(struct lutex)/sizeof(lispobj), 2); +} + +static lispobj +trans_lutex(lispobj object) +{ + struct lutex *lutex = native_pointer(object); + lispobj copied; + size_t words = CEILING(sizeof(struct lutex)/sizeof(lispobj), 2); + gc_assert(is_lisp_pointer(object)); + copied = copy_object(object, words); + + /* Update the links, since the lutex moved in memory. */ + if (lutex->next) { + lutex->next->prev = native_pointer(copied); + } + + if (lutex->prev) { + lutex->prev->next = native_pointer(copied); + } else { + generations[lutex->gen].lutexes = native_pointer(copied); + } + + return copied; +} + +static long +size_lutex(lispobj *where) +{ + return CEILING(sizeof(struct lutex)/sizeof(lispobj), 2); +} +#endif /* LUTEX_WIDETAG */ + + +/* * weak pointers */ @@ -2378,6 +2573,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) #endif case SAP_WIDETAG: case WEAK_POINTER_WIDETAG: +#ifdef LUTEX_WIDETAG + case LUTEX_WIDETAG: +#endif break; default: @@ -3481,6 +3679,9 @@ verify_space(lispobj *start, size_t words) #endif case SAP_WIDETAG: case WEAK_POINTER_WIDETAG: +#ifdef LUTEX_WIDETAG + case LUTEX_WIDETAG: +#endif count = (sizetab[widetag_of(*start)])(start); break; @@ -3817,6 +4018,31 @@ scavenge_interrupt_contexts(void) #endif +static void +preserve_context_registers (os_context_t *c) +{ + void **ptr; + /* On Darwin the signal context isn't a contiguous block of memory, + * so just preserve_pointering its contents won't be sufficient. + */ +#if defined(LISP_FEATURE_DARWIN) +#if defined LISP_FEATURE_X86 + preserve_pointer((void*)*os_context_register_addr(c,reg_EAX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_ECX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_EDX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_EBX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_ESI)); + preserve_pointer((void*)*os_context_register_addr(c,reg_EDI)); + preserve_pointer((void*)*os_context_pc_addr(c)); +#else + #error "preserve_context_registers needs to be tweaked for non-x86 Darwin" +#endif +#endif + for(ptr = (void **)(c+1); ptr>=(void **)c; ptr--) { + preserve_pointer(*ptr); + } +} + /* Garbage collect a generation. If raise is 0 then the remains of the * generation are not raised to the next generation. */ static void @@ -3834,6 +4060,10 @@ garbage_collect_generation(generation_index_t generation, int raise) /* Initialize the weak pointer list. */ weak_pointers = NULL; +#ifdef LUTEX_WIDETAG + unmark_lutexes(generation); +#endif + /* When a generation is not being raised it is transported to a * temporary generation (NUM_GENERATIONS), and lowered when * done. Set up this new generation. There should be no pages @@ -3906,9 +4136,7 @@ garbage_collect_generation(generation_index_t generation, int raise) if (esp1>=(void **)th->control_stack_start && esp1<(void **)th->control_stack_end) { if(esp1=(void **)c; ptr--) { - preserve_pointer(*ptr); - } + preserve_context_registers(c); } } } @@ -4079,6 +4307,12 @@ garbage_collect_generation(generation_index_t generation, int raise) generations[generation].num_gc = 0; else ++generations[generation].num_gc; + +#ifdef LUTEX_WIDETAG + reap_lutexes(generation); + if (raise) + move_lutexes(generation, generation+1); +#endif } /* Update last_free_page, then SymbolValue(ALLOCATION_POINTER). */ @@ -4345,6 +4579,7 @@ gc_free_heap(void) generations[page].gc_trigger = 2000000; generations[page].num_gc = 0; generations[page].cum_sum_bytes_allocated = 0; + generations[page].lutexes = NULL; } if (gencgc_verbose > 1) @@ -4377,6 +4612,12 @@ gc_init(void) scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer; transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large; +#ifdef LUTEX_WIDETAG + scavtab[LUTEX_WIDETAG] = scav_lutex; + transother[LUTEX_WIDETAG] = trans_lutex; + sizetab[LUTEX_WIDETAG] = size_lutex; +#endif + heap_base = (void*)DYNAMIC_SPACE_START; /* Initialize each page structure. */ @@ -4407,6 +4648,7 @@ gc_init(void) generations[i].bytes_consed_between_gc = 2000000; generations[i].trigger_age = 1; generations[i].min_av_mem_age = 0.75; + generations[i].lutexes = NULL; } /* Initialize gc_alloc. */ @@ -4450,6 +4692,13 @@ gencgc_pickup_dynamic(void) page++; } while ((long)page_address(page) < alloc_ptr); +#ifdef LUTEX_WIDETAG + /* Lutexes have been registered in generation 0 by coreparse, and + * need to be moved to the right one manually. + */ + move_lutexes(0, PSEUDO_STATIC_GENERATION); +#endif + last_free_page = page; generations[gen].bytes_allocated = PAGE_BYTES*page; diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index d8afd25..45cd2fd 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -95,8 +95,12 @@ sigaddset_deferrable(sigset_t *s) sigaddset(s, SIGVTALRM); sigaddset(s, SIGPROF); sigaddset(s, SIGWINCH); + +#if !((defined(LISP_FEATURE_DARWIN) || defined(LISP_FEATURE_FREEBSD)) && defined(LISP_FEATURE_SB_THREAD)) sigaddset(s, SIGUSR1); sigaddset(s, SIGUSR2); +#endif + #ifdef LISP_FEATURE_SB_THREAD sigaddset(s, SIG_INTERRUPT_THREAD); #endif @@ -107,6 +111,9 @@ sigaddset_blockable(sigset_t *s) { sigaddset_deferrable(s); #ifdef LISP_FEATURE_SB_THREAD +#ifdef SIG_RESUME_FROM_GC + sigaddset(s, SIG_RESUME_FROM_GC); +#endif sigaddset(s, SIG_STOP_FOR_GC); #endif } @@ -362,17 +369,14 @@ interrupt_handle_pending(os_context_t *context) struct thread *thread; struct interrupt_data *data; - check_blockables_blocked_or_lose(); + FSHOW_SIGNAL((stderr, "/entering interrupt_handle_pending\n")); + check_blockables_blocked_or_lose(); thread=arch_os_get_current_thread(); data=thread->interrupt_data; /* If pseudo_atomic_interrupted is set then the interrupt is going * to be handled now, ergo it's safe to clear it. */ - - /* CLH: 20060220 FIXME This sould probably be arch_clear_p_a_i but - * the behavior of arch_clear_p_a_i and clear_p_a_i are slightly - * different on PPC. */ arch_clear_pseudo_atomic_interrupted(context); if (SymbolValue(GC_INHIBIT,thread)==NIL) { @@ -457,18 +461,23 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) boolean were_in_lisp; #endif union interrupt_handler handler; + check_blockables_blocked_or_lose(); + + #ifndef LISP_FEATURE_WIN32 if (sigismember(&deferrable_sigset,signal)) check_interrupts_enabled_or_lose(context); #endif -#ifdef LISP_FEATURE_LINUX +#if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT) /* Under Linux on some architectures, we appear to have to restore the FPU control word from the context, as after the signal is delivered we appear to have a null FPU control word. */ os_restore_fp_control(context); #endif + + handler = interrupt_handlers[signal]; if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) { @@ -519,6 +528,9 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) sigset_t unblock; sigemptyset(&unblock); sigaddset(&unblock, SIG_STOP_FOR_GC); +#ifdef SIG_RESUME_FROM_GC + sigaddset(&unblock, SIG_RESUME_FROM_GC); +#endif thread_sigmask(SIG_UNBLOCK, &unblock, 0); } #endif @@ -565,6 +577,8 @@ run_deferred_handler(struct interrupt_data *data, void *v_context) { * pending handler before calling it. Trust the handler to finish * with the siginfo before enabling interrupts. */ void (*pending_handler) (int, siginfo_t*, void*)=data->pending_handler; + os_context_t *context = arch_os_get_context(&v_context); + data->pending_handler=0; (*pending_handler)(data->pending_signal,&(data->pending_info), v_context); } @@ -636,6 +650,9 @@ store_signal_data_for_later (struct interrupt_data *data, void *handler, data->pending_signal = signal; if(info) memcpy(&(data->pending_info), info, sizeof(siginfo_t)); + + FSHOW_SIGNAL((stderr, "/store_signal_data_for_later: signal: %d\n", signal)); + if(context) { /* the signal mask in the context (from before we were * interrupted) is copied to be restored when @@ -651,11 +668,17 @@ static void maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context) { os_context_t *context = arch_os_get_context(&void_context); - struct thread *thread=arch_os_get_current_thread(); - struct interrupt_data *data=thread->interrupt_data; -#ifdef LISP_FEATURE_LINUX + + struct thread *thread; + struct interrupt_data *data; + + thread=arch_os_get_current_thread(); + data=thread->interrupt_data; + +#if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT) os_restore_fp_control(context); #endif + if(maybe_defer_handler(interrupt_handle_now,data,signal,info,context)) return; interrupt_handle_now(signal, info, context); @@ -670,9 +693,10 @@ low_level_interrupt_handle_now(int signal, siginfo_t *info, void *void_context) { os_context_t *context = (os_context_t*)void_context; -#ifdef LISP_FEATURE_LINUX +#if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT) os_restore_fp_control(context); #endif + check_blockables_blocked_or_lose(); check_interrupts_enabled_or_lose(context); interrupt_low_level_handlers[signal](signal, info, void_context); @@ -686,11 +710,16 @@ static void low_level_maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context) { os_context_t *context = arch_os_get_context(&void_context); - struct thread *thread=arch_os_get_current_thread(); - struct interrupt_data *data=thread->interrupt_data; -#ifdef LISP_FEATURE_LINUX + struct thread *thread; + struct interrupt_data *data; + + thread=arch_os_get_current_thread(); + data=thread->interrupt_data; + +#if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT) os_restore_fp_control(context); #endif + if(maybe_defer_handler(low_level_interrupt_handle_now,data, signal,info,context)) return; @@ -708,10 +737,11 @@ void sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context) { os_context_t *context = arch_os_get_context(&void_context); + struct thread *thread=arch_os_get_current_thread(); sigset_t ss; - if ((arch_pseudo_atomic_atomic(context) || + if ((arch_pseudo_atomic_atomic(context) || SymbolValue(GC_INHIBIT,thread) != NIL)) { SetSymbolValue(STOP_FOR_GC_PENDING,T,thread); if (SymbolValue(GC_INHIBIT,thread) == NIL) @@ -732,10 +762,24 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context) thread->state=STATE_SUSPENDED; FSHOW_SIGNAL((stderr,"thread=%lu suspended\n",thread->os_thread)); +#if defined(SIG_RESUME_FROM_GC) + sigemptyset(&ss); sigaddset(&ss,SIG_RESUME_FROM_GC); +#else sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC); +#endif + /* It is possible to get SIGCONT (and probably other * non-blockable signals) here. */ +#ifdef SIG_RESUME_FROM_GC + { + int sigret; + do { sigwait(&ss, &sigret); } + while (sigret != SIG_RESUME_FROM_GC); + } +#else while (sigwaitinfo(&ss,0) != SIG_STOP_FOR_GC); +#endif + FSHOW_SIGNAL((stderr,"thread=%lu resumed\n",thread->os_thread)); if(thread->state!=STATE_RUNNING) { lose("sig_stop_for_gc_handler: wrong thread state on wakeup: %ld\n", @@ -787,6 +831,7 @@ extern int *context_eflags_addr(os_context_t *context); 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) { @@ -832,6 +877,35 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function) u32 *sp=(u32 *)*os_context_register_addr(context,reg_ESP); +#if defined(LISP_FEATURE_DARWIN) + u32 *register_save_area = (u32 *)os_validate(0, 0x40); + + FSHOW_SIGNAL((stderr, "/arrange_return_to_lisp_function: preparing to go to function %x, sp: %x\n", function, sp)); + FSHOW_SIGNAL((stderr, "/arrange_return_to_lisp_function: context: %x, &context %x\n", context, &context)); + + /* 1. os_validate (malloc/mmap) register_save_block + * 2. copy register state into register_save_block + * 3. put a pointer to register_save_block in a register in the context + * 4. set the context's EIP to point to a trampoline which: + * a. builds the fake stack frame from the block + * b. frees the block + * c. calls the function + */ + + *register_save_area = *os_context_pc_addr(context); + *(register_save_area + 1) = function; + *(register_save_area + 2) = *os_context_register_addr(context,reg_EDI); + *(register_save_area + 3) = *os_context_register_addr(context,reg_ESI); + *(register_save_area + 4) = *os_context_register_addr(context,reg_EDX); + *(register_save_area + 5) = *os_context_register_addr(context,reg_ECX); + *(register_save_area + 6) = *os_context_register_addr(context,reg_EBX); + *(register_save_area + 7) = *os_context_register_addr(context,reg_EAX); + *(register_save_area + 8) = *context_eflags_addr(context); + + *os_context_pc_addr(context) = call_into_lisp_tramp; + *os_context_register_addr(context,reg_ECX) = register_save_area; +#else + /* return address for call_into_lisp: */ *(sp-15) = (u32)post_signal_tramp; *(sp-14) = function; /* args for call_into_lisp : function*/ @@ -853,6 +927,8 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function) *(sp-2)=*os_context_register_addr(context,reg_EBP); *(sp-1)=*os_context_pc_addr(context); +#endif + #elif defined(LISP_FEATURE_X86_64) u64 *sp=(u64 *)*os_context_register_addr(context,reg_RSP); /* return address for call_into_lisp: */ @@ -887,6 +963,8 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function) #endif #ifdef LISP_FEATURE_X86 + +#if !defined(LISP_FEATURE_DARWIN) *os_context_pc_addr(context) = (os_context_register_t)call_into_lisp; *os_context_register_addr(context,reg_ECX) = 0; *os_context_register_addr(context,reg_EBP) = (os_context_register_t)(sp-2); @@ -895,7 +973,9 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function) (os_context_register_t)(sp-15); #else *os_context_register_addr(context,reg_ESP) = (os_context_register_t)(sp-15); -#endif +#endif /* __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_register_addr(context,reg_RCX) = 0; @@ -929,6 +1009,7 @@ void interrupt_thread_handler(int num, siginfo_t *info, void *v_context) { os_context_t *context = (os_context_t*)arch_os_get_context(&v_context); + /* let the handler enable interrupts again when it sees fit */ sigaddset_deferrable(os_context_sigmask_addr(context)); arrange_return_to_lisp_function(context, SymbolFunction(RUN_INTERRUPTION)); @@ -1065,6 +1146,9 @@ interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context) else { sigset_t new; sigemptyset(&new); +#if defined(SIG_RESUME_FROM_GC) + sigaddset(&new,SIG_RESUME_FROM_GC); +#endif sigaddset(&new,SIG_STOP_FOR_GC); thread_sigmask(SIG_UNBLOCK,&new,0); } @@ -1151,6 +1235,7 @@ static void unblock_me_trampoline(int signal, siginfo_t *info, void *void_context) { sigset_t unblock; + sigemptyset(&unblock); sigaddset(&unblock, signal); thread_sigmask(SIG_UNBLOCK, &unblock, 0); @@ -1161,6 +1246,7 @@ static void low_level_unblock_me_trampoline(int signal, siginfo_t *info, void *void_context) { sigset_t unblock; + sigemptyset(&unblock); sigaddset(&unblock, signal); thread_sigmask(SIG_UNBLOCK, &unblock, 0); diff --git a/src/runtime/interrupt.h b/src/runtime/interrupt.h index 651668c..7213c0c 100644 --- a/src/runtime/interrupt.h +++ b/src/runtime/interrupt.h @@ -13,6 +13,7 @@ #define _INCLUDE_INTERRUPT_H_ #include +#include /* * This is a workaround for some slightly silly Linux/GNU Libc diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c index 026923a..faf1a47 100644 --- a/src/runtime/linux-os.c +++ b/src/runtime/linux-os.c @@ -34,6 +34,7 @@ #include "runtime.h" #include "genesis/static-symbols.h" #include "genesis/fdefn.h" + #include #include #include @@ -61,7 +62,7 @@ int personality (unsigned long); size_t os_vm_page_size; -#ifdef LISP_FEATURE_SB_THREAD +#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_SB_LUTEX) #include #include #include @@ -96,7 +97,6 @@ futex_wake(int *lock_word, int n) int linux_sparc_siginfo_bug = 0; -int linux_no_threads_p = 0; #ifdef LISP_FEATURE_SB_THREAD int @@ -119,7 +119,7 @@ os_init(char *argv[], char *envp[]) { /* Conduct various version checks: do we have enough mmap(), is * this a sparc running 2.2, can we do threads? */ -#ifdef LISP_FEATURE_SB_THREAD +#if defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_SB_LUTEX) int *futex=0; #endif struct utsname name; @@ -145,12 +145,14 @@ os_init(char *argv[], char *envp[]) #endif } #ifdef LISP_FEATURE_SB_THREAD +#if !defined(LISP_FEATURE_SB_LUTEX) futex_wait(futex,-1); if(errno==ENOSYS) { lose("This version of SBCL is compiled with threading support, but your kernel\n" "is too old to support this. Please use a more recent kernel or\n" "a version of SBCL without threading support.\n"); } +#endif if(! isnptl()) { lose("This version of SBCL only works correctly with the NPTL threading\n" "library. Please use a newer glibc, use an older SBCL, or stop using\n" diff --git a/src/runtime/linux-os.h b/src/runtime/linux-os.h index 411ade6..e72aa72 100644 --- a/src/runtime/linux-os.h +++ b/src/runtime/linux-os.h @@ -22,9 +22,9 @@ #include #include #include + #include "target-arch-os.h" #include "target-arch.h" - #define linuxversion(a, b, c) (((a)<<16)+((b)<<8)+(c)) typedef caddr_t os_vm_address_t; diff --git a/src/runtime/pthread-lutex.c b/src/runtime/pthread-lutex.c new file mode 100644 index 0000000..285891b --- /dev/null +++ b/src/runtime/pthread-lutex.c @@ -0,0 +1,161 @@ +/* An approximation of Linux futexes implemented using pthread mutexes + * and pthread condition variables. + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * 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" + +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + +#include + +#include "runtime.h" +#include "arch.h" +#include "target-arch-os.h" +#include "os.h" + +#include "genesis/lutex.h" + +typedef unsigned long tagged_lutex_t; + +#if 1 +# define lutex_assert(ex) \ +do { \ + if (!(ex)) lutex_abort(); \ +} while (0) +# define lutex_assert_verbose(ex, fmt, ...) \ +do { \ + if (!(ex)) { \ + fprintf(stderr, fmt, ## __VA_ARGS__); \ + lutex_abort(); \ + } \ +} while (0) +#else +# define lutex_assert(ex) +# define lutex_assert_verbose(ex, fmt, ...) +#endif + +#define lutex_abort() \ + lose("Lutex assertion failure, file \"%s\", line %d\n", __FILE__, __LINE__) + + +pthread_mutex_t lutex_register_lock = PTHREAD_MUTEX_INITIALIZER; + +int +lutex_init (tagged_lutex_t tagged_lutex) +{ + int ret; + struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); + + lutex->mutex = malloc(sizeof(pthread_mutex_t)); + lutex_assert(lutex->mutex != 0); + + ret = pthread_mutex_init(lutex->mutex, NULL); + lutex_assert(ret == 0); + + lutex->condition_variable = malloc(sizeof(pthread_cond_t)); + lutex_assert(lutex->condition_variable != 0); + + ret = pthread_cond_init(lutex->condition_variable, NULL); + lutex_assert(ret == 0); + + ret = thread_mutex_lock(&lutex_register_lock); lutex_assert(ret == 0); + + gencgc_register_lutex(lutex); + + ret = thread_mutex_unlock(&lutex_register_lock); lutex_assert(ret == 0); + + return ret; +} + +int +lutex_wait (tagged_lutex_t tagged_queue_lutex, tagged_lutex_t tagged_mutex_lutex) +{ + int ret; + struct lutex *queue_lutex = (struct lutex*) native_pointer(tagged_queue_lutex); + struct lutex *mutex_lutex = (struct lutex*) native_pointer(tagged_mutex_lutex); + + ret = pthread_cond_wait(queue_lutex->condition_variable, mutex_lutex->mutex); + lutex_assert(ret == 0); + + return ret; +} + +int +lutex_wake (tagged_lutex_t tagged_lutex, int n) +{ + int ret = 0; + struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); + + /* The lisp-side code passes N=2**29-1 for a broadcast. */ + if (n >= ((1 << 29) - 1)) { + /* CONDITION-BROADCAST */ + ret = pthread_cond_broadcast(lutex->condition_variable); + lutex_assert(ret == 0); + } else{ + /* We're holding the condition variable mutex, so a thread + * we're waking can't re-enter the wait between to calls to + * pthread_cond_signal. Thus we'll wake N different threads, + * instead of the same thread N times. + */ + while (n--) { + ret = pthread_cond_signal(lutex->condition_variable); + lutex_assert(ret == 0); + } + } + + return ret; +} + +int +lutex_lock (tagged_lutex_t tagged_lutex) +{ + int ret = 0; + struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); + + ret = thread_mutex_lock(lutex->mutex); + lutex_assert(ret == 0); + + return ret; +} + +int +lutex_unlock (tagged_lutex_t tagged_lutex) +{ + int ret = 0; + struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); + + ret = thread_mutex_unlock(lutex->mutex); + lutex_assert(ret == 0); + + return ret; +} + +int +lutex_destroy (tagged_lutex_t tagged_lutex) +{ + struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex); + + if (lutex->condition_variable) { + pthread_cond_destroy(lutex->condition_variable); + free(lutex->condition_variable); + lutex->condition_variable = NULL; + } + + if (lutex->mutex) { + pthread_mutex_destroy(lutex->mutex); + free(lutex->mutex); + lutex->mutex = NULL; + } + + return 0; +} +#endif diff --git a/src/runtime/purify.c b/src/runtime/purify.c index c4bc398..7ebf991 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -368,6 +368,9 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #endif case SAP_WIDETAG: case WEAK_POINTER_WIDETAG: +#ifdef LUTEX_WIDETAG + case LUTEX_WIDETAG: +#endif break; default: @@ -945,6 +948,11 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #endif case SAP_WIDETAG: return ptrans_unboxed(thing, header); +#ifdef LUTEX_WIDETAG + case LUTEX_WIDETAG: + gencgc_unregister_lutex(native_pointer(thing)); + return ptrans_unboxed(thing, header); +#endif case RATIO_WIDETAG: case COMPLEX_WIDETAG: diff --git a/src/runtime/save.c b/src/runtime/save.c index d0e5026..33f7e36 100644 --- a/src/runtime/save.c +++ b/src/runtime/save.c @@ -34,6 +34,10 @@ #include "genesis/static-symbols.h" #include "genesis/symbol.h" +#ifdef LISP_FEATURE_SB_LUTEX +#include "genesis/lutex.h" +#endif + static void write_lispobj(lispobj obj, FILE *file) { @@ -76,6 +80,79 @@ write_bytes(FILE *file, char *addr, long bytes, os_vm_offset_t file_offset) return ((data - file_offset) / os_vm_page_size) - 1; } +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) +/* saving lutexes in the core */ +static void **lutex_addresses; +static long n_lutexes = 0; +static long max_lutexes = 0; + +static long +default_scan_action(lispobj *obj) +{ + return (sizetab[widetag_of(*obj)])(obj); +} + +static long +lutex_scan_action(lispobj *obj) +{ + /* note the address of the lutex */ + if(n_lutexes >= max_lutexes) { + max_lutexes *= 2; + lutex_addresses = realloc(lutex_addresses, max_lutexes * sizeof(void *)); + gc_assert(lutex_addresses); + } + + lutex_addresses[n_lutexes++] = obj; + + return (*sizetab[widetag_of(*obj)])(obj); +} + +typedef long (*scan_table[256])(lispobj *obj); + +static void +scan_objects(lispobj *start, long n_words, scan_table table) +{ + lispobj *end = start + n_words; + lispobj *object_ptr; + long n_words_scanned; + for (object_ptr = start; + object_ptr < end; + object_ptr += n_words_scanned) { + lispobj obj = *object_ptr; + + n_words_scanned = (table[widetag_of(obj)])(object_ptr); + } +} + +static void +scan_for_lutexes(lispobj *addr, long n_words) +{ + static int initialized = 0; + static scan_table lutex_scan_table; + + if (!initialized) { + int i; + + /* allocate a little space to get started */ + lutex_addresses = malloc(16*sizeof(void *)); + gc_assert(lutex_addresses); + max_lutexes = 16; + + /* initialize the mapping table */ + for(i = 0; i < ((sizeof lutex_scan_table)/(sizeof lutex_scan_table[0])); ++i) { + lutex_scan_table[i] = default_scan_action; + } + + lutex_scan_table[LUTEX_WIDETAG] = lutex_scan_action; + + initialized = 1; + } + + /* do the scan */ + scan_objects(addr, n_words, lutex_scan_table); +} +#endif + static void output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t file_offset) { @@ -88,6 +165,11 @@ output_space(FILE *file, int id, lispobj *addr, lispobj *end, os_vm_offset_t fil bytes = words * sizeof(lispobj); +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + printf("scanning space for lutexes...\n"); + scan_for_lutexes((char *)addr, words); +#endif + printf("writing %ld bytes from the %s space at 0x%08lx\n", bytes, names[id], (unsigned long)addr); @@ -217,6 +299,24 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function, } #endif +#if defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_SB_LUTEX) + if(n_lutexes > 0) { + long offset; + printf("writing %d lutexes to the core...\n", n_lutexes); + write_lispobj(LUTEX_TABLE_CORE_ENTRY_TYPE_CODE, file); + /* word count of the entry */ + write_lispobj(4, file); + /* indicate how many lutexes we saved */ + write_lispobj(n_lutexes, file); + /* save the lutexes */ + offset = write_bytes(file, (char *) lutex_addresses, + n_lutexes * sizeof(*lutex_addresses), + core_start_pos); + + write_lispobj(offset, file); + } +#endif + write_lispobj(END_CORE_ENTRY_TYPE_CODE, file); /* Write a trailing header, ignored when parsing the core normally. diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c index 0cccfe1..e88e950 100644 --- a/src/runtime/sunos-os.c +++ b/src/runtime/sunos-os.c @@ -201,11 +201,6 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) { os_context_t *context = arch_os_get_context(&void_context); void* fault_addr = (void*)info->si_addr; - if(info->si_code == 1) - { - perror("error: SEGV_MAPERR\n"); - exit(1); - } if (!gencgc_handle_wp_violation(fault_addr)) if(!handle_guard_page_triggered(context, fault_addr)) @@ -213,7 +208,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) arrange_return_to_lisp_function(context, SymbolFunction(MEMORY_FAULT_ERROR)); #else - interrupt_handle_now(signal, info, context); + interrupt_handle_now(signal, info, context); #endif } @@ -239,6 +234,13 @@ os_install_interrupt_handlers() { undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT, sigsegv_handler); + +#ifdef LISP_FEATURE_SB_THREAD + undoably_install_low_level_interrupt_handler(SIG_INTERRUPT_THREAD, + interrupt_thread_handler); + undoably_install_low_level_interrupt_handler(SIG_STOP_FOR_GC, + sig_stop_for_gc_handler); +#endif } char * @@ -253,3 +255,4 @@ os_get_runtime_executable_path() return copied_string(path); } + diff --git a/src/runtime/sunos-os.h b/src/runtime/sunos-os.h index 15475d3..95212e2 100644 --- a/src/runtime/sunos-os.h +++ b/src/runtime/sunos-os.h @@ -32,5 +32,10 @@ typedef int os_vm_prot_t; #define SIG_MEMORY_FAULT SIGSEGV +#define SIG_INTERRUPT_THREAD (SIGRTMIN) +#define SIG_STOP_FOR_GC (SIGRTMIN+1) +#define SIG_RESUME_FROM_GC (SIGRTMIN+2) + /* Yaargh?! */ typedef int os_context_register_t ; + diff --git a/src/runtime/thread.c b/src/runtime/thread.c index bedab33..b10ea3c 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -47,19 +47,32 @@ #define SIGSTKSZ 1024 #endif +#if defined(LISP_FEATURE_DARWIN) && defined(LISP_FEATURE_SB_THREAD) +#define QUEUE_FREEABLE_THREAD_STACKS +#endif + #define ALIEN_STACK_SIZE (1*1024*1024) /* 1Mb size chosen at random */ struct freeable_stack { +#ifdef QUEUE_FREEABLE_THREAD_STACKS + struct freeable_stack *next; +#endif os_thread_t os_thread; os_vm_address_t stack; }; + +#ifdef QUEUE_FREEABLE_THREAD_STACKS +static struct freeable_stack * volatile freeable_stack_queue = 0; +static int freeable_stack_count = 0; +pthread_mutex_t freeable_stack_lock = PTHREAD_MUTEX_INITIALIZER; +#else static struct freeable_stack * volatile freeable_stack = 0; +#endif int dynamic_values_bytes=4096*sizeof(lispobj); /* same for all threads */ struct thread * volatile all_threads; extern struct interrupt_data * global_interrupt_data; -extern int linux_no_threads_p; #ifdef LISP_FEATURE_SB_THREAD pthread_mutex_t all_threads_lock = PTHREAD_MUTEX_INITIALIZER; @@ -120,6 +133,60 @@ initial_thread_trampoline(struct thread *th) #ifdef LISP_FEATURE_SB_THREAD +#ifdef QUEUE_FREEABLE_THREAD_STACKS + +queue_freeable_thread_stack(struct thread *thread_to_be_cleaned_up) +{ + if (thread_to_be_cleaned_up) { + pthread_mutex_lock(&freeable_stack_lock); + if (freeable_stack_queue) { + struct freeable_stack *new_freeable_stack = 0, *next; + next = freeable_stack_queue; + while (next->next) { + next = next->next; + } + new_freeable_stack = (struct freeable_stack *) + os_validate(0, sizeof(struct freeable_stack)); + new_freeable_stack->next = NULL; + new_freeable_stack->os_thread = thread_to_be_cleaned_up->os_thread; + new_freeable_stack->stack = (os_vm_address_t) + thread_to_be_cleaned_up->control_stack_start; + next->next = new_freeable_stack; + freeable_stack_count++; + } else { + struct freeable_stack *new_freeable_stack = 0; + new_freeable_stack = (struct freeable_stack *) + os_validate(0, sizeof(struct freeable_stack)); + new_freeable_stack->next = NULL; + new_freeable_stack->os_thread = thread_to_be_cleaned_up->os_thread; + new_freeable_stack->stack = (os_vm_address_t) + thread_to_be_cleaned_up->control_stack_start; + freeable_stack_queue = new_freeable_stack; + freeable_stack_count++; + } + pthread_mutex_unlock(&freeable_stack_lock); + } +} + +#define FREEABLE_STACK_QUEUE_SIZE 4 + +static void +free_freeable_stacks() { + if (freeable_stack_queue && (freeable_stack_count > FREEABLE_STACK_QUEUE_SIZE)) { + struct freeable_stack* old; + pthread_mutex_lock(&freeable_stack_lock); + old = freeable_stack_queue; + freeable_stack_queue = old->next; + freeable_stack_count--; + gc_assert(pthread_join(old->os_thread, NULL) == 0); + FSHOW((stderr, "freeing thread %x stack\n", old->os_thread)); + os_invalidate(old->stack, THREAD_STRUCT_SIZE); + os_invalidate((os_vm_address_t)old, sizeof(struct freeable_stack)); + pthread_mutex_unlock(&freeable_stack_lock); + } +} + +#else static void free_thread_stack_later(struct thread *thread_to_be_cleaned_up) { @@ -135,7 +202,7 @@ free_thread_stack_later(struct thread *thread_to_be_cleaned_up) swap_lispobjs((lispobj *)(void *)&freeable_stack, (lispobj)new_freeable_stack); if (new_freeable_stack) { - FSHOW((stderr,"/reaping %lu\n", new_freeable_stack->os_thread)); + FSHOW((stderr,"/reaping %p\n", (void*) new_freeable_stack->os_thread)); /* Under NPTL pthread_join really waits until the thread * exists and the stack can be safely freed. This is sadly not * mandated by the pthread spec. */ @@ -145,6 +212,7 @@ free_thread_stack_later(struct thread *thread_to_be_cleaned_up) sizeof(struct freeable_stack)); } } +#endif /* this is the first thing that runs in the child (which is why the * silly calling convention). Basically it calls the user's requested @@ -155,7 +223,7 @@ int new_thread_trampoline(struct thread *th) { lispobj function; - int result; + int result, lock_ret; FSHOW((stderr,"/creating thread %lu\n", thread_self())); function = th->no_tls_value_marker; th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG; @@ -170,25 +238,36 @@ new_thread_trampoline(struct thread *th) * 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). */ - pthread_mutex_lock(&all_threads_lock); + lock_ret = pthread_mutex_lock(&all_threads_lock); + gc_assert(lock_ret == 0); link_thread(th); - pthread_mutex_unlock(&all_threads_lock); + lock_ret = pthread_mutex_unlock(&all_threads_lock); + gc_assert(lock_ret == 0); result = funcall0(function); th->state=STATE_DEAD; /* SIG_STOP_FOR_GC is blocked and GC might be waiting for this * thread, but since we are already dead it won't wait long. */ - pthread_mutex_lock(&all_threads_lock); + lock_ret = pthread_mutex_lock(&all_threads_lock); + gc_assert(lock_ret == 0); + gc_alloc_update_page_tables(0, &th->alloc_region); unlink_thread(th); pthread_mutex_unlock(&all_threads_lock); + gc_assert(lock_ret == 0); if(th->tls_cookie>=0) arch_os_thread_cleanup(th); os_invalidate((os_vm_address_t)th->interrupt_data, (sizeof (struct interrupt_data))); + +#ifdef QUEUE_FREEABLE_THREAD_STACKS + queue_freeable_thread_stack(th); +#else free_thread_stack_later(th); - FSHOW((stderr,"/exiting thread %lu\n", thread_self())); +#endif + + FSHOW((stderr,"/exiting thread %p\n", thread_self())); return result; } @@ -347,6 +426,10 @@ boolean create_os_thread(struct thread *th,os_thread_t *kid_tid) pthread_attr_t attr; sigset_t newset,oldset; boolean r=1; + int retcode, initcode, sizecode, addrcode; + + FSHOW_SIGNAL((stderr,"/create_os_thread: creating new thread\n")); + sigemptyset(&newset); /* Blocking deferrable signals is enough, no need to block * SIG_STOP_FOR_GC because the child process is not linked onto @@ -354,12 +437,31 @@ boolean create_os_thread(struct thread *th,os_thread_t *kid_tid) sigaddset_deferrable(&newset); thread_sigmask(SIG_BLOCK, &newset, &oldset); - if((pthread_attr_init(&attr)) || +#if defined(LISP_FEATURE_DARWIN) +#define CONTROL_STACK_ADJUST 8192 /* darwin wants page-aligned stacks */ +#else +#define CONTROL_STACK_ADJUST 16 +#endif + + if((initcode = pthread_attr_init(&attr)) || + /* FIXME: why do we even have this in the first place? */ (pthread_attr_setstack(&attr,th->control_stack_start, - THREAD_CONTROL_STACK_SIZE-16)) || - (pthread_create - (kid_tid,&attr,(void *(*)(void *))new_thread_trampoline,th))) + THREAD_CONTROL_STACK_SIZE-CONTROL_STACK_ADJUST)) || +#undef CONTROL_STACK_ADJUST + (retcode = pthread_create + (kid_tid,&attr,(void *(*)(void *))new_thread_trampoline,th))) { + FSHOW_SIGNAL((stderr, "init, size, addr = %d, %d, %d\n", initcode, sizecode, addrcode)); + FSHOW_SIGNAL((stderr, printf("pthread_create returned %d, errno %d\n", retcode, errno))); + FSHOW_SIGNAL((stderr, "wanted stack size %d, min stack size %d\n", + THREAD_CONTROL_STACK_SIZE-16, PTHREAD_STACK_MIN)); + if(retcode < 0) { + perror("create_os_thread"); + } r=0; + } +#ifdef QUEUE_FREEABLE_THREAD_STACKS + free_freeable_stacks(); +#endif thread_sigmask(SIG_SETMASK,&oldset,0); return r; } @@ -368,8 +470,6 @@ os_thread_t create_thread(lispobj initial_function) { struct thread *th; os_thread_t kid_tid; - if(linux_no_threads_p) return 0; - /* 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. initial_function violates this @@ -431,19 +531,22 @@ int signal_interrupt_thread(os_thread_t os_thread) void gc_stop_the_world() { struct thread *p,*th=arch_os_get_current_thread(); - int status; + int status, lock_ret; FSHOW_SIGNAL((stderr,"/gc_stop_the_world:waiting on lock, thread=%lu\n", th->os_thread)); /* keep threads from starting while the world is stopped. */ - pthread_mutex_lock(&all_threads_lock); \ + lock_ret = pthread_mutex_lock(&all_threads_lock); \ + gc_assert(lock_ret == 0); + FSHOW_SIGNAL((stderr,"/gc_stop_the_world:got lock, thread=%lu\n", th->os_thread)); /* stop all other threads by sending them SIG_STOP_FOR_GC */ for(p=all_threads; p; p=p->next) { gc_assert(p->os_thread != 0); + FSHOW_SIGNAL((stderr,"/gc_stop_the_world: p->state: %x\n", p->state)); if((p!=th) && ((p->state==STATE_RUNNING))) { - FSHOW_SIGNAL((stderr,"/gc_stop_the_world: suspending %lu\n", - p->os_thread)); + FSHOW_SIGNAL((stderr,"/gc_stop_the_world: suspending %x, os_thread %x\n", + p, p->os_thread)); status=kill_thread_safely(p->os_thread,SIG_STOP_FOR_GC); if (status==ESRCH) { /* This thread has exited. */ @@ -457,6 +560,7 @@ void gc_stop_the_world() FSHOW_SIGNAL((stderr,"/gc_stop_the_world:signals sent\n")); /* wait for the running threads to stop or finish */ for(p=all_threads;p;) { + FSHOW_SIGNAL((stderr,"/gc_stop_the_world: th: %p, p: %p\n", th, p)); if((p!=th) && (p->state==STATE_RUNNING)) { sched_yield(); } else { @@ -469,7 +573,7 @@ void gc_stop_the_world() void gc_start_the_world() { struct thread *p,*th=arch_os_get_current_thread(); - int status; + int status, lock_ret; /* if a resumed thread creates a new thread before we're done with * this loop, the new thread will get consed on the front of * all_threads, but it won't have been stopped so won't need @@ -485,7 +589,12 @@ void gc_start_the_world() FSHOW_SIGNAL((stderr, "/gc_start_the_world: resuming %lu\n", p->os_thread)); p->state=STATE_RUNNING; + +#if defined(SIG_RESUME_FROM_GC) + status=kill_thread_safely(p->os_thread,SIG_RESUME_FROM_GC); +#else status=kill_thread_safely(p->os_thread,SIG_STOP_FOR_GC); +#endif if (status) { lose("cannot resume thread=%lu: %d, %s\n", p->os_thread,status,strerror(status)); @@ -496,7 +605,10 @@ void gc_start_the_world() * SIG_STOP_FOR_GC wouldn't need to be a rt signal. That has some * performance implications, but does away with the 'rt signal * queue full' problem. */ - pthread_mutex_unlock(&all_threads_lock); \ + + lock_ret = pthread_mutex_unlock(&all_threads_lock); + gc_assert(lock_ret == 0); + FSHOW_SIGNAL((stderr,"/gc_start_the_world:end\n")); } #endif diff --git a/src/runtime/thread.h b/src/runtime/thread.h index 78367d4..2152111 100644 --- a/src/runtime/thread.h +++ b/src/runtime/thread.h @@ -113,9 +113,18 @@ static inline struct thread *arch_os_get_current_thread() { #if defined(LISP_FEATURE_SB_THREAD) #if defined(LISP_FEATURE_X86) register struct thread *me=0; - if(all_threads) + if(all_threads) { +#if defined(LISP_FEATURE_DARWIN) && defined(LISP_FEATURE_RESTORE_FS_SEGMENT_REGISTER_FROM_TLS) + sel_t sel; + struct thread *th = pthread_getspecific(specials); + sel.index = th->tls_cookie; + sel.rpl = USER_PRIV; + sel.ti = SEL_LDT; + __asm__ __volatile__ ("movw %w0, %%fs" : : "r"(sel)); +#endif __asm__ __volatile__ ("movl %%fs:%c1,%0" : "=r" (me) : "i" (offsetof (struct thread,this))); + } return me; #else return pthread_getspecific(specials); @@ -135,8 +144,8 @@ static inline struct thread *arch_os_get_current_thread() { #define thread_self getpid #define thread_kill kill #define thread_sigmask sigprocmask -#define thread_mutex_lock(l) -#define thread_mutex_unlock(l) +#define thread_mutex_lock(l) 0 +#define thread_mutex_unlock(l) 0 #endif extern void create_initial_thread(lispobj); diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c index c3f9268..428ad5f 100644 --- a/src/runtime/x86-arch.c +++ b/src/runtime/x86-arch.c @@ -250,7 +250,7 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context) single-stepping (as far as I can tell) this is somewhat moot, but it might be worth either moving this code up or deleting the single-stepping code entirely. -- CSR, 2002-07-15 */ -#ifdef LISP_FEATURE_LINUX +#if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT) os_restore_fp_control(context); #endif @@ -317,6 +317,9 @@ static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context) { os_context_t *context = (os_context_t*)void_context; + /* Triggering SIGTRAP using int3 is unreliable on OS X/x86, so + * we need to use illegal instructions for traps. + */ #if defined(LISP_FEATURE_DARWIN) if (*((unsigned short *)*os_context_pc_addr(context)) == 0x0b0f) { *os_context_pc_addr(context) += 2; diff --git a/src/runtime/x86-arch.h b/src/runtime/x86-arch.h index 7fe1aa0..82daa19 100644 --- a/src/runtime/x86-arch.h +++ b/src/runtime/x86-arch.h @@ -26,11 +26,20 @@ get_spinlock(volatile lispobj *word,long value) if(*word==value) lose("recursive get_spinlock: 0x%x,%ld\n",word,value); do { +#if defined(LISP_FEATURE_DARWIN) + asm ("xor %0,%0;\n\ + lock/cmpxchg %1,%2" + : "=a" (eax) + : "r" (value), "m" (*word) + : "memory", "cc"); +#else asm ("xor %0,%0\n\ lock cmpxchg %1,%2" : "=a" (eax) : "r" (value), "m" (*word) : "memory", "cc"); +#endif + } while(eax!=0); #else *word=value; @@ -49,10 +58,17 @@ static inline lispobj swap_lispobjs(volatile lispobj *dest, lispobj value) { lispobj old_value; +#if defined(LISP_FEATURE_DARWIN) + asm ("lock/xchg %0,(%1)" + : "=r" (old_value) + : "r" (dest), "0" (value) + : "memory"); +#else asm ("lock xchg %0,(%1)" : "=r" (old_value) : "r" (dest), "0" (value) : "memory"); +#endif return old_value; } diff --git a/src/runtime/x86-assem.S b/src/runtime/x86-assem.S index e3032e2..72b14b8 100644 --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@ -832,6 +832,57 @@ GNAME(alloc_overflow_edi): ret SIZE(GNAME(alloc_overflow_edi)) + +#ifdef LISP_FEATURE_DARWIN + .align align_4byte + .globl GNAME(call_into_lisp_tramp) + TYPE(GNAME(call_into_lisp_tramp)) +GNAME(call_into_lisp_tramp): + /* 1. build the stack frame from the block that's pointed to by ECX + 2. free the block + 3. set ECX to 0 + 4. call the function via call_into_lisp + */ + pushl 0(%ecx) /* return address */ + + pushl %ebp + movl %esp, %ebp + + pushl 32(%ecx) /* eflags */ + pushl 28(%ecx) /* EAX */ + pushl 20(%ecx) /* ECX */ + pushl 16(%ecx) /* EDX */ + pushl 24(%ecx) /* EBX */ + pushl $0 /* popal is going to ignore esp */ + pushl %ebp /* is this right?? */ + pushl 12(%ecx) /* ESI */ + pushl 8(%ecx) /* EDI */ + pushl $0 /* args for call_into_lisp */ + pushl $0 + pushl 4(%ecx) /* function to call */ + + /* free our save block */ + pushl %ecx /* reserve sufficient space on stack for args */ + pushl %ecx + andl $0xfffffff0, %esp /* align stack */ + movl $0x40, 4(%esp) + movl %ecx, (%esp) + call GNAME(os_invalidate) + + /* call call_into_lisp */ + leal -48(%ebp), %esp + call GNAME(call_into_lisp) + + /* Clean up our mess */ + leal -36(%ebp), %esp + popal + popfl + leave + ret + + SIZE(call_into_lisp_tramp) +#endif + .align align_4byte,0x90 .globl GNAME(post_signal_tramp) TYPE(GNAME(post_signal_tramp)) @@ -842,6 +893,10 @@ GNAME(post_signal_tramp): addl $12,%esp /* clear call_into_lisp args from stack */ popal /* restore registers */ popfl +#ifdef LISP_FEATURE_DARWIN + /* skip two padding words */ + addl $8,%esp +#endif leave ret SIZE(GNAME(post_signal_tramp)) diff --git a/src/runtime/x86-bsd-os.c b/src/runtime/x86-bsd-os.c index c579f6c..490c7cf 100644 --- a/src/runtime/x86-bsd-os.c +++ b/src/runtime/x86-bsd-os.c @@ -1,7 +1,23 @@ #include #include "sbcl.h" #include "runtime.h" -#include "target-os.h" +#include "thread.h" + + +#ifdef LISP_FEATURE_SB_THREAD +#ifdef LISP_FEATURE_DARWIN +#include +#include +#include +#else +#include +#include +#endif /* LISP_FEATURE_DARWIN */ +#endif + +#if defined(LISP_FEATURE_FREEBSD) +#include "machine/npx.h" +#endif /* KLUDGE: There is strong family resemblance in the signal context * stuff in FreeBSD and OpenBSD, but in detail they're different in @@ -85,7 +101,6 @@ os_context_sp_addr(os_context_t *context) #endif /* __NetBSD__ */ - /* FIXME: If this can be a no-op on BSD/x86, then it * deserves a more precise name. * @@ -94,3 +109,92 @@ void os_flush_icache(os_vm_address_t address, os_vm_size_t length) { } + +/* Note: the Darwin versions of arch_os_thread_init found in + * x86-darwin-os.c +*/ +#if !defined(LISP_FEATURE_DARWIN) + +#ifdef LISP_FEATURE_SB_THREAD + +void set_data_desc_size(struct segment_descriptor* desc, unsigned long size) +{ + desc->sd_lolimit = (size - 1) & 0xffff; + desc->sd_hilimit = ((size - 1) >> 16) &0xf; +} + +void set_data_desc_addr(struct segment_descriptor* desc, void* addr) +{ + desc->sd_lobase = (unsigned int)addr & 0xffffff; + desc->sd_hibase = ((unsigned int)addr & 0xff000000) >> 24; +} + +#endif + +int arch_os_thread_init(struct thread *thread) { + +#ifdef LISP_FEATURE_SB_THREAD + int n; + int sel; + + struct segment_descriptor ldt_entry = { 0, 0, SDT_MEMRW, SEL_UPL, 1, + 0, 0, 1, 0, 0 }; + + set_data_desc_addr(&ldt_entry, (unsigned long) thread); + set_data_desc_size(&ldt_entry, dynamic_values_bytes); + + n = i386_set_ldt(LDT_AUTO_ALLOC, (union descriptor*) &ldt_entry, 1); + if (n < 0) { + perror("i386_set_ldt"); + lose("unexpected i386_set_ldt(..) failure\n"); + } + FSHOW_SIGNAL((stderr, "/ TLS: Allocated LDT %x\n", n)); + sel = LSEL(n, SEL_UPL); + __asm__ __volatile__ ("mov %0, %%fs" : : "r"(sel)); + + thread->tls_cookie=n; + pthread_setspecific(specials,thread); +#endif + +#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK + stack_t sigstack; + + /* Signal handlers are run on the control stack, so if it is exhausted + * we had better use an alternate stack for whatever signal tells us + * we've exhausted it */ + sigstack.ss_sp=((void *) thread)+dynamic_values_bytes; + sigstack.ss_flags=0; + sigstack.ss_size = 32*SIGSTKSZ; + sigaltstack(&sigstack,0); +#endif + + return 1; /* success */ +} + +int arch_os_thread_cleanup(struct thread *thread) { + +#if defined(LISP_FEATURE_SB_THREAD) + int n = thread->tls_cookie; + + /* Set the %%fs register back to 0 and free the the ldt + * by setting it to NULL. + */ + FSHOW_SIGNAL((stderr, "/ TLS: Freeing LDT %x\n", n)); + + __asm__ __volatile__ ("mov %0, %%fs" : : "r"(0)); + i386_set_ldt(n, NULL, 1); +#endif + + return 1; /* success */ +} + +#endif /* !LISP_FEATURE_DARWIN */ + +#if defined(LISP_FEATURE_FREEBSD) +void +os_restore_fp_control(os_context_t *context) +{ + struct envxmm *ex = (struct envxmm*)(&context->uc_mcontext.mc_fpstate); + asm ("fldcw %0" : : "m" (ex->en_cw)); +} +#endif diff --git a/src/runtime/x86-bsd-os.h b/src/runtime/x86-bsd-os.h index 303b7eb..e550f33 100644 --- a/src/runtime/x86-bsd-os.h +++ b/src/runtime/x86-bsd-os.h @@ -19,4 +19,14 @@ static inline os_context_t *arch_os_get_context(void **void_context) { #error unsupported BSD variant #endif +#if defined(LISP_FEATURE_SB_THREAD) + +#if defined LISP_FEATURE_FREEBSD +/* FIXME: why is this only done for SB-THREAD? */ +#define RESTORE_FP_CONTROL_FROM_CONTEXT +void os_restore_fp_control(os_context_t *context); +#endif + +#endif + #endif /* _X86_BSD_OS_H */ diff --git a/src/runtime/x86-darwin-os.c b/src/runtime/x86-darwin-os.c new file mode 100644 index 0000000..fa924d5 --- /dev/null +++ b/src/runtime/x86-darwin-os.c @@ -0,0 +1,92 @@ + + +#ifdef LISP_FEATURE_SB_THREAD +#include +#include +#include +#endif + +#include "thread.h" +#include "x86-darwin-os.h" + +#ifdef LISP_FEATURE_SB_THREAD + +pthread_mutex_t modify_ldt_lock = PTHREAD_MUTEX_INITIALIZER; + +void set_data_desc_size(data_desc_t* desc, unsigned long size) +{ + desc->limit00 = (size - 1) & 0xffff; + desc->limit16 = ((size - 1) >> 16) &0xf; +} + +void set_data_desc_addr(data_desc_t* desc, void* addr) +{ + desc->base00 = (unsigned int)addr & 0xffff; + desc->base16 = ((unsigned int)addr & 0xff0000) >> 16; + desc->base24 = ((unsigned int)addr & 0xff000000) >> 24; +} + +#endif + +int arch_os_thread_init(struct thread *thread) { +#ifdef LISP_FEATURE_SB_THREAD + int n; + sel_t sel; + + data_desc_t ldt_entry = { 0, 0, 0, DESC_DATA_WRITE, + 3, 1, 0, DESC_DATA_32B, DESC_GRAN_BYTE, 0 }; + + set_data_desc_addr(&ldt_entry, (unsigned long) thread); + set_data_desc_size(&ldt_entry, dynamic_values_bytes); + + thread_mutex_lock(&modify_ldt_lock); + n = i386_set_ldt(LDT_AUTO_ALLOC, (union ldt_entry*) &ldt_entry, 1); + + if (n < 0) { + perror("i386_set_ldt"); + lose("unexpected i386_set_ldt(..) failure\n"); + } + thread_mutex_unlock(&modify_ldt_lock); + + FSHOW_SIGNAL((stderr, "/ TLS: Allocated LDT %x\n", n)); + sel.index = n; + sel.rpl = USER_PRIV; + sel.ti = SEL_LDT; + + __asm__ __volatile__ ("mov %0, %%fs" : : "r"(sel)); + + thread->tls_cookie=n; + pthread_setspecific(specials,thread); +#endif + +#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK + stack_t sigstack; + + /* Signal handlers are run on the control stack, so if it is exhausted + * we had better use an alternate stack for whatever signal tells us + * we've exhausted it */ + sigstack.ss_sp=((void *) thread)+dynamic_values_bytes; + sigstack.ss_flags=0; + sigstack.ss_size = 32*SIGSTKSZ; + sigaltstack(&sigstack,0); +#endif + return 1; /* success */ +} + +int arch_os_thread_cleanup(struct thread *thread) { +#if defined(LISP_FEATURE_SB_THREAD) + int n = thread->tls_cookie; + + /* Set the %%fs register back to 0 and free the the ldt + * by setting it to NULL. + */ + FSHOW_SIGNAL((stderr, "/ TLS: Freeing LDT %x\n", n)); + + __asm__ __volatile__ ("mov %0, %%fs" : : "r"(0)); + thread_mutex_lock(&modify_ldt_lock); + i386_set_ldt(n, NULL, 1); + thread_mutex_unlock(&modify_ldt_lock); +#endif + return 1; /* success */ +} + diff --git a/src/runtime/x86-darwin-os.h b/src/runtime/x86-darwin-os.h index 8ee0e38..b0f9fd1 100644 --- a/src/runtime/x86-darwin-os.h +++ b/src/runtime/x86-darwin-os.h @@ -1,10 +1,18 @@ #ifndef _X86_DARWIN_OS_H #define _X86_DARWIN_OS_H +#include +#include + +#include "darwin-os.h" + static inline os_context_t *arch_os_get_context(void **void_context) { return (os_context_t *) *void_context; } +void set_data_desc_size(data_desc_t* desc, unsigned long size); +void set_data_desc_addr(data_desc_t* desc, void* addr); + #define CONTEXT_ADDR_FROM_STEM(stem) &context->uc_mcontext->ss.stem #define DARWIN_FIX_CONTEXT(context) diff --git a/src/runtime/x86-sunos-os.c b/src/runtime/x86-sunos-os.c index 4569063..45d87f4 100644 --- a/src/runtime/x86-sunos-os.c +++ b/src/runtime/x86-sunos-os.c @@ -18,12 +18,92 @@ #include #include +#ifdef LISP_FEATURE_SB_THREAD +#include +#include +#endif + #include "validate.h" + #ifdef LISP_FEATURE_SB_THREAD -#error "Define threading support functions" -#else +pthread_mutex_t modify_ldt_lock = PTHREAD_MUTEX_INITIALIZER; +#endif + +static int +ldt_index_selector (int index) { + return index << 3 | 7; +} + +static int +find_free_ldt_index () { + struct ssd ssd; + int usage[65536/sizeof(int)]; + int i; + FILE *fp; + + memset(usage, 0, sizeof(usage)); + + fp = fopen("/proc/self/ldt", "r"); + + if (fp == NULL) { + lose("Couldn't open /proc/self/ldt"); + } + + while (fread(&ssd, sizeof(ssd), 1, fp) == 1) { + int index = ssd.sel >> 3; + if (index >= 65536) { + lose("segment selector index too large: %d", index); + } + + usage[index / sizeof(int)] |= 1 << (index & (sizeof(int)-1)); + } + + fclose(fp); + + /* Magic number 7 is the first LDT index that Solaris leaves free. */ + for (i = 7; i < 65536; i++) { + if (~usage[i / sizeof(int)] & (1 << (i & (sizeof(int)-1)))) { + return i; + } + } + + lose("Couldn't find a free LDT index"); +} + +static int +install_segment (unsigned long start, unsigned long size) { + int selector; + + thread_mutex_lock(&modify_ldt_lock); + + selector = ldt_index_selector(find_free_ldt_index()); + struct ssd ssd = { selector, + start, + size, + 0xf2, + 0x4}; + if (sysi86(SI86DSCR, &ssd) < 0) { + lose("Couldn't install segment for thread-local data"); + } + + thread_mutex_unlock(&modify_ldt_lock); + + return selector; +} + int arch_os_thread_init(struct thread *thread) { stack_t sigstack; + +#ifdef LISP_FEATURE_SB_THREAD + int sel = install_segment((unsigned long) thread, dynamic_values_bytes); + + FSHOW_SIGNAL((stderr, "/ TLS: Allocated LDT %x\n", sel)); + __asm__ __volatile__ ("mov %0, %%fs" : : "r"(sel)); + + thread->tls_cookie = sel; + pthread_setspecific(specials,thread); +#endif + #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK /* Signal handlers are run on the control stack, so if it is exhausted * we had better use an alternate stack for whatever signal tells us @@ -35,10 +115,27 @@ int arch_os_thread_init(struct thread *thread) { #endif return 1; /* success */ } + int arch_os_thread_cleanup(struct thread *thread) { +#if defined(LISP_FEATURE_SB_THREAD) + int n = thread->tls_cookie; + struct ssd delete = { n, 0, 0, 0, 0}; + + /* Set the %%fs register back to 0 and free the the ldt + * by setting it to NULL. + */ + FSHOW_SIGNAL((stderr, "/ TLS: Freeing LDT %x\n", n)); + + __asm__ __volatile__ ("mov %0, %%fs" : : "r"(0)); + + thread_mutex_lock(&modify_ldt_lock); + if (sysi86(SI86DSCR, &delete) < 0) { + lose("Couldn't remove segment\n"); + } + thread_mutex_unlock(&modify_ldt_lock); +#endif return 1; /* success */ } -#endif os_context_register_t * os_context_register_addr(os_context_t *context, int offset) diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index 2d72ec1..c285c81 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -1,3 +1,4 @@ + ;;;; miscellaneous tests of thread stuff ;;;; This software is part of the SBCL system. See the README file for @@ -81,8 +82,9 @@ (with-open-file (o "threads-foreign.c" :direction :output :if-exists :supersede) (format o "void loop_forever() { while(1) ; }~%")) (sb-ext:run-program - "cc" - (or #+linux '("-shared" "-o" "threads-foreign.so" "threads-foreign.c") + #-sunos "cc" #+sunos "gcc" + (or #+(or linux freebsd sunos) '("-shared" "-o" "threads-foreign.so" "threads-foreign.c") + #+darwin '("-dynamiclib" "-o" "threads-foreign.so" "threads-foreign.c") (error "Missing shared library compilation options for this platform")) :search t) (sb-alien:load-shared-object "threads-foreign.so") @@ -571,3 +573,47 @@ | (mp:make-process #'roomy) | (mp:make-process #'roomy))) |# + +(with-test (:name (:condition-variable :notify-multiple)) + (flet ((tester (notify-fun) + (let ((queue (make-waitqueue :name "queue")) + (lock (make-mutex :name "lock")) + (data nil)) + (labels ((test (x) + (loop + (with-mutex (lock) + (format t "condition-wait ~a~%" x) + (force-output) + (condition-wait queue lock) + (format t "woke up ~a~%" x) + (force-output) + (push x data))))) + (let ((threads (loop for x from 1 to 10 + collect + (let ((x x)) + (sb-thread:make-thread (lambda () + (test x))))))) + (sleep 5) + (with-mutex (lock) + (funcall notify-fun queue)) + (sleep 5) + (mapcar #'terminate-thread threads) + ;; Check that all threads woke up at least once + (assert (= (length (remove-duplicates data)) 10))))))) + (tester (lambda (queue) + (format t "~&(condition-notify queue 10)~%") + (force-output) + (condition-notify queue 10))) + (tester (lambda (queue) + (format t "~&(condition-broadcast queue)~%") + (force-output) + (condition-broadcast queue))))) + +(with-test (:name (:mutex :finalization)) + (let ((a nil)) + (dotimes (i 500000) + (setf a (make-mutex))))) + + + + diff --git a/version.lisp-expr b/version.lisp-expr index f8aadc1..3165a5e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.13.21" +"0.9.13.22" -- 1.7.10.4