paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-05 13:37:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Sendcommandtothread

Browse Source
This commit is contained in:
Michael Van Canneyt 2025-02-12 09:19:11 +01:00
parent 1affbdc510
commit ad2ee34f56
1 changed files with 12 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
packages/wasi/src/rtl.threadcontroller.pas
View File

@ -27,12 +27,10 @@ Type
function GetLoaded: Boolean; function GetLoaded: Boolean;
function GetLoadSent: Boolean; function GetLoadSent: Boolean;
function GetThreadID: Integer; function GetThreadID: Integer;
function GetThreadIDRange: Integer;
function GetThreadInfo: TThreadinfo; function GetThreadInfo: TThreadinfo;
procedure SetLoaded(AValue: Boolean); procedure SetLoaded(AValue: Boolean);
procedure SetLoadSent(AValue: Boolean); procedure SetLoadSent(AValue: Boolean);
procedure SetThreadID(AValue: Integer); procedure SetThreadID(AValue: Integer);
procedure SetThreadIDRange(AValue: Integer);
procedure SetThreadInfo(AValue: TThreadinfo); procedure SetThreadInfo(AValue: TThreadinfo);
Public Public
Class function Create(aScript : String) : TWasmThread; reintroduce; static; Class function Create(aScript : String) : TWasmThread; reintroduce; static;
@ -41,7 +39,6 @@ Type
Property Loaded : Boolean Read GetLoaded Write SetLoaded; Property Loaded : Boolean Read GetLoaded Write SetLoaded;
Property ThreadInfo : TThreadinfo Read GetThreadInfo Write SetThreadInfo; Property ThreadInfo : TThreadinfo Read GetThreadInfo Write SetThreadInfo;
Property ThreadID : Integer Read GetThreadID Write SetThreadID; Property ThreadID : Integer Read GetThreadID Write SetThreadID;
Property ThreadIDRange : Integer Read GetThreadIDRange Write SetThreadIDRange;
end; end;
@ -113,6 +110,8 @@ Type
procedure SendLoadCommands; procedure SendLoadCommands;
// Send a command to all workers // Send a command to all workers
procedure SendCommandToAllWorkers(aCommand : TWorkerCommand); procedure SendCommandToAllWorkers(aCommand : TWorkerCommand);
// Send a command to a specific thread. TWorkerCommand has the thread ID.
procedure SendCommandToThread(aCommand : TWorkerCommand);
// Name of worker script // Name of worker script
Property WorkerScript : String Read FWorkerScript; Property WorkerScript : String Read FWorkerScript;
// Initial number of threads, set by constructor // Initial number of threads, set by constructor
@ -140,7 +139,6 @@ begin
Result.ThreadID:=-1; Result.ThreadID:=-1;
Result.Loaded:=False; Result.Loaded:=False;
Result.LoadSent:=False; Result.LoadSent:=False;
Result.ThreadIDRange:=-1;
Result.ThreadInfo:=Default(TThreadInfo); Result.ThreadInfo:=Default(TThreadInfo);
end; end;
@ -172,16 +170,6 @@ begin
Result:=ThreadInfo.ThreadID; Result:=ThreadInfo.ThreadID;
end; end;
function TWasmThreadHelper.GetThreadIDRange: Integer;
Var
S : JSValue;
begin
S:=Properties['FThreadIDRange'];
if isNumber(S) then
Result:=Integer(S)
else
Result:=0;
end;
function TWasmThreadHelper.GetThreadInfo: TThreadinfo; function TWasmThreadHelper.GetThreadInfo: TThreadinfo;
Var Var
@ -211,10 +199,6 @@ begin
ThreadInfo.ThreadID:=aValue; ThreadInfo.ThreadID:=aValue;
end; end;
procedure TWasmThreadHelper.SetThreadIDRange(AValue: Integer);
begin
Properties['FThreadIDRange']:=aValue
end;
procedure TWasmThreadHelper.SetThreadInfo(AValue: TThreadinfo); procedure TWasmThreadHelper.SetThreadInfo(AValue: TThreadinfo);
begin begin
@ -278,7 +262,7 @@ Var
WLC: TWorkerLoadCommand; WLC: TWorkerLoadCommand;
begin begin
WLC:=TWorkerLoadCommand.Create(aThreadWorker.ThreadIDRange, Host.PreparedStartDescriptor.Module, Host.PreparedStartDescriptor.Memory); WLC:=TWorkerLoadCommand.Create(Host.PreparedStartDescriptor.Module, Host.PreparedStartDescriptor.Memory);
aThreadWorker.SendCommand(WLC); aThreadWorker.SendCommand(WLC);
aThreadWorker.LoadSent:=True; aThreadWorker.LoadSent:=True;
end; end;
@ -379,6 +363,15 @@ begin
WT.postMessage(aCommand); WT.postMessage(aCommand);
end; end;
procedure TThreadController.SendCommandToThread(aCommand: TWorkerCommand);
var
W : TJSWorker;
begin
W:=TJSWorker(FThreads[aCommand.ThreadID]);
if Assigned(W) then
W.postMessage(aCommand);
end;
procedure TThreadController.RunTimeOut(aInfo: TThreadInfo; aInterval: Integer); procedure TThreadController.RunTimeOut(aInfo: TThreadInfo; aInterval: Integer);
var var