From e5c707d47de56cd4ee59915ba30a4fc87e2ad0d9 Mon Sep 17 00:00:00 2001 From: Doug Torrance Date: Fri, 18 Apr 2025 10:33:46 -0400 Subject: [PATCH 1/6] Add new Mutex class (wrapper around pthread_mutex_t) --- M2/Macaulay2/d/actors4.d | 1 + M2/Macaulay2/d/basic.d | 1 + M2/Macaulay2/d/classes.dd | 2 ++ M2/Macaulay2/d/equality.dd | 4 ++++ M2/Macaulay2/d/expr.d | 1 + M2/Macaulay2/d/parse.d | 4 +++- 6 files changed, 12 insertions(+), 1 deletion(-) diff --git a/M2/Macaulay2/d/actors4.d b/M2/Macaulay2/d/actors4.d index 93402ef6c79..2c4c7da5485 100644 --- a/M2/Macaulay2/d/actors4.d +++ b/M2/Macaulay2/d/actors4.d @@ -1037,6 +1037,7 @@ tostringfun(e:Expr):Expr := ( Ccode(void, "sprintf((char *)", buf, "->array, \"%d\", ", load(x.v), ")"); Ccode(void, buf, "->len = strlen((char *)", buf, "->array)"); toExpr(buf)) + is x:mutexCell do toExpr("<>") ); setupfun("simpleToString",tostringfun); diff --git a/M2/Macaulay2/d/basic.d b/M2/Macaulay2/d/basic.d index f0a22f9a839..7748342e218 100644 --- a/M2/Macaulay2/d/basic.d +++ b/M2/Macaulay2/d/basic.d @@ -72,6 +72,7 @@ export hash(e:Expr):hash_t := ( -- cast to long first to avoid "different size" compiler warning is x:pointerCell do Ccode(hash_t, "(long)", x.v) is x:atomicIntCell do x.hash + is x:mutexCell do x.hash ); export hash(x:List):hash_t := ( diff --git a/M2/Macaulay2/d/classes.dd b/M2/Macaulay2/d/classes.dd index 8bcf7fea0f3..869d5bfa54b 100644 --- a/M2/Macaulay2/d/classes.dd +++ b/M2/Macaulay2/d/classes.dd @@ -82,6 +82,7 @@ setupconst("Task",Expr(taskClass)); setupconst("FileOutputSyncState",Expr(fileOutputSyncStateClass)); setupconst("Pointer",Expr(pointerClass)); setupconst("AtomicInt",Expr(atomicIntClass)); +setupconst("Mutex",Expr(mutexClass)); export ancestor(o:HashTable,p:HashTable):bool := ( while true do ( @@ -175,6 +176,7 @@ export Class(e:Expr):HashTable := ( is fileOutputSyncState do fileOutputSyncStateClass is pointerCell do pointerClass is atomicIntCell do atomicIntClass + is mutexCell do mutexClass ); classfun(e:Expr):Expr := Expr(Class(e)); -- # typical value: class, Thing, Type diff --git a/M2/Macaulay2/d/equality.dd b/M2/Macaulay2/d/equality.dd index c34f82e85bf..c4eda7ae6b8 100644 --- a/M2/Macaulay2/d/equality.dd +++ b/M2/Macaulay2/d/equality.dd @@ -259,6 +259,10 @@ export equal(lhs:Expr,rhs:Expr):Expr := ( when rhs is y:atomicIntCell do if x == y then True else False else False) + is x:mutexCell do ( + when rhs + is y:mutexCell do if x == y then True else False + else False) ); -- Local Variables: diff --git a/M2/Macaulay2/d/expr.d b/M2/Macaulay2/d/expr.d index 7958fd5a315..29052c0137e 100644 --- a/M2/Macaulay2/d/expr.d +++ b/M2/Macaulay2/d/expr.d @@ -355,6 +355,7 @@ export RRiClass := newbignumbertype(); export pointerClass := newbasictype(); export atomicIntClass := newbasictype(); export pseudocodeClosureClass := newtypeof(pseudocodeClass); +export mutexClass := newbasictype(); -- all new types, dictionaries, and classes go just above this line, if possible, so hash codes don't change gratuitously! diff --git a/M2/Macaulay2/d/parse.d b/M2/Macaulay2/d/parse.d index daf87278af0..aca4e7e17fa 100644 --- a/M2/Macaulay2/d/parse.d +++ b/M2/Macaulay2/d/parse.d @@ -357,6 +357,7 @@ export TaskCell := {+ body:TaskCellBody }; export pointerCell := {+ v:voidPointer }; export atomicIntCell := {+ v:atomicField, hash:hash_t }; +export mutexCell := {+ v:ThreadMutex, hash:hash_t }; export Expr := ( CCcell or @@ -414,7 +415,8 @@ export Expr := ( TaskCell or fileOutputSyncState or pointerCell or - atomicIntCell + atomicIntCell or + mutexCell ); --Unique True expression From c5fa7b5079e0e2fd18539fc2e1d1b4154d96cbc8 Mon Sep 17 00:00:00 2001 From: Doug Torrance Date: Fri, 18 Apr 2025 12:06:00 -0400 Subject: [PATCH 2/6] Add interpreter-level mutex methods --- M2/Macaulay2/d/pthread.d | 48 +++++++++++++++++++++++++++++++++++++++ M2/Macaulay2/d/pthread0.d | 1 + 2 files changed, 49 insertions(+) diff --git a/M2/Macaulay2/d/pthread.d b/M2/Macaulay2/d/pthread.d index acd635f8e95..f047ee10a1b 100644 --- a/M2/Macaulay2/d/pthread.d +++ b/M2/Macaulay2/d/pthread.d @@ -231,6 +231,54 @@ export getIOThreadMode(e:Expr):Expr := ( else WrongArg("a file or ()")); setupfun("getIOThreadMode", getIOThreadMode); +WrongArgMutex():Expr := WrongArg("a mutex"); + +mutexFinalizer(obj:voidPointer, data:voidPointer):void := ( + mutex := Ccode(ThreadMutex, "*(pthread_mutex_t *)", obj); + destroy(mutex);); + +mutexInit(e:Expr):Expr := ( + when e + is HashTable do ( + ptr := GCmalloc(Pointer "pthread_mutex_t *"); + mutex := Ccode(ThreadMutex, "*", ptr); + r := init(mutex); + if r != 0 then return buildErrorPacketErrno("pthread_mutex_init", r); + Ccode(void, "GC_REGISTER_FINALIZER(", ptr, ", ", + "(GC_finalization_proc)", mutexFinalizer, ", NULL, NULL, NULL)"); + cell := mutexCell(mutex, hash_t(0)); + cell.hash = hashFromAddress(Expr(cell)); + Expr(cell)) + else WrongArgHashTable()); +installMethod(NewS, mutexClass, mutexInit); + +lock(e:Expr):Expr := ( + when e + is m:mutexCell do ( + r := lock(m.v); + if r == 0 then nullE + else buildErrorPacketErrno("pthread_mutex_lock", r)) + else WrongArgMutex()); +setupfun("lock0", lock); + +trylock(e:Expr):Expr := ( + when e + is m:mutexCell do ( + r := trylock(m.v); + if r == 0 then nullE + else buildErrorPacketErrno("pthread_mutex_trylock", r)) + else WrongArgMutex()); +setupfun("tryLock0", trylock); + +unlock(e:Expr):Expr := ( + when e + is m:mutexCell do ( + r := unlock(m.v); + if r == 0 then nullE + else buildErrorPacketErrno("pthread_mutex_unlock", r)) + else WrongArgMutex()); +setupfun("unlock0", unlock); + -- Local Variables: -- compile-command: "echo \"make: Entering directory \\`$M2BUILDDIR/Macaulay2/d'\" && make -C $M2BUILDDIR/Macaulay2/d pthread.o " -- End: diff --git a/M2/Macaulay2/d/pthread0.d b/M2/Macaulay2/d/pthread0.d index d6d2d6607cc..1210ffb168f 100644 --- a/M2/Macaulay2/d/pthread0.d +++ b/M2/Macaulay2/d/pthread0.d @@ -30,6 +30,7 @@ export SpinLock := atomicType "struct spinlockStructure"; export init(x:ThreadMutex) ::= Ccode(int, "pthread_mutex_init(&(",lvalue(x),"),NULL)"); export destroy(x:ThreadMutex) ::= Ccode(int, "pthread_mutex_destroy(&(",lvalue(x),"))"); export lock(x:ThreadMutex) ::= Ccode(int, "pthread_mutex_lock(&(",lvalue(x),"))"); +export trylock(x:ThreadMutex) ::= Ccode(int, "pthread_mutex_trylock(&(",lvalue(x),"))"); export unlock(x:ThreadMutex) ::= Ccode(int, "pthread_mutex_unlock(&(",lvalue(x),"))"); export getthreadself() ::= Ccode(Thread, "pthread_self()"); From 9e9315bb5bf7134ff800d91d95090436be4a8d68 Mon Sep 17 00:00:00 2001 From: Doug Torrance Date: Fri, 18 Apr 2025 12:08:14 -0400 Subject: [PATCH 3/6] Move AtomicInt and parallelApply to new threads.m2 --- M2/Macaulay2/m2/integers.m2 | 18 ------------------ M2/Macaulay2/m2/lists.m2 | 19 ------------------- M2/Macaulay2/m2/loadsequence | 1 + M2/Macaulay2/m2/threads.m2 | 35 +++++++++++++++++++++++++++++++++++ 4 files changed, 36 insertions(+), 37 deletions(-) create mode 100644 M2/Macaulay2/m2/threads.m2 diff --git a/M2/Macaulay2/m2/integers.m2 b/M2/Macaulay2/m2/integers.m2 index 1cb1eeb4a00..6b5dfb8f914 100644 --- a/M2/Macaulay2/m2/integers.m2 +++ b/M2/Macaulay2/m2/integers.m2 @@ -105,24 +105,6 @@ changeBase(String, ZZ) := ZZ => changeBase0 changeBase(String, ZZ, ZZ) := String => (s, oldbase, newbase) -> ( changeBase(changeBase(s, oldbase), newbase)) ------------------------------------------------------------------------------ --- AtomicInt ------------------------------------------------------------------------------ - -AtomicInt.synonym = "atomic integer" - -scan({symbol +=, symbol -=, symbol &=, symbol |=, symbol ^^=}, - op -> typicalValues#(op, AtomicInt) = ZZ) - -store = method() -store(AtomicInt, ZZ) := atomicStore - -exchange = method() -exchange(AtomicInt, ZZ) := atomicExchange - -compareExchange = method() -compareExchange(AtomicInt, ZZ, ZZ) := atomicCompareExchange - -- Local Variables: -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 " -- End: diff --git a/M2/Macaulay2/m2/lists.m2 b/M2/Macaulay2/m2/lists.m2 index d9f3f3edbfa..78abe9aae38 100644 --- a/M2/Macaulay2/m2/lists.m2 +++ b/M2/Macaulay2/m2/lists.m2 @@ -320,25 +320,6 @@ pack(ZZ, BasicList) := List => pack' pack(String, ZZ) := pack(BasicList, ZZ) := List => (L, n) -> pack'(n, L) ------------------------------------------------------------------------------ - -parallelApplyRaw = (L, f) -> - -- 'reverse's to minimize thread switching in 'taskResult's: - reverse (taskResult \ reverse apply(L, e -> schedule(f, e))); -parallelApply = method(Options => {Strategy => null}) -parallelApply(BasicList, Function) := o -> (L, f) -> ( - if o.Strategy === "raw" then return parallelApplyRaw(L, f); - n := #L; - numThreads := min(n + 1, maxAllowableThreads); - oldAllowableThreads := allowableThreads; - if allowableThreads < numThreads then allowableThreads = numThreads; - numChunks := 3 * numThreads; - res := if n <= numChunks then toList parallelApplyRaw(L, f) else - flatten parallelApplyRaw(pack(L, ceiling(n / numChunks)), chunk -> apply(chunk, f)); - allowableThreads = oldAllowableThreads; - res); - - -- Local Variables: -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 " -- End: diff --git a/M2/Macaulay2/m2/loadsequence b/M2/Macaulay2/m2/loadsequence index 39463b8c5a6..f3f2af4df01 100644 --- a/M2/Macaulay2/m2/loadsequence +++ b/M2/Macaulay2/m2/loadsequence @@ -6,6 +6,7 @@ shared.m2 autoload.m2 system.m2 regex.m2 +threads.m2 profile.m2 debugging.m2 diff --git a/M2/Macaulay2/m2/threads.m2 b/M2/Macaulay2/m2/threads.m2 new file mode 100644 index 00000000000..63dc3684bda --- /dev/null +++ b/M2/Macaulay2/m2/threads.m2 @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- AtomicInt +----------------------------------------------------------------------------- + +AtomicInt.synonym = "atomic integer" + +scan({symbol +=, symbol -=, symbol &=, symbol |=, symbol ^^=}, + op -> typicalValues#(op, AtomicInt) = ZZ) + +store = method() +store(AtomicInt, ZZ) := atomicStore + +exchange = method() +exchange(AtomicInt, ZZ) := atomicExchange + +compareExchange = method() +compareExchange(AtomicInt, ZZ, ZZ) := atomicCompareExchange + +----------------------------------------------------------------------------- + +parallelApplyRaw = (L, f) -> + -- 'reverse's to minimize thread switching in 'taskResult's: + reverse (taskResult \ reverse apply(L, e -> schedule(f, e))); +parallelApply = method(Options => {Strategy => null}) +parallelApply(BasicList, Function) := o -> (L, f) -> ( + if o.Strategy === "raw" then return parallelApplyRaw(L, f); + n := #L; + numThreads := min(n + 1, maxAllowableThreads); + oldAllowableThreads := allowableThreads; + if allowableThreads < numThreads then allowableThreads = numThreads; + numChunks := 3 * numThreads; + res := if n <= numChunks then toList parallelApplyRaw(L, f) else + flatten parallelApplyRaw(pack(L, ceiling(n / numChunks)), chunk -> apply(chunk, f)); + allowableThreads = oldAllowableThreads; + res); From 7592c1d5d97b84a6b536abc41bf057473cc5f1c3 Mon Sep 17 00:00:00 2001 From: Doug Torrance Date: Fri, 18 Apr 2025 12:31:25 -0400 Subject: [PATCH 4/6] Add mutex methods at top level --- M2/Macaulay2/m2/exports.m2 | 4 ++++ M2/Macaulay2/m2/threads.m2 | 20 ++++++++++++++++++++ 2 files changed, 24 insertions(+) diff --git a/M2/Macaulay2/m2/exports.m2 b/M2/Macaulay2/m2/exports.m2 index 354035d0a74..c8bb72b8eae 100644 --- a/M2/Macaulay2/m2/exports.m2 +++ b/M2/Macaulay2/m2/exports.m2 @@ -289,6 +289,7 @@ export { "MutableHashTable", "MutableList", "MutableMatrix", + "Mutex", "midpoint", "NCLex", "Name", @@ -890,6 +891,7 @@ export { "local", "localDictionaries", "locate", + "lock", "log", "log1p", "lookup", @@ -1228,6 +1230,7 @@ export { "truncate", "truncateOutput", "try", + "tryLock", "tutorial", "typicalValues", "uniquePermutations", @@ -1240,6 +1243,7 @@ export { "uninstallPackage", "union", "unique", + "unlock", "unsequence", "unstack", "urlEncode", diff --git a/M2/Macaulay2/m2/threads.m2 b/M2/Macaulay2/m2/threads.m2 index 63dc3684bda..2af6a95ca96 100644 --- a/M2/Macaulay2/m2/threads.m2 +++ b/M2/Macaulay2/m2/threads.m2 @@ -16,6 +16,26 @@ exchange(AtomicInt, ZZ) := atomicExchange compareExchange = method() compareExchange(AtomicInt, ZZ, ZZ) := atomicCompareExchange +----------------------------------------------------------------------------- +-- Mutex +----------------------------------------------------------------------------- + +Mutex.synonym = "mutex" +globalAssignment Mutex +net Mutex := x -> toString ( + if hasAttribute(x, ReverseDictionary) + then getAttribute(x, ReverseDictionary) + else x) + +lock = method() +lock Mutex := lock0 + +tryLock = method() +tryLock Mutex := tryLock0 + +unlock = method() +unlock Mutex := unlock0 + ----------------------------------------------------------------------------- parallelApplyRaw = (L, f) -> From feb48b0448c223d9b50c0df29fa62f7a0f46da45 Mon Sep 17 00:00:00 2001 From: Doug Torrance Date: Fri, 18 Apr 2025 13:26:43 -0400 Subject: [PATCH 5/6] Document mutexes --- .../packages/Macaulay2Doc/doc_atomic.m2 | 1 + .../packages/Macaulay2Doc/doc_mutex.m2 | 138 ++++++++++++++++++ M2/Macaulay2/packages/Macaulay2Doc/loads.m2 | 1 + .../packages/Macaulay2Doc/ov_types.m2 | 1 + 4 files changed, 141 insertions(+) create mode 100644 M2/Macaulay2/packages/Macaulay2Doc/doc_mutex.m2 diff --git a/M2/Macaulay2/packages/Macaulay2Doc/doc_atomic.m2 b/M2/Macaulay2/packages/Macaulay2Doc/doc_atomic.m2 index eda1b3f7db3..4176492c7fa 100644 --- a/M2/Macaulay2/packages/Macaulay2Doc/doc_atomic.m2 +++ b/M2/Macaulay2/packages/Macaulay2Doc/doc_atomic.m2 @@ -13,6 +13,7 @@ doc /// between $-2^{31}$ and $2^{31} - 1$. SeeAlso "parallel programming with threads and tasks" + Mutex Subnodes (NewFromMethod, AtomicInt, ZZ) (NewFromMethod, ZZ, AtomicInt) diff --git a/M2/Macaulay2/packages/Macaulay2Doc/doc_mutex.m2 b/M2/Macaulay2/packages/Macaulay2Doc/doc_mutex.m2 new file mode 100644 index 00000000000..d9cc1315d0e --- /dev/null +++ b/M2/Macaulay2/packages/Macaulay2Doc/doc_mutex.m2 @@ -0,0 +1,138 @@ +doc /// + Key + Mutex + Headline + the class of mutexes + Description + Text + A @EM "mutex"@ (short for @EM "mutual exclusion"@) is a synchronization + primitive used to prevent multiple threads from accessing shared + data at the same time. It ensures that only one thread can hold + the lock at a time, which helps avoid race conditions in + concurrent programs. + + In Macaulay2, a @M2CODE "Mutex"@ object can be used to protect critical + sections of code. When a thread locks a mutex, other threads attempting + to lock it will wait until it is unlocked. + + For example, suppose multiple threads try to modify the same string. + Each thread will need to get the current value of the string, make its + modification, and then save the new value. However, there is a good + chance that another thread might save its updated value after another + thread has fetched it but before it saved the new value. We can + see this in the code below. + Example + msgs = "" + sayhello = i -> msgs |= "hello from thread #" | toString i | newline + T = apply(10, i -> schedule(() -> sayhello i)) + while not all(T, isReady) do null + stack sort lines msgs + Text + We likely ended up with fewer than the expected number of 10 messages. + We can get around this issue by using a mutex to lock the string so + that only one thread can modify it at a time. + Example + m = new Mutex + msgs = "" + T = apply(10, i -> schedule(() -> (lock m; sayhello i; unlock m))) + while not all(T, isReady) do null + stack sort lines msgs + Text + With the mutex, all 10 messages are present. + SeeAlso + "parallel programming with threads and tasks" + AtomicInt + Subnodes + (NewMethod, Mutex) + (lock, Mutex) + (tryLock, Mutex) + (unlock, Mutex) +/// + +doc /// + Key + (NewMethod, Mutex) + Headline + construct a mutex + Usage + new Mutex + Outputs + :Mutex + Description + Text + Construct a new @TO Mutex@ object. + Example + m = new Mutex +/// + +doc /// + Key + lock + (lock, Mutex) + Headline + lock a mutex + Usage + lock m + Inputs + m:Mutex + Description + Text + Locks a mutex. + Example + m = new Mutex + lock m + Text + If the mutex is already locked, then the thread blocks until it is + unlocked. This is not interruptible. + SeeAlso + (tryLock, Mutex) + (unlock, Mutex) +/// + +doc /// + Key + tryLock + (tryLock, Mutex) + Headline + try locking a mutex + Usage + tryLock m + Inputs + m:Mutex + Description + Text + Tries locking a mutex. + Example + m = new Mutex + tryLock m + Text + If the mutex is already locked, then an error is raised. + Example + stopIfError = false + tryLock m + SeeAlso + (lock, Mutex) + (unlock, Mutex) +/// + +doc /// + Key + unlock + (unlock, Mutex) + Headline + unlock a mutex + Usage + unlock m + Inputs + m:Mutex + Description + Text + Unlocks a mutex. + Example + m = new Mutex + lock m + unlock m + SeeAlso + (lock, Mutex) + (tryLock, Mutex) +/// diff --git a/M2/Macaulay2/packages/Macaulay2Doc/loads.m2 b/M2/Macaulay2/packages/Macaulay2Doc/loads.m2 index df8d62d6d9e..42c13f000d8 100644 --- a/M2/Macaulay2/packages/Macaulay2Doc/loads.m2 +++ b/M2/Macaulay2/packages/Macaulay2Doc/loads.m2 @@ -64,6 +64,7 @@ load "./operators.m2" load "./shared.m2" load "./doc_iterators.m2" load "./doc_atomic.m2" +load "./doc_mutex.m2" load "./options.m2" -- this must come last load "./undocumented.m2" diff --git a/M2/Macaulay2/packages/Macaulay2Doc/ov_types.m2 b/M2/Macaulay2/packages/Macaulay2Doc/ov_types.m2 index a0bf7371fd8..f7dc8fb11f7 100644 --- a/M2/Macaulay2/packages/Macaulay2Doc/ov_types.m2 +++ b/M2/Macaulay2/packages/Macaulay2Doc/ov_types.m2 @@ -524,6 +524,7 @@ document { File, --Function, AtomicInt, + Mutex, Symbol, Pseudocode --FunctionBody From 29d0f9864026708560bb4fd24cbd84af39e1f31e Mon Sep 17 00:00:00 2001 From: Doug Torrance Date: Fri, 18 Apr 2025 13:41:56 -0400 Subject: [PATCH 6/6] Add unit tests for mutexes --- M2/Macaulay2/tests/normal/threads.m2 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/M2/Macaulay2/tests/normal/threads.m2 b/M2/Macaulay2/tests/normal/threads.m2 index 312a42b3431..9cfe352da4e 100644 --- a/M2/Macaulay2/tests/normal/threads.m2 +++ b/M2/Macaulay2/tests/normal/threads.m2 @@ -85,6 +85,16 @@ assert Equation(getIOThreadMode f, 2) removeFile fn +-- mutexes +m = new Mutex + +lock m +unlock m + +assert try tryLock m then true else false +assert try tryLock m then false else true +unlock m + -- Local Variables: -- compile-command: "make -C $M2BUILDDIR/Macaulay2/packages/Macaulay2Doc/test threads.out" -- End: