paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 21:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* WebAssembly threads: bug fixes in LockMutexTimeoutWait

Browse Source
This commit is contained in:
Nikolay Nikolov 2024-08-03 01:29:04 +03:00
parent 8708144c50
commit 692bd62359
1 changed files with 28 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
rtl/wasi/wasmmutex.inc
View File

@ -104,6 +104,7 @@ Var
Res : TLockMutexResult;
MyThread : TThreadID;
EndTime: TOSTime;
RemainingTime: Int64;
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutWait('+IntToStr(m.locked)+','+intToStr(aTimeOutNS)+')');{$ENDIF}
@ -112,30 +113,37 @@ begin
if aTimeOutNS>=0 then
EndTime:=GetClockTime+aTimeOutNS
else
EndTime:=0;
begin
EndTime:=0;
RemainingTime:=-1;
end;
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;
if TryLockMutex(m) then
Res:=lmrOk
else
begin
if aTimeOutNS>=0 then
begin
RemainingTime:=EndTime-GetClockTime;
if RemainingTime<0 then
Res:=lmrTimeOut;;
end;
1 : Res:=lmrError;
2 : begin
if M.Destroying then
Res:=lmrError
else if (GetThreadState(MyThread)<>tsRunning) then
Res:=lmrError
else
begin
If (aTimeOutNS>=0) and (GetClockTime>EndTime) then
Res:=lmrTimeOut
end;
end;
end;
if Res<>lmrNone then
Case fpc_wasm32_memory_atomic_wait32(@M.Locked,1,RemainingTime) of
0, 1:
if M.Destroying then
Res:=lmrError;
2:
if M.Destroying then
Res:=lmrError
else if (GetThreadState(MyThread)<>tsRunning) then
Res:=lmrError
else
Res:=lmrTimeOut;
end;
end;
Until Res<>lmrNone;
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('LockMutexTimeoutWait: done loop');{$ENDIF}
InterLockedDecrement(M.Waiters);