From: Nikodemus S. <nsi...@it...> - 2007-03-19 15:35:25
|
The following patch implements a first cut (missing proper documentation and tests) of timeouts on mutexes for the futex backend. Interface: variable *default-mutex-timeout* variable *default-mutex-timeout-function* accessor mutex-timeout accessor mutex-timeout-function WITH-MUTEX and GET-MUTEX also get new arguments (timeout and timeout-function), which default to the values stored in the mutex itself. If a mutex times out, it calls the mutex-timeout-function. If the function returns the mutex keeps on spinning: to abandon the attempt the timeout-function needs to perform a non-local exit. Comments welcome. Cheers, -- Nikodemus Index: package-data-list.lisp-expr =================================================================== RCS file: /cvsroot/sbcl/sbcl/package-data-list.lisp-expr,v retrieving revision 1.385 diff -u -r1.385 package-data-list.lisp-expr --- package-data-list.lisp-expr 2 Mar 2007 04:35:58 -0000 1.385 +++ package-data-list.lisp-expr 19 Mar 2007 15:30:32 -0000 @@ -1646,6 +1646,7 @@ "INTERRUPT-THREAD-ERROR-THREAD" "INTERRUPT-THREAD" "TERMINATE-THREAD" "DESTROY-THREAD" "MUTEX" "MAKE-MUTEX" "MUTEX-NAME" "MUTEX-VALUE" + "MUTEX-TIMEOUT" "MUTEX-TIMEOUT-FUNCTION" "GET-MUTEX" "RELEASE-MUTEX" "WITH-MUTEX" "WITH-RECURSIVE-LOCK" "WAITQUEUE" "MAKE-WAITQUEUE" "WAITQUEUE-NAME" Index: src/code/target-thread.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/target-thread.lisp,v retrieving revision 1.62 diff -u -r1.62 target-thread.lisp --- src/code/target-thread.lisp 20 Nov 2006 04:51:38 -0000 1.62 +++ src/code/target-thread.lisp 19 Mar 2007 15:30:32 -0000 @@ -161,7 +161,7 @@ (declaim (inline futex-wait futex-wake)) (sb!alien:define-alien-routine "futex_wait" - int (word unsigned-long) (old-value unsigned-long)) + int (word unsigned-long) (old-value unsigned-long) (timeout double-float)) (sb!alien:define-alien-routine "futex_wake" int (word unsigned-long) (n unsigned-long)))) @@ -233,11 +233,12 @@ (+ (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)) +(defun get-mutex (mutex &optional (new-value *current-thread*) (wait-p t) (timeout (mutex-timeout mutex)) + (timeout-function (mutex-timeout-function mutex))) #!+sb-doc "Acquire MUTEX, setting it to NEW-VALUE or some suitable default -value if NIL. If WAIT-P is non-NIL and the mutex is in use, sleep -until it is available" +value if NIL. If WAIT-P is true (the default) 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 @@ -264,16 +265,21 @@ (%lutex-trylock lutex)))) (setf (mutex-value mutex) new-value)) #!-sb-lutex - (let (old) + (let ((timeout (coerce (or timeout 0.0d0) 'double-float)) + 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))))))) + (unless + (setf old (sb!vm::%instance-set-conditional mutex 2 nil + new-value)) + (return t)) + (unless wait-p (return nil)) + (when (minusp (with-pinned-objects (mutex old) + (futex-wait (mutex-value-address mutex) + (sb!kernel:get-lisp-obj-address old) + timeout))) + (if hook + (funcall timeout-function mutex) + (warn "Timeout on ~S without a timeout-function." mutex))))))) (defun release-mutex (mutex) #!+sb-doc @@ -352,7 +358,8 @@ ;; Ergo, no lost wakeup (with-pinned-objects (queue me) (futex-wait (waitqueue-data-address queue) - (sb!kernel:get-lisp-obj-address me)))) + (sb!kernel:get-lisp-obj-address me) + 0.0d0))) ;; If we are interrupted while waiting, we should do these things ;; before returning. Ideally, in the case of an unhandled signal, ;; we should do them before entering the debugger, but this is Index: src/code/thread.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/thread.lisp,v retrieving revision 1.17 diff -u -r1.17 thread.lisp --- src/code/thread.lisp 3 Jun 2006 20:26:52 -0000 1.17 +++ src/code/thread.lisp 19 Mar 2007 15:30:32 -0000 @@ -11,13 +11,25 @@ (in-package "SB!THREAD") +(defun mutex-timeout-error (mutex) + (cerror "Continue waiting till another timeout occurs." + "Timeout on ~A." mutex)) + +(defvar *default-mutex-timeout* nil + "Default timeout value for mutexes.") + +(defvar *default-timeout-function* 'mutex-timeout-error + "Default default timeout function for mutexes.") + (def!struct mutex #!+sb-doc "Mutex type." (name nil :type (or null simple-string)) (value nil) #!+(and sb-lutex sb-thread) - (lutex (make-lutex))) + (lutex (make-lutex)) + (timeout *default-timeout*) + (timeout-function *default-timeout-error*)) (def!struct spinlock #!+sb-doc @@ -25,25 +37,28 @@ (name nil :type (or null simple-string)) (value 0)) -(sb!xc:defmacro with-mutex ((mutex &key (value '*current-thread*) (wait-p t)) +(sb!xc:defmacro with-mutex ((mutex &key (value '*current-thread*) (wait-p t) (timeout nil timeoutp) + (timeout-function nil timeout-function-p)) &body body) #!+sb-doc "Acquire MUTEX for the dynamic scope of BODY, setting it to -NEW-VALUE or some suitable default value if NIL. If WAIT-P is non-NIL -and the mutex is in use, sleep until it is available" - #!-sb-thread (declare (ignore mutex value wait-p)) - #!+sb-thread - (with-unique-names (got mutex1) - `(let ((,mutex1 ,mutex) - ,got) +NEW-VALUE or some suitable default value if NIL. If WAIT-P is true (the default) +and the mutex is in use, sleep until it is available." + #!-sb-thread + (declare (ignore mutex value wait-p)) #!+sb-thread + (with-unique-names (got mutex1 timeout1 timeoutfun) + `(let* ((,mutex1 ,mutex) + (,timeout1 ,(if timeoutp timeout `(mutex-timeout ,mutex1))) + (,timeoutfun ,(if timeout-function-p timeout-function `(mutex-timeout-function ,mutex1))) + ,got) (/show0 "WITH-MUTEX") - (unwind-protect - ;; FIXME: async unwind in SETQ form - (when (setq ,got (get-mutex ,mutex1 ,value ,wait-p)) - (locally - ,@body)) - (when ,got - (release-mutex ,mutex1))))) + (unwind-protect + ;; FIXME: async unwind in SETQ form + (when (setq ,got (get-mutex ,mutex1 ,value ,wait-p ,timeout1 ,timeoutfun1)) + (locally + ,@body)) + (when ,got + (release-mutex ,mutex1))))) ;; KLUDGE: this separate expansion for (NOT SB-THREAD) is not ;; strictly necessary; GET-MUTEX and RELEASE-MUTEX are implemented. ;; However, there would be a (possibly slight) performance hit in Index: src/runtime/linux-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/linux-os.c,v retrieving revision 1.68 diff -u -r1.68 linux-os.c --- src/runtime/linux-os.c 15 Jan 2007 22:15:49 -0000 1.68 +++ src/runtime/linux-os.c 19 Mar 2007 15:30:32 -0000 @@ -81,12 +81,33 @@ return syscall (SYS_futex, futex, op, val, rel); } +/* We have a simple return-value interface: -1 is timeout, anything else + * is ...anything else. + */ int -futex_wait(int *lock_word, int oldval) +futex_wait(int *lock_word, int oldval, double timeout) { int t; + struct timespec to; + if (timeout>0.0) { + long timeout_sec = timeout; + to.tv_sec = timeout_sec; + to.tv_nsec = 1000000000 * (timeout-timeout_sec); + } again: - t = sys_futex(lock_word,FUTEX_WAIT,oldval, 0); + if (timeout>0.0) { + t = sys_futex(lock_word,FUTEX_WAIT,oldval, &to); + /* The manpage claims that the return value would be ETIMEDOUT, + * but this is not true. If the wait times out the return value + * is nonzero (-1, it seems) and the errno is ETIMEDOUT. + */ + if (t != 0 && errno == ETIMEDOUT) { + return -1; + } + } + else { + t = sys_futex(lock_word,FUTEX_WAIT,oldval, 0); + } /* Interrupted FUTEX_WAIT calls may return early. * @@ -96,7 +117,7 @@ if (t != 0 && errno == EINTR) goto again; - return t; + return 0; } int @@ -172,7 +193,7 @@ } #ifdef LISP_FEATURE_SB_THREAD #if !defined(LISP_FEATURE_SB_LUTEX) && !defined(LISP_FEATURE_SB_PTHREAD_FUTEX) - futex_wait(futex,-1); + futex_wait(futex,-1,0.0); 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" |
From: <me...@re...> - 2007-03-22 20:56:09
|
On Monday 19 March 2007 16:35, Nikodemus Siivola wrote: > The following patch implements a first cut (missing proper > documentation and tests) of timeouts on mutexes for the futex > backend. > > Interface: > > variable *default-mutex-timeout* > variable *default-mutex-timeout-function* > accessor mutex-timeout > accessor mutex-timeout-function > > WITH-MUTEX and GET-MUTEX also get new arguments (timeout and > timeout-function), which default to the values stored in the mutex > itself. > > If a mutex times out, it calls the mutex-timeout-function. If the > function returns the mutex keeps on spinning: to abandon the attempt > the timeout-function needs to perform a non-local exit. > > Comments welcome. Looks good. Nitpicking follows. - the extra linebreaks make it harder to read - get-mutex is getting downright ugly with its four optional parameters. They should have been keyword args anyway. If I were to break compatibility I'd remove new-value (no use-case?), change wait-p to waitp (even wait is better). - What is timeout=0 supposed to do? Same as wait-p NIL? Some combination of parameters are meaningless. - what's the rationale for having timeout + timeout-function instead of only timeout and signalling a condition? I guess that would make warn-if-no-timeout-function go away and present a simpler interface. > Cheers, Gabor > -- Nikodemus |