Add top-level mutex class

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("<<a mutex>>")
 );
 setupfun("simpleToString",tostringfun);
 

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 := (

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

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:

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!
 
 

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

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:

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()");
 

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",

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:

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:

M2/Macaulay2/m2/loadsequence

@@ -6,6 +6,7 @@ shared.m2
 autoload.m2
 system.m2
 regex.m2
+threads.m2
 
 profile.m2
 debugging.m2

M2/Macaulay2/m2/threads.m2

@@ -0,0 +1,55 @@
+-----------------------------------------------------------------------------
+-- 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
+
+-----------------------------------------------------------------------------
+-- 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) ->
+     -- '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);

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)