{%MainUnit system.pp} // In nanoseconds Type // We us an alias here. TWasmMutex = TRTLCriticalSection; TMutexKind = (mkNormal,mkRecursive); TLockMutexResult = (lmrNone,lmrOK,lmrNotOwner,lmrError,lmrTimeout); Function MutexKind(M : TWasmMutex) : TMutexKind; begin Result:=TMutexKind(M.Kind); end; procedure InitMutex(M : TWasmMutex; aKind : TMutexKind = mkNormal; aOwner : TThreadID = Nil); begin FillChar(M,SizeOf(TWasmMutex),0); if aOwner=Nil then aOwner:=GetSelfThread; M.Owner:=aOwner; M.Kind:=Ord(aKind); end; procedure DoneMutex(M : TWasmMutex); Var a : LongInt; begin if (M.Locked>0) and (M.Owner=GetSelfThread) then begin M.Destroying:=True; a:=fpc_wasm32_memory_atomic_notify(@M.Locked,MaxThreadSignal); end; end; Function TryLockMutex(var M : TWasmMutex) : Boolean; Var Res : Boolean; begin // We already have the lock ? Res:=(M.Locked=1) and (M.Owner=GetSelfThread); if Not Res then Res:=fpc_wasm32_i32_atomic_rmw_cmpxchg_u(@M.Locked,0,1)=0 else begin // TryLockMutex is called in a loop. Be VERY careful when adding this log. // {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TryLockMutex : we ('+IntToStr(PtrUint(GetSelfThread))+') own the lock.');{$ENDIF} end; if Res then begin if (MutexKind(M)=mkRecursive) or (M.Count=0) then InterLockedIncrement(M.Count); // {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TryLockMutex : setting owner to '+IntToStr(PtrUint(GetSelfThread))+'.');{$ENDIF} M.Owner:=GetSelfThread; end; TryLockMutex:=Res; end; // aTimeOutNS is in milliseconds. -1 is infinite Function LockMutexTimeoutNoWait(var m : TWasmMutex; aTimeOutMS : LongInt) : TLockMutexResult; Var Res : TLockMutexResult; MyThread : TThreadID; EndTime: TOSTime; begin {$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutNoWait('+IntToStr(m.locked)+','+intToStr(aTimeOutMs)+')');{$ENDIF} Res:=lmrNone; EndTime:=GetClockTime+aTimeOutMS*1000; MyThread:=GetSelfThread; {$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutNoWait: entering loop');{$ENDIF} Repeat if TryLockMutex(M) then Result:=lmrOK else begin If (GetThreadState(MyThread)<>tsRunning) then Res:=lmrError else begin If (aTimeOutMS<>-1) and (GetClockTime>EndTime) then Res:=lmrTimeOut end; end; Until (res<>lmrNone); {$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutNoWait: done loop');{$ENDIF} LockMutexTimeoutNoWait:=Res; end; Function LockMutexTimeoutWait(var m : TWasmMutex; aTimeOutMS : LongInt) : TLockMutexResult; Var Res : TLockMutexResult; MyThread : TThreadID; EndTime: TOSTime; begin {$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutWait('+IntToStr(m.locked)+','+intToStr(aTimeOutMs)+')');{$ENDIF} Res:=lmrNone; MyThread:=GetSelfThread; EndTime:=GetClockTime+aTimeOutMS*1000; InterLockedIncrement(M.Waiters); {$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutWait: entering loop');{$ENDIF} Repeat Case fpc_wasm32_memory_atomic_wait32(@M.Locked,1,1000) of 0 : begin if M.Destroying then Res:=lmrError else Res:=lmrOK; end; 1 : Res:=lmrError; 2 : begin if M.Destroying then Res:=lmrError else if (GetThreadState(MyThread)<>tsRunning) then Res:=lmrError else begin If (aTimeOutMS<>-1) and (GetClockTime>EndTime) then Res:=lmrTimeOut end; end; end; Until Res<>lmrNone; {$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutWait: done loop');{$ENDIF} InterLockedDecrement(M.Waiters); LockMutexTimeoutWait:=Res; end; Function LockMutexTimeout(var m : TWasmMutex; aTimeOutMS : Int64) : TLockMutexResult; begin if TryLockMutex(M) then Result:=lmrOK else if isWaitAllowed then Result:=LockMutexTimeoutWait(m,aTimeOutMS) else Result:=LockMutexTimeoutNoWait(m,aTimeOutMS) end; Function LockMutex(var m : TRTLCriticalSection) : TLockMutexResult; begin LockMutexTimeout(M,-1); end; function UnLockMutex(var m : TRTLCriticalSection) : TLockMutexResult; var Res : TLockMutexResult; MyThread : TThreadID; EndTime: TOSTime; a : LongInt; begin Res:=lmrNone; MyThread:=GetSelfThread; if MyThread<>M.owner then Res:=lmrNotOwner else if M.Count=0 then Res:=lmrError else begin res:=lmrOK; if (MutexKind(M)=mkRecursive) or (M.Count=1) then InterLockedDecrement(M.Count); if (M.Count=0) then a:=fpc_wasm32_memory_atomic_notify(@M.Locked,1); end; end;