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

* WebAssembly threads: RTLEvents rewritten to implement an auto reset event.

Browse Source 
Previous implementation did a manual reset event. However, at least on Windows
  and Linux, an auto reset event is used.
This commit is contained in:
Nikolay Nikolov 2024-08-21 18:02:56 +03:00
parent d3c902e5a1
commit 017b41de89
1 changed files with 72 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
rtl/wasi/systhrd.inc
View File

@ -209,21 +209,30 @@ Var
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : setting signal=1');{$ENDIF} {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : setting signal=1');{$ENDIF}
fpc_wasm32_i32_atomic_store(@P^.Signal,1); if fpc_wasm32_i32_atomic_rmw_cmpxchg_u(@P^.Signal,0,1)=0 then
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : notifying waiting threads');{$ENDIF} begin
a:=fpc_wasm32_memory_atomic_notify(@(P^.Signal),MaxThreadSignal); {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : notifying 1 waiting thread');{$ENDIF}
a:=fpc_wasm32_memory_atomic_notify(@(P^.Signal),1);
end
else
begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : signal was already 1, nothing to do');{$ENDIF}
end;
end; end;
procedure WasiRTLEventDestroy(AEvent:PRTLEvent); procedure WasiRTLEventDestroy(AEvent:PRTLEvent);
Var Var
P : PWasmRTLEvent absolute aEvent; P : PWasmRTLEvent absolute aEvent;
a : LongInt;
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : setting destroying to true');{$ENDIF} {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : setting destroying to true');{$ENDIF}
fpc_wasm32_i32_atomic_store8(@P^.Destroying,1); fpc_wasm32_i32_atomic_store8(@P^.Destroying,1);
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : setting event to notify others');{$ENDIF} {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : setting event to notify others');{$ENDIF}
WasiRTLEventSetEvent(aEvent); fpc_wasm32_i32_atomic_store(@P^.Signal,1);
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : notifying waiting threads');{$ENDIF}
a:=fpc_wasm32_memory_atomic_notify(@(P^.Signal),MaxThreadSignal);
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : freeing memory');{$ENDIF} {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : freeing memory');{$ENDIF}
Dispose(P); Dispose(P);
end; end;
@ -239,37 +248,78 @@ begin
fpc_wasm32_i32_atomic_store(@P^.Signal,0); fpc_wasm32_i32_atomic_store(@P^.Signal,0);
end; end;
procedure WasiRTLEventWaitFor_WaitAllowed(AEvent:PWasmRTLEvent; aTimeoutNs : Int64); procedure WasiRTLEventWaitFor_WaitAllowed(P:PWasmRTLEvent; aTimeoutNs : Int64);
Var Var
a : Longint; a : Longint;
EndTime: TOSTime;
RemainingTime: Int64;
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitAllowed : waiting');{$ENDIF} if fpc_wasm32_i32_atomic_load8_u(@P^.Destroying)<>0 then
a:=fpc_wasm32_memory_atomic_wait32(@(aEvent^.Signal),0,aTimeoutNs); exit; // abandoned
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitAllowed : done');{$ENDIF} if aTimeOutNS>=0 then
EndTime:=GetClockTime+aTimeOutNS
else
begin
EndTime:=0;
RemainingTime:=-1;
end;
repeat
if aTimeOutNS>=0 then
begin
RemainingTime:=EndTime-GetClockTime;
if RemainingTime<0 then
exit; // timeout
end;
case fpc_wasm32_memory_atomic_wait32(@P^.Signal,0,RemainingTime) of
0, { "ok" }
1: { "not-equal" }
begin
if fpc_wasm32_i32_atomic_load8_u(@P^.Destroying)<>0 then
exit // abandoned
else if fpc_wasm32_i32_atomic_rmw_cmpxchg_u(@P^.Signal,1,0)=1 then
exit // signaled
else
; { try waiting again (loop continues) }
end;
2: { "timed-out" }
exit; // timeout or abandoned
else { invalid result from wait }
exit; // error
end;
until false;
end; end;
procedure WasiRTLEventWaitFor_WaitNotAllowed(AEvent:PWasmRTLEvent; aTimeoutNs : Int64); procedure WasiRTLEventWaitFor_WaitNotAllowed(P:PWasmRTLEvent; aTimeoutNs : Int64);
Var Var
EndTime : Int64; EndTime: TOSTime;
IsTimeOut : Boolean; RemainingTime: Int64;
IsDone : Boolean;
begin begin
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitNotAllowed : waiting');{$ENDIF} if fpc_wasm32_i32_atomic_load8_u(@P^.Destroying)<>0 then
if aTimeoutNs>=0 then exit; // abandoned
EndTime:=GetClockTime+aTimeoutNs if aTimeOutNS>=0 then
EndTime:=GetClockTime+aTimeOutNS
else else
EndTime:=0; begin
Repeat EndTime:=0;
IsTimeOut:=(aTimeoutNs>=0) and (GetClockTime>EndTime); RemainingTime:=-1;
IsDone:=(fpc_wasm32_i32_atomic_load(@aEvent^.Signal)=1) or (fpc_wasm32_i32_atomic_load8_u(@aEvent^.Destroying)<>0); end;
Until isTimeOut or IsDone; repeat
{$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitNotAllowed : done waiting (isTimeout='+intToStr(Ord(isTimeOut))+',IsDone='+intToStr(Ord(IsDone))+ if aTimeOutNS>=0 then
',Signal='+IntToStr(aEvent^.Signal)+',Destroying='+IntToStr(Ord(aEvent^.Destroying))+')');{$ENDIF} begin
RemainingTime:=EndTime-GetClockTime;
if RemainingTime<0 then
exit; // timeout
end;
if fpc_wasm32_i32_atomic_load8_u(@P^.Destroying)<>0 then
exit // abandoned
else if fpc_wasm32_i32_atomic_rmw_cmpxchg_u(@P^.Signal,1,0)=1 then
exit; // signaled
until false;
end; end;
procedure WasiRTLEventWaitFor(AEvent:PRTLEvent); procedure WasiRTLEventWaitFor(AEvent:PRTLEvent);