[m-rev.] diff: thread modules for java

[Peter Wang]

Branches: main

library/thread.m:
library/thread.semaphore.m:
        Implement these modules for Java backend.

diff --git a/library/thread.m b/library/thread.m
index b184854..be0eeb9 100644
--- a/library/thread.m
+++ b/library/thread.m
@@ -95,6 +95,13 @@
 #endif
 ").
 
+:- pragma foreign_proc("Java",
+    can_spawn,
+    [will_not_call_mercury, promise_pure],
+"
+    succeeded = true;
+").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_proc("C",
@@ -147,6 +154,19 @@
     t.Start();
 ").
 
+:- pragma foreign_proc("Java",
+    spawn(Goal::(pred(di, uo) is cc_multi), IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io,
+        may_not_duplicate],
+"
+    MercuryThread mt = new MercuryThread((Object[]) Goal);
+    Thread thread = new Thread(mt);
+    thread.start();
+    IO = IO0;
+").
+
+%-----------------------------------------------------------------------------%
+
 :- pragma no_inline(yield/2).
 :- pragma foreign_proc("C",
     yield(IO0::di, IO::uo),
@@ -173,6 +193,15 @@
     IO = IO0;
 ").
 
+:- pragma foreign_proc("Java",
+    yield(IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io,
+        may_not_duplicate],
+"
+    java.lang.Thread.yield();
+    IO = IO0;
+").
+
 yield(!IO).
 
 %-----------------------------------------------------------------------------%
@@ -360,6 +389,9 @@ INIT mercury_sys_init_thread_modules
 :- pragma foreign_export("IL",
     call_back_to_mercury(pred(di, uo) is cc_multi, di, uo),
     "ML_call_back_to_mercury_cc_multi").
+:- pragma foreign_export("Java",
+    call_back_to_mercury(pred(di, uo) is cc_multi, di, uo),
+    "ML_call_back_to_mercury_cc_multi").
 
 call_back_to_mercury(Goal, !IO) :-
     Goal(!IO).
@@ -381,6 +413,21 @@ public class MercuryThread {
     }
 }").
 
+:- pragma foreign_code("Java", "
+public static class MercuryThread implements Runnable {
+    final Object[] Goal;
+
+    public MercuryThread(Object[] g)
+    {
+        Goal = g;
+    }
+
+    public void run()
+    {
+        thread.ML_call_back_to_mercury_cc_multi(Goal);
+    }
+}").
+
 %-----------------------------------------------------------------------------%
 :- end_module thread.
 %-----------------------------------------------------------------------------%
diff --git a/library/thread.semaphore.m b/library/thread.semaphore.m
index 8e06e48..6047b1e 100644
--- a/library/thread.semaphore.m
+++ b/library/thread.semaphore.m
@@ -148,6 +148,13 @@ new(Semaphore, !IO) :-
     Semaphore.count = Count;
 ").
 
+:- pragma foreign_proc("Java",
+    new(Count::in) = (Semaphore::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    Semaphore = new java.util.concurrent.Semaphore(Count);
+").
+
 :- pragma foreign_code("C", "
 
 void
@@ -256,6 +263,13 @@ ML_finalize_semaphore(void *obj, void *cd)
     System.Threading.Monitor.Exit(Semaphore);
 ").
 
+:- pragma foreign_proc("Java",
+    signal(Semaphore::in, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    Semaphore.release();
+").
+
     % semaphore.wait causes the calling context to resume in semaphore.nop,
     % which simply jumps to the succip. That will return control to the caller
     % of semaphore.wait as intended, but not if this procedure is inlined.
@@ -341,6 +355,17 @@ ML_finalize_semaphore(void *obj, void *cd)
     System.Threading.Monitor.Exit(Semaphore);
 ").
 
+:- pragma foreign_proc("Java",
+    wait(Semaphore::in, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    /*
+    ** acquire() might be useful as well; it will throw an exception if the
+    ** thread is interrupted.
+    */
+    Semaphore.acquireUninterruptibly();
+").
+
 semaphore.try_wait(Sem, Res, !IO) :-
     try_wait_2(Sem, Res0, !IO),
     Res = ( Res0 = 0 -> yes ; no ).
@@ -385,6 +410,13 @@ semaphore.try_wait(Sem, Res, !IO) :-
     }
 ").
 
+:- pragma foreign_proc("Java",
+    try_wait_2(Semaphore::in, Res::out, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+"
+    Res = Semaphore.tryAcquire() ? 0 : 1;
+").
+
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_decl("C",

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------