Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: c4e3e84)
Implement a few non-blocking MP functions:
authorMatthew Mondor <mmondor@pulsar-zone.net>
Wed, 26 Aug 2015 16:31:19 +0000 (12:31 -0400)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Wed, 26 Aug 2015 16:31:19 +0000 (12:31 -0400)
 MP:TRY-GET-SEMAPHORE
   returns NIL if the semaphore could not be obtained, or the count
   if it could be obtained

 MP:MAILBOX-TRY-READ
   returns a message if it's available, NIL if the queue is empty

 MP:MAILBOX-TRY-SEND
   returns the sent message if it could be queued, or NIL
   (mailbox is full)

src/c/symbols_list.h patch | blob | blame | history
src/c/symbols_list2.h patch | blob | blame | history
src/c/threads/mailbox.d patch | blob | blame | history
src/c/threads/semaphore.d patch | blob | blame | history
src/h/external.h patch | blob | blame | history

diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 0a65446..94425ad 100755 (executable)
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1585,6 +1585,7 @@ cl_symbols[] = {
 {MP_ "MAKE-SEMAPHORE", MP_ORDINARY, IF_MP(mp_make_semaphore), -1, OBJNULL},
 {MP_ "SIGNAL-SEMAPHORE", MP_ORDINARY, IF_MP(mp_signal_semaphore), -1, OBJNULL},
 {MP_ "WAIT-ON-SEMAPHORE", MP_ORDINARY, IF_MP(mp_wait_on_semaphore), 1, OBJNULL},
+{MP_ "TRY-GET-SEMAPHORE", MP_ORDINARY, IF_MP(mp_try_get_semaphore), 1, OBJNULL},
 {MP_ "SEMAPHORE-COUNT", MP_ORDINARY, IF_MP(mp_semaphore_count), 1, OBJNULL},
 {MP_ "SEMAPHORE-NAME", MP_ORDINARY, IF_MP(mp_semaphore_name), 1, OBJNULL},
 {MP_ "SEMAPHORE-WAIT-COUNT", MP_ORDINARY, IF_MP(mp_semaphore_wait_count), 1, OBJNULL},
@@ -1608,7 +1609,9 @@ cl_symbols[] = {
 {MP_ "MAILBOX-COUNT", MP_ORDINARY, IF_MP(mp_mailbox_count), 1, OBJNULL},
 {MP_ "MAILBOX-EMPTY-P", MP_ORDINARY, IF_MP(mp_mailbox_empty_p), 1, OBJNULL},
 {MP_ "MAILBOX-READ", MP_ORDINARY, IF_MP(mp_mailbox_read), 1, OBJNULL},
+{MP_ "MAILBOX-TRY-READ", MP_ORDINARY, IF_MP(mp_mailbox_try_read), 1, OBJNULL},
 {MP_ "MAILBOX-SEND", MP_ORDINARY, IF_MP(mp_mailbox_send), 2, OBJNULL},
+{MP_ "MAILBOX-TRY-SEND", MP_ORDINARY, IF_MP(mp_mailbox_try_send), 2, OBJNULL},
 /* #endif defined(ECL_THREADS) */
 
 {SYS_ "WHILE", SI_ORDINARY, NULL, -1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index d1861b5..ea64517 100644 (file)
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1564,7 +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_ "WITH-RWLOCK",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")},
@@ -1585,6 +1585,7 @@ cl_symbols[] = {
 {MP_ "MAKE-SEMAPHORE",IF_MP("mp_make_semaphore")},
 {MP_ "SIGNAL-SEMAPHORE",IF_MP("mp_signal_semaphore")},
 {MP_ "WAIT-ON-SEMAPHORE",IF_MP("mp_wait_on_semaphore")},
+{MP_ "TRY-GET-SEMAPHORE",IF_MP("mp_try_get_semaphore")},
 {MP_ "SEMAPHORE-COUNT",IF_MP("mp_semaphore_count")},
 {MP_ "SEMAPHORE-NAME",IF_MP("mp_semaphore_name")},
 {MP_ "SEMAPHORE-WAIT-COUNT",IF_MP("mp_semaphore_wait_count")},
@@ -1608,7 +1609,9 @@ cl_symbols[] = {
 {MP_ "MAILBOX-COUNT",IF_MP("mp_mailbox_count")},
 {MP_ "MAILBOX-EMPTY-P",IF_MP("mp_mailbox_empty_p")},
 {MP_ "MAILBOX-READ",IF_MP("mp_mailbox_read")},
+{MP_ "MAILBOX-TRY-READ",IF_MP("mp_mailbox_try_read")},
 {MP_ "MAILBOX-SEND",IF_MP("mp_mailbox_send")},
+{MP_ "MAILBOX-TRY-SEND",IF_MP("mp_mailbox_try_send")},
 /* #endif defined(ECL_THREADS) */
 
 {SYS_ "WHILE",NULL},
diff --git a/src/c/threads/mailbox.d b/src/c/threads/mailbox.d
index fdda559..615c2ec 100755 (executable)
--- a/src/c/threads/mailbox.d
+++ b/src/c/threads/mailbox.d
@@ -108,6 +108,25 @@ mp_mailbox_read(cl_object mailbox)
 }
 
 cl_object
+mp_mailbox_try_read(cl_object mailbox)
+{
+        cl_env_ptr env = ecl_process_env();
+        cl_fixnum ndx;
+        cl_object output;
+        unlikely_if (ecl_t_of(mailbox) != t_mailbox) {
+                FEerror_not_a_mailbox(mailbox);
+        }
+        output = mp_try_get_semaphore(mailbox->mailbox.reader_semaphore);
+        if (output != ECL_NIL) {
+                ndx = AO_fetch_and_add1((AO_t*)&mailbox->mailbox.read_pointer) &
+                        mailbox->mailbox.mask;
+                output = mailbox->mailbox.data->vector.self.t[ndx];
+                mp_signal_semaphore(1, mailbox->mailbox.writer_semaphore);
+        }
+        ecl_return1(env, output);
+}
+
+cl_object
 mp_mailbox_send(cl_object mailbox, cl_object msg)
 {
         cl_env_ptr env = ecl_process_env();
@@ -124,3 +143,24 @@ mp_mailbox_send(cl_object mailbox, cl_object msg)
         mp_signal_semaphore(1, mailbox->mailbox.reader_semaphore);
         ecl_return0(env);
 }
+
+cl_object
+mp_mailbox_try_send(cl_object mailbox, cl_object msg)
+{
+        cl_env_ptr env = ecl_process_env();
+        cl_object output;
+        cl_fixnum ndx;
+        unlikely_if (ecl_t_of(mailbox) != t_mailbox) {
+                FEerror_not_a_mailbox(mailbox);
+        }
+        output = mp_try_get_semaphore(mailbox->mailbox.writer_semaphore);
+        if (output != ECL_NIL) {
+                output = msg;
+                ndx = AO_fetch_and_add1((AO_t*)&mailbox->mailbox.write_pointer) &
+                        mailbox->mailbox.mask;
+                mailbox->mailbox.data->vector.self.t[ndx] = msg;
+                mp_signal_semaphore(1, mailbox->mailbox.reader_semaphore);
+        }
+        ecl_return1(env, output);
+}
+
diff --git a/src/c/threads/semaphore.d b/src/c/threads/semaphore.d
index ccd4bf2..04d7850 100644 (file)
--- a/src/c/threads/semaphore.d
+++ b/src/c/threads/semaphore.d
@@ -127,3 +127,15 @@ mp_wait_on_semaphore(cl_object semaphore)
         }
         ecl_return1(env, output);
 }
+
+cl_object
+mp_try_get_semaphore(cl_object semaphore)
+{
+        cl_env_ptr env = ecl_process_env();
+        cl_object output;
+        unlikely_if (ecl_t_of(semaphore) != t_semaphore) {
+                FEerror_not_a_semaphore(semaphore);
+        }
+        ecl_return1(env, get_semaphore_inner(env, semaphore));
+}
+
diff --git a/src/h/external.h b/src/h/external.h
index 2e05ede..20bf469 100755 (executable)
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1734,6 +1734,7 @@ extern ECL_API cl_object mp_semaphore_count(cl_object);
 extern ECL_API cl_object mp_semaphore_name(cl_object);
 extern ECL_API cl_object mp_semaphore_wait_count(cl_object);
 extern ECL_API cl_object mp_wait_on_semaphore(cl_object);
+extern ECL_API cl_object mp_try_get_semaphore(cl_object);
 extern ECL_API cl_object mp_signal_semaphore _ECL_ARGS((cl_narg, cl_object, ...));
 extern ECL_API cl_object ecl_make_semaphore(cl_object name, cl_fixnum count);
 
@@ -1754,7 +1755,9 @@ extern ECL_API cl_object mp_mailbox_name(cl_object mailbox);
 extern ECL_API cl_object mp_mailbox_count(cl_object mailbox);
 extern ECL_API cl_object mp_mailbox_empty_p(cl_object);
 extern ECL_API cl_object mp_mailbox_read(cl_object mailbox);
+extern ECL_API cl_object mp_mailbox_try_read(cl_object mailbox);
 extern ECL_API cl_object mp_mailbox_send(cl_object mailbox, cl_object msg);
+extern ECL_API cl_object mp_mailbox_try_send(cl_object mailbox, cl_object msg);
 
 /* threads/atomic.c */
 
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)