diff options
Diffstat (limited to 'src/rw-lock.lisp')
| -rw-r--r-- | src/rw-lock.lisp | 11 |
1 files changed, 10 insertions, 1 deletions
diff --git a/src/rw-lock.lisp b/src/rw-lock.lisp index dc8850d..b8d08b1 100644 --- a/src/rw-lock.lisp +++ b/src/rw-lock.lisp | |||
| @@ -7,6 +7,7 @@ | |||
| 7 | (:import-from :com.dieggsy.f-string :enable-f-strings) | 7 | (:import-from :com.dieggsy.f-string :enable-f-strings) |
| 8 | (:import-from :sb-sys | 8 | (:import-from :sb-sys |
| 9 | :allow-with-interrupts :with-local-interrupts :without-interrupts) | 9 | :allow-with-interrupts :with-local-interrupts :without-interrupts) |
| 10 | (:import-from :serapeum :->) | ||
| 10 | (:export | 11 | (:export |
| 11 | #:rw-lock | 12 | #:rw-lock |
| 12 | #:rw-lock-p | 13 | #:rw-lock-p |
| @@ -36,12 +37,14 @@ | |||
| 36 | 37 | ||
| 37 | (defvar *counter* 0) | 38 | (defvar *counter* 0) |
| 38 | 39 | ||
| 40 | (-> gen-name () string) | ||
| 39 | (defun gen-name () | 41 | (defun gen-name () |
| 40 | "Generate a name for a rw-lock" | 42 | "Generate a name for a rw-lock" |
| 41 | (format nil "Read-Write Lock ~A" | 43 | (format nil "Read-Write Lock ~A" |
| 42 | (with-lock-held (*counter-lock*) | 44 | (with-lock-held (*counter-lock*) |
| 43 | (incf *counter*)))) | 45 | (incf *counter*)))) |
| 44 | 46 | ||
| 47 | (-> make-rw-lock (&key (:name string)) rw-lock) | ||
| 45 | (defun make-rw-lock (&key (name (gen-name))) | 48 | (defun make-rw-lock (&key (name (gen-name))) |
| 46 | (check-type name string) | 49 | (check-type name string) |
| 47 | (make-rw-lock% | 50 | (make-rw-lock% |
| @@ -49,6 +52,7 @@ | |||
| 49 | :reader-cv (make-condition-variable :name #f"{name}'s internal reader-cv") | 52 | :reader-cv (make-condition-variable :name #f"{name}'s internal reader-cv") |
| 50 | :writer-cv (make-condition-variable :name #f"{name}'s internal writer-cv"))) | 53 | :writer-cv (make-condition-variable :name #f"{name}'s internal writer-cv"))) |
| 51 | 54 | ||
| 55 | (-> wakeup-waiters (rw-lock) (values &optional)) | ||
| 52 | (defun wakeup-waiters (rw-lock) | 56 | (defun wakeup-waiters (rw-lock) |
| 53 | ;; NOTE: RW-LOCK-LOCK HAS TO BE TAKEN! | 57 | ;; NOTE: RW-LOCK-LOCK HAS TO BE TAKEN! |
| 54 | (declare (type rw-lock rw-lock)) | 58 | (declare (type rw-lock rw-lock)) |
| @@ -57,8 +61,10 @@ | |||
| 57 | ((zerop waiting-readers) (condition-notify writer-cv)) | 61 | ((zerop waiting-readers) (condition-notify writer-cv)) |
| 58 | ((zerop waiting-writers) (condition-broadcast reader-cv)) | 62 | ((zerop waiting-writers) (condition-broadcast reader-cv)) |
| 59 | (t (whichever (condition-notify writer-cv) | 63 | (t (whichever (condition-notify writer-cv) |
| 60 | (condition-broadcast reader-cv)))))) | 64 | (condition-broadcast reader-cv))))) |
| 65 | (values)) | ||
| 61 | 66 | ||
| 67 | (-> acquire-read-lock (rw-lock &key (:wait boolean)) boolean) | ||
| 62 | (defun acquire-read-lock (rw-lock &key (wait t)) | 68 | (defun acquire-read-lock (rw-lock &key (wait t)) |
| 63 | ;; TODO: timeout | 69 | ;; TODO: timeout |
| 64 | (check-type rw-lock rw-lock) | 70 | (check-type rw-lock rw-lock) |
| @@ -83,6 +89,7 @@ | |||
| 83 | (decf waiting-readers) | 89 | (decf waiting-readers) |
| 84 | (release-lock lock))))))) | 90 | (release-lock lock))))))) |
| 85 | 91 | ||
| 92 | (-> release-read-lock (rw-lock) rw-lock) | ||
| 86 | (defun release-read-lock (rw-lock) | 93 | (defun release-read-lock (rw-lock) |
| 87 | (check-type rw-lock rw-lock) | 94 | (check-type rw-lock rw-lock) |
| 88 | (with-slots (lock active-readers active-writer) rw-lock | 95 | (with-slots (lock active-readers active-writer) rw-lock |
| @@ -107,6 +114,7 @@ | |||
| 107 | (when ,lock-acquired | 114 | (when ,lock-acquired |
| 108 | (release-read-lock ,lock-value))))))) | 115 | (release-read-lock ,lock-value))))))) |
| 109 | 116 | ||
| 117 | (-> acquire-write-lock (rw-lock &key (:wait boolean)) boolean) | ||
| 110 | (defun acquire-write-lock (rw-lock &key (wait t)) | 118 | (defun acquire-write-lock (rw-lock &key (wait t)) |
| 111 | ;; TODO: timeout | 119 | ;; TODO: timeout |
| 112 | (check-type rw-lock rw-lock) | 120 | (check-type rw-lock rw-lock) |
| @@ -131,6 +139,7 @@ | |||
| 131 | (decf waiting-writers) | 139 | (decf waiting-writers) |
| 132 | (release-lock lock))))))) | 140 | (release-lock lock))))))) |
| 133 | 141 | ||
| 142 | (-> release-write-lock (rw-lock) rw-lock) | ||
| 134 | (defun release-write-lock (rw-lock) | 143 | (defun release-write-lock (rw-lock) |
| 135 | (check-type rw-lock rw-lock) | 144 | (check-type rw-lock rw-lock) |
| 136 | (with-slots (lock active-readers active-writer) rw-lock | 145 | (with-slots (lock active-readers active-writer) rw-lock |