%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2000-2001,2003-2004, 2006-2007, 2009-2011 The University of Melbourne. % Copyright (C) 2014-2018, 2020-2022 The Mercury Team. % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % % File: thread.semaphore.m. % Main author: conway. % Stability: medium. % % This module implements a simple semaphore data type for allowing % threads to synchronise with one another. % % The operations in this module are no-ops in the hlc grades that do not % contain a .par component. % %---------------------------------------------------------------------------% :- module thread.semaphore. :- interface. :- import_module bool. :- import_module io. %---------------------------------------------------------------------------% :- type semaphore. % init(Count, Sem, !IO) creates a new semaphore Sem with its counter % initialized to Count. % :- pred init(int::in, semaphore::uo, io::di, io::uo) is det. % init(Sem, !IO) creates a new semaphore Sem with its counter % initialized to 0. % :- pred init(semaphore::uo, io::di, io::uo) is det. % Sem = init(Count) returns a new semaphore Sem with its counter % initialized to Count. % :- impure func impure_init(int::in) = (semaphore::uo) is det. % signal(Sem, !IO) increments the counter associated with Sem % and if the resulting counter has a value greater than 0, it wakes % one or more threads that are waiting on this semaphore (if % any). % :- pred signal(semaphore::in, io::di, io::uo) is det. % wait(Sem, !IO) blocks until the counter associated with Sem % becomes greater than 0, whereupon it wakes, decrements the % counter and returns. % :- pred wait(semaphore::in, io::di, io::uo) is det. % try_wait(Sem, Succ, !IO) is the same as wait/3, except that % instead of blocking, it binds Succ to a boolean indicating % whether the call succeeded in obtaining the semaphore or not. % :- pred try_wait(semaphore::in, bool::out, io::di, io::uo) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. init(Count, Semaphore, !IO) :- promise_pure ( impure impure_init(Count, Semaphore) ). init(Semaphore, !IO) :- init(0, Semaphore, !IO). impure_init(Count) = Semaphore :- impure impure_init(Count, Semaphore). signal(Semaphore, !IO) :- promise_pure ( impure impure_signal(Semaphore), !:IO = !.IO ). wait(Semaphore, !IO) :- promise_pure ( impure impure_wait(Semaphore), !:IO = !.IO ). try_wait(Sem, Res, !IO) :- promise_pure ( impure impure_try_wait(Sem, Res) ). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- interface. % The semaphore operations above can be used without the I/O state in impure % code. These predicates are provided for use by implementors. :- impure pred impure_init(int::in, semaphore::uo) is det. :- impure pred impure_init(semaphore::uo) is det. :- impure pred impure_wait(semaphore::in) is det. :- impure pred impure_try_wait(semaphore::in, bool::out) is det. :- impure pred impure_signal(semaphore::in) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- pragma foreign_decl("C", " #include #include ""mercury_context.h"" #include ""mercury_thread.h"" typedef struct ML_SEMAPHORE_STRUCT { MR_Integer count; #ifndef MR_HIGHLEVEL_CODE MR_Context *suspended_head; MR_Context *suspended_tail; #else #ifdef MR_THREAD_SAFE MercuryCond cond; #endif #endif #ifdef MR_THREAD_SAFE MercuryLock lock; #endif } ML_Semaphore; "). :- pragma foreign_code("C#", " public class ML_Semaphore { public int count; }; "). % XXX the struct tag works around bug #19 in high-level C grades :- pragma foreign_type("C", semaphore, "struct ML_SEMAPHORE_STRUCT *", [can_pass_as_mercury_type]). :- pragma foreign_type("C#", semaphore, "thread__semaphore.ML_Semaphore"). :- pragma foreign_type("Java", semaphore, "jmercury.runtime.Semaphore"). :- pragma foreign_decl("C", " extern void ML_finalize_semaphore(void *obj, void *cd); "). %---------------------------------------------------------------------------% impure_init(Semaphore) :- impure impure_init(0, Semaphore). :- pragma foreign_proc("C", impure_init(Count::in, Semaphore::uo), [will_not_call_mercury, thread_safe], " ML_Semaphore *sem; MR_incr_hp_type_msg(sem, ML_Semaphore, MR_ALLOC_ID, ""thread.semaphore.semaphore/0""); sem->count = Count; #ifndef MR_HIGHLEVEL_CODE sem->suspended_head = NULL; sem->suspended_tail = NULL; #else #ifdef MR_THREAD_SAFE pthread_cond_init(&(sem->cond), MR_COND_ATTR); #endif #endif #ifdef MR_THREAD_SAFE pthread_mutex_init(&(sem->lock), MR_MUTEX_ATTR); #endif // The condvar and the mutex will need to be destroyed // when the semaphore is garbage collected. MR_GC_register_finalizer(sem, ML_finalize_semaphore, NULL); Semaphore = sem; "). :- pragma foreign_proc("C#", impure_init(Count::in, Semaphore::uo), [will_not_call_mercury, thread_safe], " Semaphore = new thread__semaphore.ML_Semaphore(); Semaphore.count = Count; "). :- pragma foreign_proc("Java", impure_init(Count::in, Semaphore::uo), [will_not_call_mercury, thread_safe], " Semaphore = new jmercury.runtime.Semaphore(Count); "). :- pragma foreign_code("C", " void ML_finalize_semaphore(void *obj, void *cd) { ML_Semaphore *sem; sem = (ML_Semaphore *) obj; #if defined(MR_THREAD_SAFE) #if defined(MR_HIGHLEVEL_CODE) pthread_cond_destroy(&(sem->cond)); #endif pthread_mutex_destroy(&(sem->lock)); #endif } "). %---------------------------------------------------------------------------% % impure_signal causes the calling context to resume in semaphore.nop, % which simply jumps to the succip. That will return control to the caller % of semaphore.signal as intended, but not if this procedure is inlined. % % XXX get rid of this limitation at some stage. % :- pragma no_inline(pred(semaphore.impure_signal/1)). :- pragma foreign_proc("C", impure_signal(Semaphore::in), [will_not_call_mercury, thread_safe], " ML_Semaphore *sem; #ifndef MR_HIGHLEVEL_CODE MR_Context *ctxt; #endif sem = (ML_Semaphore *) Semaphore; MR_LOCK(&(sem->lock), ""semaphore.signal""); #ifndef MR_HIGHLEVEL_CODE if (sem->count >= 0 && sem->suspended_head != NULL) { // Reschedule the context at the start of the queue. ctxt = sem->suspended_head; sem->suspended_head = ctxt->MR_ctxt_next; if (sem->suspended_tail == ctxt) { sem->suspended_tail = ctxt->MR_ctxt_next; assert(sem->suspended_tail == NULL); } MR_UNLOCK(&(sem->lock), ""semaphore.signal""); MR_schedule_context(ctxt); // yield() // This context switch can be done more directly and faster. MR_save_context(MR_ENGINE(MR_eng_this_context)); #ifdef ML_THREAD_AVOID_LABEL_ADDRS MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume = MR_ENTRY(mercury__thread__semaphore__nop); #else MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume = &&signal_skip_to_the_end_1; #endif MR_schedule_context(MR_ENGINE(MR_eng_this_context)); MR_ENGINE(MR_eng_this_context) = NULL; MR_idle(); #ifndef ML_THREAD_AVOID_LABEL_ADDRS signal_skip_to_the_end_1: ; #endif } else { sem->count++; MR_UNLOCK(&(sem->lock), ""semaphore.signal""); // yield() MR_save_context(MR_ENGINE(MR_eng_this_context)); #ifdef ML_THREAD_AVOID_LABEL_ADDRS MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume = MR_ENTRY(mercury__thread__semaphore__nop); #else MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume = &&signal_skip_to_the_end_2; #endif MR_schedule_context(MR_ENGINE(MR_eng_this_context)); MR_ENGINE(MR_eng_this_context) = NULL; MR_idle(); #ifndef ML_THREAD_AVOID_LABEL_ADDRS signal_skip_to_the_end_2: ; #endif } #else sem->count++; MR_COND_SIGNAL(&(sem->cond), ""semaphore.signal""); MR_UNLOCK(&(sem->lock), ""semaphore.signal""); #endif "). :- pragma foreign_proc("C#", impure_signal(Semaphore::in), [will_not_call_mercury, thread_safe], " System.Threading.Monitor.Enter(Semaphore); Semaphore.count++; // XXX I think we only need to do a Pulse. System.Threading.Monitor.PulseAll(Semaphore); System.Threading.Monitor.Exit(Semaphore); "). :- pragma foreign_proc("Java", impure_signal(Semaphore::in), [will_not_call_mercury, thread_safe], " Semaphore.release(); "). %---------------------------------------------------------------------------% % impure_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. % % XXX get rid of this limitation at some stage. % :- pragma no_inline(pred(impure_wait/1)). :- pragma foreign_proc("C", impure_wait(Semaphore::in), [will_not_call_mercury, thread_safe], " ML_Semaphore *sem; #ifndef MR_HIGHLEVEL_CODE MR_Context *ctxt; #endif sem = (ML_Semaphore *) Semaphore; MR_LOCK(&(sem->lock), ""semaphore.wait""); #ifndef MR_HIGHLEVEL_CODE if (sem->count > 0) { sem->count--; MR_UNLOCK(&(sem->lock), ""semaphore.wait""); } else { MR_save_context(MR_ENGINE(MR_eng_this_context)); // Put the current context at the end of the queue. ctxt = MR_ENGINE(MR_eng_this_context); #ifdef ML_THREAD_AVOID_LABEL_ADDRS ctxt->MR_ctxt_resume = MR_ENTRY(mercury__thread__semaphore__nop); #else ctxt->MR_ctxt_resume = &&wait_skip_to_the_end; #endif ctxt->MR_ctxt_next = NULL; if (sem->suspended_tail) { sem->suspended_tail->MR_ctxt_next = ctxt; sem->suspended_tail = ctxt; } else { sem->suspended_head = ctxt; sem->suspended_tail = ctxt; } MR_UNLOCK(&(sem->lock), ""semaphore.wait""); // Make the current engine do something else. MR_ENGINE(MR_eng_this_context) = NULL; MR_idle(); #ifndef ML_THREAD_AVOID_LABEL_ADDRS wait_skip_to_the_end: ; #endif } #else while (sem->count <= 0) { // Although it goes against the spec, pthread_cond_wait() can return // prematurely with the error code EINTR in glibc 2.3.2 // if the thread is sent a signal. while (MR_COND_WAIT(&(sem->cond), &(sem->lock), ""semaphore.wait"") != 0) { // do nothing } } sem->count--; MR_UNLOCK(&(sem->lock), ""semaphore.wait""); #endif "). :- pragma foreign_proc("C#", impure_wait(Semaphore::in), [will_not_call_mercury, thread_safe], " System.Threading.Monitor.Enter(Semaphore); while (Semaphore.count <= 0) { System.Threading.Monitor.Wait(Semaphore); } Semaphore.count--; System.Threading.Monitor.Exit(Semaphore); "). :- pragma foreign_proc("Java", impure_wait(Semaphore::in), [will_not_call_mercury, thread_safe], " // acquire() might be useful as well; it will throw an exception // if the thread is interrupted. Semaphore.acquireUninterruptibly(); "). %---------------------------------------------------------------------------% impure_try_wait(Sem, Res) :- impure impure_try_wait_2(Sem, Res0), Res = ( if Res0 = 0 then yes else no ). :- impure pred impure_try_wait_2(semaphore::in, int::out) is det. :- pragma foreign_proc("C", impure_try_wait_2(Semaphore::in, Res::out), [will_not_call_mercury, thread_safe], " ML_Semaphore *sem; sem = (ML_Semaphore *) Semaphore; MR_LOCK(&(sem->lock), ""semaphore.try_wait""); if (sem->count > 0) { sem->count--; MR_UNLOCK(&(sem->lock), ""semaphore.try_wait""); Res = 0; } else { MR_UNLOCK(&(sem->lock), ""semaphore.try_wait""); Res = 1; } "). :- pragma foreign_proc("C#", impure_try_wait_2(Semaphore::in, Res::out), [will_not_call_mercury, thread_safe], " if (System.Threading.Monitor.TryEnter(Semaphore)) { if (Semaphore.count > 0) { Semaphore.count--; System.Threading.Monitor.Exit(Semaphore); Res = 0; } else { System.Threading.Monitor.Exit(Semaphore); Res = 1; } } else { Res = 1; } "). :- pragma foreign_proc("Java", impure_try_wait_2(Semaphore::in, Res::out), [will_not_call_mercury, thread_safe], " Res = Semaphore.tryAcquire() ? 0 : 1; "). %---------------------------------------------------------------------------% :- pragma foreign_decl("C", " /* INIT mercury_sys_init_semaphore_modules */ #ifndef MR_HIGHLEVEL_CODE MR_define_extern_entry(mercury__thread__semaphore__nop); #endif "). :- pragma foreign_code("C", " #ifndef MR_HIGHLEVEL_CODE MR_BEGIN_MODULE(hand_written_semaphores_module) MR_init_entry_ai(mercury__thread__semaphore__nop); MR_BEGIN_CODE MR_define_entry(mercury__thread__semaphore__nop); { MR_proceed(); } MR_END_MODULE #endif // Forward decls to suppress gcc warnings. void mercury_sys_init_semaphore_modules_init(void); void mercury_sys_init_semaphore_modules_init_type_tables(void); #ifdef MR_DEEP_PROFILING void mercury_sys_init_semaphore_modules_write_out_proc_statics( FILE *deep_fp, FILE *procrep_fp); #endif void mercury_sys_init_semaphore_modules_init(void) { #ifndef MR_HIGHLEVEL_CODE hand_written_semaphores_module(); #endif } void mercury_sys_init_semaphore_modules_init_type_tables(void) { // No types to register. } #ifdef MR_DEEP_PROFILING void mercury_sys_init_semaphore_modules_write_out_proc_statics( FILE *deep_fp, FILE *procrep_fp) { // No proc_statics to write out. } #endif "). %---------------------------------------------------------------------------% :- end_module thread.semaphore. %---------------------------------------------------------------------------%