1
;; mutex.jl -- thread mutex devices
2
;; Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
4
;; $Id: mutex.jl,v 1.7 2001/08/03 03:13:08 jsh Exp $
6
;; This file is part of librep.
8
;; librep is free software; you can redistribute it and/or modify it
9
;; under the terms of the GNU General Public License as published by
10
;; the Free Software Foundation; either version 2, or (at your option)
13
;; librep is distributed in the hope that it will be useful, but
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
;; GNU General Public License for more details.
18
;; You should have received a copy of the GNU General Public License
19
;; along with librep; see the file COPYING. If not, write to
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
(define-structure rep.threads.mutex
34
(define-structure-alias mutex rep.threads.mutex)
36
;; Each mutex is (mutex [OWNING-THREAD [BLOCKED-THREADS...]])
39
"Create and return a mutex object. No thread will own the new mutex."
43
"Returns true if ARG is a mutex object."
44
(eq (car arg) 'mutex))
46
(defun obtain-mutex (mtx #!optional timeout)
47
"Obtain the mutex MTX for the current thread. Will suspend the current
48
thread until the mutex is available. Returns false if the timeout expired."
51
(rplacd mtx (list (current-thread)))
52
(rplacd mtx (nconc (cdr mtx) (list (current-thread))))
53
(not (thread-suspend (current-thread) timeout)))))
55
(defun maybe-obtain-mutex (mtx)
56
"Attempt to obtain mutex MTX for the current thread without blocking.
57
Returns true if able to obtain the mutex, false otherwise."
64
(defun release-mutex (mtx)
65
"Release the mutex object MTX (which should have previously been obtained
66
by the current thread). Returns true if the mutex has no new owner."
67
(or (eq (cadr mtx) (current-thread))
68
(error "Not owner of mutex: %S" mtx))
70
(rplacd mtx (cddr mtx))
73
(thread-wake (cadr mtx))
added
removed
lisp/rep/threads/mutex.jl
