Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: b0e7937)
Implement MP:WITH-RWLOCK
authorMatthew Mondor <mmondor@pulsar-zone.net>
Wed, 26 Aug 2015 13:51:34 +0000 (09:51 -0400)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Wed, 26 Aug 2015 13:51:34 +0000 (09:51 -0400)
src/c/symbols_list.h patch | blob | blame | history
src/c/symbols_list2.h patch | blob | blame | history
src/lsp/mp.lsp patch | blob | blame | history
src/new-cmp/cmpmain.lsp patch | blob | blame | history

diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 820df6d..0a65446 100755 (executable)
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1564,6 +1564,7 @@ cl_symbols[] = {
 {MP_ "INTERRUPT-PROCESS", MP_ORDINARY, IF_MP(mp_interrupt_process), 2, OBJNULL},
 {MP_ "+LOAD-COMPILE-LOCK+", MP_CONSTANT, NULL, -1, OBJNULL},
 {MP_ "WITH-LOCK", MP_CONSTANT, NULL, -1, OBJNULL},
+{MP_ "WITH-RWLOCK", MP_CONSTANT, NULL, -1, OBJNULL},
 {MP_ "BLOCK-SIGNALS", MP_ORDINARY, IF_MP(mp_block_signals), 0, OBJNULL},
 {MP_ "RESTORE-SIGNALS", MP_ORDINARY, IF_MP(mp_restore_signals), 1, OBJNULL},
 {MP_ "PROCESS-SUSPEND", MP_ORDINARY, IF_MP(mp_process_suspend), 1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 8a9e314..d1861b5 100644 (file)
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1564,6 +1564,7 @@ cl_symbols[] = {
 {MP_ "INTERRUPT-PROCESS",IF_MP("mp_interrupt_process")},
 {MP_ "+LOAD-COMPILE-LOCK+",NULL},
 {MP_ "WITH-LOCK",NULL},
+{MP_ "WITH-LOCK",NULL},
 {MP_ "BLOCK-SIGNALS",IF_MP("mp_block_signals")},
 {MP_ "RESTORE-SIGNALS",IF_MP("mp_restore_signals")},
 {MP_ "PROCESS-SUSPEND",IF_MP("mp_process_suspend")},
diff --git a/src/lsp/mp.lsp b/src/lsp/mp.lsp
index 56c4770..c0f30f8 100644 (file)
--- a/src/lsp/mp.lsp
+++ b/src/lsp/mp.lsp
@@ -133,3 +133,18 @@ by ALLOW-WITH-INTERRUPTS."
                               (> (the fixnum (mp:lock-count ,lock))
                                  (the fixnum ,count))))
                  (mp::giveup-lock ,lock))))))))
+
+#+ecl-read-write-lock
+(defmacro with-rwlock ((lock op) &body body)
+  (assert (member op '(:read :write) :test #'eq))
+  (let ((s-lock (gensym)))
+    `(let ((,s-lock ,lock))
+       (,(if (eq :read op)
+             'mp:get-rwlock-read
+             'mp:get-rwlock-write) ,s-lock t)
+       (unwind-protect
+            (progn
+              ,@body)
+         (,(if (eq :read op)
+               'mp:giveup-rwlock-read
+               'mp:giveup-rwlock-write) ,s-lock)))))
diff --git a/src/new-cmp/cmpmain.lsp b/src/new-cmp/cmpmain.lsp
index dce4982..c9219d5 100644 (file)
--- a/src/new-cmp/cmpmain.lsp
+++ b/src/new-cmp/cmpmain.lsp
@@ -19,6 +19,10 @@
 (defmacro with-lock ((lock) &body body)
   `(progn ,@body))
 
+#-ecl-read-write-lock
+(defmacro with-rwlock ((lock op) &body body)
+  `(progn ,@body))
+
 (defun safe-system (string)
   (cmpnote "Invoking external command:~%  ~A" string)
   (let ((result (si:system string)))
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)