A mostly working thread safe augmented assignment operation on hash tables

Author: jkyang92

M2/Macaulay2/d/evaluate.d

@@ -1285,6 +1285,55 @@ maybeUnlock(x:HashTableOrNull):void := (
 	if !y.beingInitialized then unlock(y.mutex))
     else nothing);
 
+--what about mutable lists?
+--assumes that the table has been locked on
+hashTableAugmentedAssignmentFun(lhs:binaryCode, oper1: Symbol, oper:Symbol, rexpr:Expr, rpos:Position):Expr := (
+    lexpr := nullE;
+    key := nullE;
+    table := eval(lhs.lhs);
+    when table
+    is Error do return table
+    is hashTable:HashTable do (
+        if lhs.f == DotS.symbol.binary then (
+            --this replicates dotfun from actors5.d but using the non-locking variation of lookup1force
+            when lhs.rhs
+            is r:globalSymbolClosureCode do (
+                key = Expr(SymbolClosure(globalFrame,r.symbol));
+                lexpr = lookup1forceNoLock(hashTable, key))
+            else nothing) --TODO correct error message printErrorMessageE(rhs,"expected a symbol"))
+        else if lhs.f == SharpS.symbol.binary then (
+            --TODO
+            key = eval(lhs.rhs);
+            lexpr = lookup1forceNoLock(hashTable, key)
+        )
+        else (
+            --this case should be impossible
+            return nullE;
+        );
+        meth := lookup(Class(lexpr), Expr(SymbolClosure(globalFrame, oper1)));
+        if meth != nullE then (
+            r := applyEEE(meth,lexpr,rexpr);--TODO what if meth tries to assign to the same hash table
+            --check if the returned value is the symbol "Default"
+	    when r
+            is s:SymbolClosure do (
+       	        if (s.symbol.word.name === "Default") then nothing
+	        else (
+                    return r
+                )
+            )
+            else (
+	        return r;
+	    )
+        );
+        left := evaluatedCode(lexpr, codePosition(Code(lhs)));
+        right := evaluatedCode(rexpr, rpos);
+        r := eval(Code(binaryCode(oper.binary, Code(left), right, rpos)));
+        --r := oper.binary(Code(left),Code(right));
+        storeInHashTableNoLock(hashTable,key,hash(key),r);
+        r)
+    else WrongArgHashTable(1)
+    );
+
 augmentedAssignmentFun(x:augmentedAssignmentCode):Expr := (
     when lookup(x.oper.word, augmentedAssignmentOperatorTable)
     is null do buildErrorPacket("unknown augmented assignment operator")
@@ -1293,17 +1342,58 @@ augmentedAssignmentFun(x:augmentedAssignmentCode):Expr := (
 	table := maybeLock(x.lhs);
 	-- evaluate the left-hand side first
 	lexpr := nullE;
+	-- this will eventually hold the value to assign
 	if s.word.name === "??" -- x ??= y is treated like x ?? (x = y)
 	then (
+	    maybeUnlock(table);
 	    e := nullify(x.lhs);
 	    when e
-	    is Nothing do nothing
+	    is Nothing do (
+		return when x.lhs
+		is y:globalMemoryReferenceCode do (
+		    r := eval(x.rhs);
+		    when r is e:Error do r
+		    else globalAssignment(y.frameindex, x.info, r))
+		is y:localMemoryReferenceCode do (
+		    r := eval(x.rhs);
+		    when r is e:Error do r
+		    else localAssignment(y.nestingDepth, y.frameindex, r))
+		is y:threadMemoryReferenceCode do (
+		    r := eval(x.rhs);
+		    when r is e:Error do r
+		    else globalAssignment(y.frameindex, x.info, r))
+		is y:binaryCode do (
+		    r := x.rhs;
+		    if y.f == DotS.symbol.binary || y.f == SharpS.symbol.binary
+		    then (
+			z := AssignElemFun(y.lhs, y.rhs, r);
+			z)
+		    else InstallValueFun(CodeSequence(
+			    convertGlobalOperator(x.info), y.lhs, y.rhs, r)))
+		is y:adjacentCode do (
+		    r := x.rhs;
+		    InstallValueFun(CodeSequence(
+			    convertGlobalOperator(AdjacentS.symbol), y.lhs, y.rhs, r)))
+		is y:unaryCode do (
+		    r := x.rhs;
+		    UnaryInstallValueFun(convertGlobalOperator(x.info), y.rhs, r))
+		else buildErrorPacket(
+		    "augmented assignment not implemented for this code")
+		)
 	    else (
-		maybeUnlock(table);
 		return e))
-	else lexpr = eval(x.lhs);
+	else (
+            when table is hashTable:HashTable do (
+                when x.lhs is y:binaryCode do (
+                    r := hashTableAugmentedAssignmentFun(y, x.oper, s, eval(x.rhs), codePosition(x.rhs));
+	            unlock(hashTable.mutex);
+	            return r)
+                else nothing; --this case should be impossible
+                )
+            else nothing;
+            lexpr = eval(x.lhs)
+            );
 	when lexpr is e:Error do (
-	    maybeUnlock(table);
 	    return lexpr)
 	else nothing;
 	-- check if user-defined method exists
@@ -1319,10 +1409,8 @@ augmentedAssignmentFun(x:augmentedAssignmentCode):Expr := (
 	    is s:SymbolClosure do (
 		if s.symbol.word.name === "Default" then nothing
 		else (
-		    maybeUnlock(table);
 		    return r))
 	    else (
-		maybeUnlock(table);
 		return r));
 	-- if not, use default behavior
 	left := evaluatedCode(lexpr, codePosition(x.lhs));
@@ -1344,7 +1432,6 @@ augmentedAssignmentFun(x:augmentedAssignmentCode):Expr := (
 	    if y.f == DotS.symbol.binary || y.f == SharpS.symbol.binary
 	    then (
 		z := AssignElemFun(y.lhs, y.rhs, r);
-		maybeUnlock(table);
 		z)
 	    else InstallValueFun(CodeSequence(
 		    convertGlobalOperator(x.info), y.lhs, y.rhs, r)))

M2/Macaulay2/d/hashtables.dd

@@ -107,6 +107,38 @@ export remove(x:HashTable,key:Expr):Expr := (
 	  p = p.next);
      if !x.beingInitialized then unlock(x.mutex);
      ret);
+
+export storeInHashTableNoLock(x:HashTable,key:Expr,h:hash_t,value:Expr):Expr := (
+     if !x.Mutable then return buildErrorPacket("attempted to modify an immutable hash table");
+     hmod := int(h & (length(x.table)-1));
+     p := x.table.hmod;
+     while p != p.next do (
+	  if p.key == key || equal(p.key,key)==True 
+	  then (
+	       p.value = value;
+	       if !x.beingInitialized then unlock(x.mutex);
+	       return value);
+	  p = p.next);
+     if 4 * x.numEntries == 3 * length(x.table) -- SEE ABOVE
+     then (
+	  enlarge(x);
+	  hmod = int(h & (length(x.table)-1));
+	  );
+     -- Old comments:
+     -- In the following statement, a new entry is adding by atomically replacing the pointer x.table.hmod.
+     -- This will not confuse readers that don't lock the hash table, because once the load x.table.hmod, they
+     -- will have a linked list that stays the same, is shortened, or has a value changed, and contains no
+     -- duplicate entries.  Adding a new entry by appending to the end of the list, on the other hand, might
+     -- cause a reader to encounter the same key twice, if the key is removed and added while the reader is
+     -- traversing the list.
+     x.table.hmod = KeyValuePair(key,h,value,x.table.hmod);
+     --Do not increment numEntries until after new value pair has been inserted to maintain consistency.
+     --It is necessary to throw in a compilerBarrier to ensure that there is no memory reordering
+     -- compilerBarrier();
+     x.numEntries = x.numEntries + 1;
+     --Note: x.numEntries may be inconsistent with the number of entries in the table if accessed from another thread
+     value);
+
 export storeInHashTable(x:HashTable,key:Expr,h:hash_t,value:Expr):Expr := (
      if !x.Mutable then return buildErrorPacket("attempted to modify an immutable hash table");
      if !x.beingInitialized then lockWrite(x.mutex);
@@ -327,6 +359,22 @@ KeyNotFound(object:string, key:Expr):Expr := (
 	is str:stringCell do msg = str.v else nothing);
     buildErrorPacket(msg));
 
+--Don't lock the table, used for augmented assignments
+export lookup1forceNoLock(object:HashTable, key:Expr, keyhash:hash_t):Expr := (
+     res := notfoundE;
+     keymod := int(keyhash & (length(object.table)-1));
+     bucket := object.table.keymod;
+     while bucket != bucket.next do (
+	  if bucket.key == key || bucket.hash == keyhash && equal(bucket.key,key)==True then (
+	       res = bucket.value;
+	       break);
+	  bucket = bucket.next;
+	  );
+     if res != notfoundE then res
+     else KeyNotFound("hash table", key)
+);
+export lookup1forceNoLock(object:HashTable, key:Expr):Expr := lookup1forceNoLock(object,key,hash(key));
+
 export lookup1(object:HashTable,key:Expr,keyhash:hash_t):Expr := (
      -- warning: can return notfoundE, which should not be given to the user
      res := notfoundE;