mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-05 18:17:45 +02:00
* Refactor so we can start threaded wasm application in a webworker
This commit is contained in:
Michael Van Canneyt
parent
afb8872fcb
commit
de31826647
535
packages/wasi/src/rtl.threadcontroller.pas
Normal file
535
packages/wasi/src/rtl.threadcontroller.pas
Normal file
@ -0,0 +1,535 @@
|
||||
unit rtl.threadcontroller;
|
||||
|
||||
{$mode ObjFPC}
|
||||
{$modeswitch externalclass}
|
||||
{$modeswitch typehelpers}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFDEF FPC_DOTTEDUNITS}
|
||||
JSApi.JS, System.Classes, System.SysUtils, System.WebThreads, Wasi.Env, BrowserApi.WebOrWorker;
|
||||
{$ELSE}
|
||||
JS, Classes, SysUtils, Rtl.WebThreads, wasienv, weborworker;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
Type
|
||||
{ TWasmThread }
|
||||
TWasmThread = TJSWorker;
|
||||
|
||||
{ TWasmThreadHelper }
|
||||
|
||||
TWasmThreadHelper = Class helper for TWasmThread
|
||||
private
|
||||
function GetLoaded: Boolean;
|
||||
function GetLoadSent: Boolean;
|
||||
function GetThreadID: Integer;
|
||||
function GetThreadIDRange: Integer;
|
||||
function GetThreadInfo: TThreadinfo;
|
||||
procedure SetLoaded(AValue: Boolean);
|
||||
procedure SetLoadSent(AValue: Boolean);
|
||||
procedure SetThreadID(AValue: Integer);
|
||||
procedure SetThreadIDRange(AValue: Integer);
|
||||
procedure SetThreadInfo(AValue: TThreadinfo);
|
||||
Public
|
||||
Class function Create(aScript : String) : TWasmThread; reintroduce; static;
|
||||
Procedure SendCommand(aCommand : TWorkerCommand);
|
||||
Property LoadSent : Boolean Read GetLoadSent Write SetLoadSent;
|
||||
Property Loaded : Boolean Read GetLoaded Write SetLoaded;
|
||||
Property ThreadInfo : TThreadinfo Read GetThreadInfo Write SetThreadInfo;
|
||||
Property ThreadID : Integer Read GetThreadID Write SetThreadID;
|
||||
Property ThreadIDRange : Integer Read GetThreadIDRange Write SetThreadIDRange;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
TThreadHash = class external name 'Object' (TJSObject)
|
||||
Private
|
||||
function GetThreadData(aIndex: NativeInt): TWasmThread; external name '[]';
|
||||
procedure SetThreadData(aIndex: NativeInt; const AValue: TWasmThread); external name '[]';
|
||||
Public
|
||||
Property ThreadData[aIndex : NativeInt] : TWasmThread Read GetThreadData Write SetThreadData; default;
|
||||
end;
|
||||
|
||||
|
||||
// This object has the thread support that is needed by the 'main' program
|
||||
|
||||
{ TThreadController }
|
||||
|
||||
TThreadController = class(TWasmThreadSupport)
|
||||
private
|
||||
FInitialWorkerCount: Integer;
|
||||
FMaxWorkerCount: Integer;
|
||||
FOnUnknownMessage: TJSRawEventHandler;
|
||||
FHost: TWASIHost;
|
||||
FWorkerScript: String;
|
||||
FNextIDRange : Integer;
|
||||
FNextThreadID : Integer;
|
||||
procedure SetWasiHost(AValue: TWASIHost);
|
||||
Protected
|
||||
procedure RunTimeOut(aInfo: TThreadInfo; aInterval: Integer); virtual;
|
||||
function thread_spawn(start_arg : longint) : longint; override;
|
||||
Function thread_detach(thread_id : longint) : Integer; override;
|
||||
Function thread_cancel(thread_id : longint) : Integer; override;
|
||||
Function thread_self() : Integer; override;
|
||||
function AllocateThreadID : Integer;
|
||||
Protected
|
||||
FIdleWorkers : Array of TWasmThread;
|
||||
FBusyWorkers : Array of TWasmThread;
|
||||
FThreads : TThreadHash; // ThreadID is key,
|
||||
// Allocate new thread ID range
|
||||
function GetNextThreadIDRange: Integer;
|
||||
// Handle worker messages. If it is a command, it is set to handlecommand.
|
||||
procedure DoWorkerMessage(aEvent: TJSEvent);
|
||||
// Create & set up new worker
|
||||
Function AllocateNewWorker(Const aWorkerScript : string) : TWasmThread;
|
||||
// Send a load command
|
||||
procedure SendLoadCommand(aThreadWorker: TWasmThread); virtual;
|
||||
// Get new worker from pool, create new if needed.
|
||||
Function GetNewWorker : TWasmThread;
|
||||
// Spawn & prepare to run a new thread.
|
||||
Function SpawnThread(aInfo : TThreadInfo) : Integer;
|
||||
// Actually send run command.
|
||||
Procedure SendRunCommand(aThreadWorker: TWasmThread);
|
||||
//
|
||||
// Handle Various commands sent from worker threads.
|
||||
//
|
||||
// Allocate a new worker for a thread and run the thread if the worker is loaded.
|
||||
procedure HandleSpawnCommand(aWorker: TWasmThread; aCommand: TWorkerSpawnThreadCommand); virtual;
|
||||
// Cancel command: stop the thread
|
||||
procedure HandleCancelCommand(aWorker: TWasmThread; aCommand: TWorkerCancelCommand); virtual;
|
||||
// Cleanup thread : after join (or stopped if detached), free worker.
|
||||
procedure HandleCleanupCommand(aWorker: TWasmThread; aCommand: TWorkerCleanupCommand); virtual;
|
||||
// forward KILL signal to thread.
|
||||
procedure HandleKillCommand(aWorker: TWasmThread; aCommand: TWorkerKillCommand); virtual;
|
||||
// Worker script is loaded, has loaded webassembly and is ready to run.
|
||||
procedure HandleLoadedCommand(aWorker: TWasmThread; aCommand: TWorkerLoadedCommand); overload;
|
||||
// Console output from worker.
|
||||
procedure HandleConsoleCommand(aWorker: TWasmThread; aCommand: TWorkerConsoleCommand);
|
||||
Public
|
||||
Constructor Create(aEnv : TPas2JSWASIEnvironment); override;
|
||||
Constructor Create(aEnv : TPas2JSWASIEnvironment; aWorkerScript : String; aSpawnWorkerCount : integer); virtual; overload;
|
||||
Procedure HandleCommand(aWorker : TWasmThread; aCommand : TWorkerCommand); overload; virtual;
|
||||
// Send load commands to all workers that still need it.
|
||||
procedure SendLoadCommands;
|
||||
// Name of worker script
|
||||
Property WorkerScript : String Read FWorkerScript;
|
||||
// Initial number of threads, set by constructor
|
||||
Property InitialWorkerCount : Integer Read FInitialWorkerCount;
|
||||
// Maximum number of workers. If more workers are requested, the GetNewWorker will return Nil.
|
||||
Property MaxWorkerCount : Integer Read FMaxWorkerCount Write FMaxWorkerCount;
|
||||
Property OnUnknownMessage : TJSRawEventHandler Read FOnUnknownMessage Write FOnUnknownMessage;
|
||||
// The WASI host, used to run routines.
|
||||
Property Host : TWASIHost Read FHost Write SetWasiHost;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Resourcestring
|
||||
SErrMaxWorkersReached = 'Cannot create thread worker, Maximum number of workers (%d) reached.';
|
||||
|
||||
var
|
||||
Self_ : TWindowOrWorkerGlobalScope; external name 'self';
|
||||
|
||||
{ TWasmThread }
|
||||
|
||||
|
||||
class function TWasmThreadHelper.Create(aScript: String): TWasmThread;
|
||||
begin
|
||||
Result:=TJSWorker.new(aScript);
|
||||
Result.ThreadID:=-1;
|
||||
Result.Loaded:=False;
|
||||
Result.LoadSent:=False;
|
||||
Result.ThreadIDRange:=-1;
|
||||
Result.ThreadInfo:=Default(TThreadInfo);
|
||||
end;
|
||||
|
||||
function TWasmThreadHelper.GetLoaded: Boolean;
|
||||
Var
|
||||
S : JSValue;
|
||||
begin
|
||||
S:=Properties['FLoaded'];
|
||||
if isBoolean(S) then
|
||||
Result:=Boolean(S)
|
||||
else
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
function TWasmThreadHelper.GetLoadSent: Boolean;
|
||||
|
||||
Var
|
||||
S : JSValue;
|
||||
begin
|
||||
S:=Properties['FLoadSent'];
|
||||
if isBoolean(S) then
|
||||
Result:=Boolean(S)
|
||||
else
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
function TWasmThreadHelper.GetThreadID: Integer;
|
||||
begin
|
||||
Result:=ThreadInfo.ThreadID;
|
||||
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;
|
||||
Var
|
||||
S : JSValue;
|
||||
begin
|
||||
S:=Properties['FThreadInfo'];
|
||||
if isObject(S) then
|
||||
Result:=TThreadinfo(S)
|
||||
else
|
||||
Result:=Default(TThreadInfo);
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetLoaded(AValue: Boolean);
|
||||
begin
|
||||
Properties['FLoaded']:=aValue
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetLoadSent(AValue: Boolean);
|
||||
begin
|
||||
Properties['FLoadSent']:=aValue;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TWasmThreadHelper.SetThreadID(AValue: Integer);
|
||||
begin
|
||||
ThreadInfo.ThreadID:=aValue;
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetThreadIDRange(AValue: Integer);
|
||||
begin
|
||||
Properties['FThreadIDRange']:=aValue
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetThreadInfo(AValue: TThreadinfo);
|
||||
begin
|
||||
Properties['FThreadInfo']:=aValue
|
||||
end;
|
||||
|
||||
|
||||
procedure TWasmThreadHelper.SendCommand(aCommand: TWorkerCommand);
|
||||
begin
|
||||
// Writeln('Sending command '+TJSJSON.Stringify(aCommand));
|
||||
PostMessage(aCommand);
|
||||
end;
|
||||
|
||||
procedure TThreadController.DoWorkerMessage(aEvent: TJSEvent);
|
||||
|
||||
Var
|
||||
aMessageEvent : TJSMessageEvent absolute aEvent;
|
||||
aData : TWorkerCommand;
|
||||
aWorker : TWasmThread;
|
||||
|
||||
begin
|
||||
// Writeln('Received worker message '+TJSJSON.Stringify(aMessageEvent.Data));
|
||||
if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
|
||||
begin
|
||||
aData:=TWorkerCommand(aMessageEvent.Data);
|
||||
aWorker:=TWasmThread(aMessageEvent.Target);
|
||||
HandleCommand(aWorker,aData);
|
||||
end
|
||||
else if Assigned(FOnUnknownMessage) then
|
||||
FOnUnknownMessage(aEvent)
|
||||
else
|
||||
Writeln('Unknown worker message : ',TJSJSON.stringify(aEvent));
|
||||
end;
|
||||
|
||||
function TThreadController.GetNextThreadIDRange : Integer;
|
||||
|
||||
begin
|
||||
Inc(FNextIDRange,ThreadIDInterval);
|
||||
Result:=FNextIDRange;
|
||||
end;
|
||||
|
||||
function TThreadController.AllocateNewWorker(const aWorkerScript: string): TWasmThread;
|
||||
|
||||
begin
|
||||
// Writeln('Allocating new worker for: '+aWorkerScript);
|
||||
Result:=TWasmThread.Create(aWorkerScript);
|
||||
Result.ThreadIDRange:=GetNextThreadIDRange;
|
||||
Result.addEventListener('message',@DoWorkerMessage);
|
||||
if Assigned(Host) and Host.StartDescriptorReady then
|
||||
SendLoadCommand(Result)
|
||||
else
|
||||
Writeln('Host not set, delaying sending load command.'+aWorkerScript);
|
||||
end;
|
||||
|
||||
procedure TThreadController.SendLoadCommand(aThreadWorker: TWasmThread);
|
||||
|
||||
Var
|
||||
WLC: TWorkerLoadCommand;
|
||||
|
||||
begin
|
||||
WLC:=TWorkerLoadCommand.Create(aThreadWorker.ThreadIDRange, Host.PreparedStartDescriptor.Module, Host.PreparedStartDescriptor.Memory);
|
||||
aThreadWorker.SendCommand(WLC);
|
||||
aThreadWorker.LoadSent:=True;
|
||||
end;
|
||||
|
||||
function TThreadController.GetNewWorker: TWasmThread;
|
||||
|
||||
Var
|
||||
WT : TWasmThread;
|
||||
|
||||
begin
|
||||
if Length(FIdleWorkers)=0 then
|
||||
begin
|
||||
// Writeln('No idle workers, creating new one');
|
||||
if Length(FBusyWorkers)<MaxWorkerCount then
|
||||
WT:=AllocateNewWorker(FWorkerScript)
|
||||
else
|
||||
Raise EWasmThreads.Create(SErrMaxWorkersReached);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WT:=TWasmThread(TJSArray(FIdleWorkers).pop);
|
||||
end;
|
||||
TJSArray(FBusyWorkers).Push(WT);
|
||||
Result:=WT;
|
||||
end;
|
||||
|
||||
|
||||
procedure TThreadController.SendRunCommand(aThreadWorker: TWasmThread);
|
||||
|
||||
Var
|
||||
WRC : TWorkerRunCommand;
|
||||
|
||||
begin
|
||||
With aThreadWorker.ThreadInfo do
|
||||
WRC:=TWorkerRunCommand.Create(ThreadID,Arguments);
|
||||
aThreadWorker.SendCommand(Wrc);
|
||||
end;
|
||||
|
||||
procedure TThreadController.SetWasiHost(AValue: TWASIHost);
|
||||
|
||||
|
||||
begin
|
||||
// Writeln('Setting wasi host');
|
||||
if FHost=AValue then
|
||||
Exit;
|
||||
FHost:=AValue;
|
||||
If Assigned(FHost) and Host.StartDescriptorReady then
|
||||
SendLoadCommands;
|
||||
end;
|
||||
|
||||
function TThreadController.thread_spawn(start_arg : longint) : longint;
|
||||
|
||||
var
|
||||
aInfo : TThreadInfo;
|
||||
|
||||
begin
|
||||
Writeln('In host thread_spawn');
|
||||
aInfo.ThreadID:=AllocateThreadID;
|
||||
aInfo.Arguments:=start_arg;
|
||||
aInfo.OriginThreadID:=0;
|
||||
Result:=SpawnThread(aInfo);
|
||||
end;
|
||||
|
||||
function TThreadController.thread_detach(thread_id: longint): Integer;
|
||||
begin
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function TThreadController.thread_cancel(thread_id: longint): Integer;
|
||||
begin
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function TThreadController.thread_self: Integer;
|
||||
begin
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function TThreadController.AllocateThreadID: Integer;
|
||||
begin
|
||||
Inc(FNextThreadID);
|
||||
Result:=FNextThreadID;
|
||||
end;
|
||||
|
||||
procedure TThreadController.SendLoadCommands;
|
||||
|
||||
Var
|
||||
WT : TWasmThread;
|
||||
|
||||
begin
|
||||
// Writeln('Sending load command to all workers');
|
||||
For WT in FIdleWorkers do
|
||||
if not WT.LoadSent then
|
||||
SendLoadCommand(WT);
|
||||
end;
|
||||
|
||||
procedure TThreadController.RunTimeOut(aInfo: TThreadInfo; aInterval: Integer);
|
||||
|
||||
var
|
||||
Msg : String;
|
||||
|
||||
begin
|
||||
Msg:=Format('Failed to run thread %d spawned from thread %d: load timed out after %d ms.',[aInfo.ThreadID,aInfo.OriginThreadID,aInterval]);
|
||||
Writeln(msg);
|
||||
end;
|
||||
|
||||
function TThreadController.SpawnThread(aInfo: TThreadInfo): Integer;
|
||||
|
||||
Var
|
||||
WT : TWasmThread;
|
||||
lInterval : NativeInt;
|
||||
TryCount : Integer;
|
||||
|
||||
Procedure TryRunCommand;
|
||||
|
||||
var
|
||||
E : Exception;
|
||||
|
||||
begin
|
||||
Writeln('TryRunCommand called');
|
||||
if WT.Loaded then
|
||||
begin
|
||||
self_.clearInterval(lInterval);
|
||||
SendRunCommand(WT);
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(TryCount);
|
||||
if TryCount>20 then
|
||||
begin
|
||||
self_.clearInterval(lInterval);
|
||||
RunTimeOut(aInfo,100*TryCount);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
// Writeln('Enter TThreadController.SpawnThread for ID ',aInfo.ThreadID);
|
||||
TryCount:=0;
|
||||
WT:=GetNewWorker;
|
||||
if WT=nil then
|
||||
begin
|
||||
Writeln('Error: no worker !');
|
||||
exit(-1)
|
||||
end;
|
||||
WT.ThreadInfo:=aInfo;
|
||||
FThreads[aInfo.ThreadID]:=WT;
|
||||
SendRunCommand(WT);
|
||||
Result:=aInfo.ThreadID
|
||||
// Writeln('Exit: TThreadController.SpawnThread for ID ',WT.ThreadID);
|
||||
end;
|
||||
|
||||
|
||||
constructor TThreadController.Create(aEnv: TPas2JSWASIEnvironment);
|
||||
begin
|
||||
Create(aEnv,DefaultThreadWorker,DefaultThreadCount)
|
||||
end;
|
||||
|
||||
constructor TThreadController.Create(aEnv: TPas2JSWASIEnvironment;
|
||||
aWorkerScript: String; aSpawnWorkerCount: integer);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Inherited Create(aEnv);
|
||||
FThreads:=TThreadHash.new;
|
||||
FWorkerScript:=aWorkerScript;
|
||||
FInitialWorkerCount:=aSpawnWorkerCount;
|
||||
FMaxWorkerCount:=DefaultMaxWorkerCount;
|
||||
For I:=1 to aSpawnWorkerCount do
|
||||
TJSArray(FIdleWorkers).Push(AllocateNewWorker(aWorkerScript));
|
||||
end;
|
||||
|
||||
procedure TThreadController.HandleSpawnCommand(aWorker : TWasmThread; aCommand: TWorkerSpawnThreadCommand);
|
||||
|
||||
Var
|
||||
aInfo: TThreadInfo;
|
||||
|
||||
begin
|
||||
aInfo.OriginThreadID:=aWorker.ThreadID;
|
||||
aInfo.ThreadID:=aCommand.ThreadID;
|
||||
aInfo.Arguments:=aCommand.Arguments;
|
||||
SpawnThread(aInfo);
|
||||
end;
|
||||
|
||||
procedure TThreadController.HandleKillCommand(aWorker : TWasmThread; aCommand: TWorkerKillCommand);
|
||||
|
||||
begin
|
||||
// todo
|
||||
end;
|
||||
|
||||
procedure TThreadController.HandleCancelCommand(aWorker : TWasmThread; aCommand: TWorkerCancelCommand);
|
||||
|
||||
begin
|
||||
// todo
|
||||
end;
|
||||
|
||||
procedure TThreadController.HandleLoadedCommand(aWorker : TWasmThread; aCommand: TWorkerLoadedCommand);
|
||||
|
||||
begin
|
||||
// Writeln('Host: Entering TThreadController.HandleLoadedCommand');
|
||||
aWorker.Loaded:=True;
|
||||
// if a thread is scheduled to run in this thread, run it.
|
||||
if aWorker.ThreadID>0 then
|
||||
SendRunCommand(aWorker);
|
||||
// Writeln('Host: exiting TThreadController.HandleLoadedCommand');
|
||||
end;
|
||||
|
||||
procedure TThreadController.HandleCleanupCommand(aWorker : TWasmThread; aCommand: TWorkerCleanupCommand);
|
||||
|
||||
Var
|
||||
Idx : Integer;
|
||||
|
||||
begin
|
||||
aWorker.ThreadInfo:=Default(TThreadInfo);
|
||||
Idx:=TJSarray(FBusyWorkers).indexOf(aWorker);
|
||||
if Idx<>-1 then
|
||||
Delete(FBusyWorkers,Idx,1);
|
||||
Idx:=TJSarray(FIdleWorkers).indexOf(aWorker);
|
||||
if Idx=-1 then
|
||||
FIdleWorkers:=Concat(FIdleWorkers,[aWorker]);
|
||||
end;
|
||||
|
||||
procedure TThreadController.HandleConsoleCommand(aWorker : TWasmThread; aCommand: TWorkerConsoleCommand);
|
||||
|
||||
Var
|
||||
Prefix : string;
|
||||
|
||||
begin
|
||||
Prefix:=Format('Wasm thread %d: ',[aWorker.ThreadID]);
|
||||
if Assigned(Host.OnConsoleWrite) then
|
||||
Host.OnConsoleWrite(Host,Prefix+aCommand.ConsoleMessage)
|
||||
else
|
||||
Writeln(Prefix+aCommand.ConsoleMessage);
|
||||
end;
|
||||
|
||||
procedure TThreadController.HandleCommand(aWorker : TWasmThread; aCommand: TWorkerCommand);
|
||||
begin
|
||||
Case aCommand.Command of
|
||||
cmdSpawn : HandleSpawnCommand(aWorker, TWorkerSpawnThreadCommand(aCommand));
|
||||
cmdCleanup : HandleCleanupCommand(aWorker, TWorkerCleanupCommand(aCommand));
|
||||
cmdKill : HandleKillCommand(aWorker, TWorkerKillCommand(aCommand));
|
||||
cmdCancel : HandleCancelCommand(aWorker, TWorkerCancelCommand(aCommand));
|
||||
cmdLoaded : HandleLoadedCommand(aWorker, TWorkerLoadedCommand(aCommand));
|
||||
cmdConsole : HandleConsoleCommand(aWorker, TWorkerConsoleCommand(aCommand));
|
||||
else
|
||||
HandleCommand(aCommand);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -10,129 +10,27 @@ interface
|
||||
|
||||
uses
|
||||
{$IFDEF FPC_DOTTEDUNITS}
|
||||
JSApi.JS, System.Classes, System.SysUtils, System.WebThreads, Wasi.Env, Fcl.App.Wasi.Host,
|
||||
JSApi.JS, System.Classes, System.SysUtils, System.WebThreads, Wasi.Env, Fcl.App.Wasi.Host, Rtl.ThreadController
|
||||
BrowserApi.WebOrWorker;
|
||||
{$ELSE}
|
||||
JS, Classes, SysUtils, Rtl.WebThreads, wasienv, wasihostapp, weborworker;
|
||||
JS, Classes, SysUtils, Rtl.WebThreads, wasienv, wasihostapp, weborworker, Rtl.ThreadController;
|
||||
{$ENDIF}
|
||||
|
||||
Type
|
||||
{ TWasmThread }
|
||||
TWasmThread = TJSWorker;
|
||||
|
||||
{ TWasmThreadHelper }
|
||||
|
||||
TWasmThreadHelper = Class helper for TWasmThread
|
||||
private
|
||||
function GetLoaded: Boolean;
|
||||
function GetLoadSent: Boolean;
|
||||
function GetThreadID: Integer;
|
||||
function GetThreadIDRange: Integer;
|
||||
function GetThreadInfo: TThreadinfo;
|
||||
procedure SetLoaded(AValue: Boolean);
|
||||
procedure SetLoadSent(AValue: Boolean);
|
||||
procedure SetThreadID(AValue: Integer);
|
||||
procedure SetThreadIDRange(AValue: Integer);
|
||||
procedure SetThreadInfo(AValue: TThreadinfo);
|
||||
Public
|
||||
Class function Create(aScript : String) : TWasmThread; reintroduce; static;
|
||||
Procedure SendCommand(aCommand : TWorkerCommand);
|
||||
Property LoadSent : Boolean Read GetLoadSent Write SetLoadSent;
|
||||
Property Loaded : Boolean Read GetLoaded Write SetLoaded;
|
||||
Property ThreadInfo : TThreadinfo Read GetThreadInfo Write SetThreadInfo;
|
||||
Property ThreadID : Integer Read GetThreadID Write SetThreadID;
|
||||
Property ThreadIDRange : Integer Read GetThreadIDRange Write SetThreadIDRange;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
TThreadHash = class external name 'Object' (TJSObject)
|
||||
Private
|
||||
function GetThreadData(aIndex: NativeInt): TWasmThread; external name '[]';
|
||||
procedure SetThreadData(aIndex: NativeInt; const AValue: TWasmThread); external name '[]';
|
||||
Public
|
||||
Property ThreadData[aIndex : NativeInt] : TWasmThread Read GetThreadData Write SetThreadData; default;
|
||||
end;
|
||||
|
||||
|
||||
// This object has the thread support that is needed by the 'main' program
|
||||
|
||||
{ TMainThreadSupport }
|
||||
|
||||
TMainThreadSupport = class(TWasmThreadSupport)
|
||||
private
|
||||
FInitialWorkerCount: Integer;
|
||||
FMaxWorkerCount: Integer;
|
||||
FOnUnknownMessage: TJSRawEventHandler;
|
||||
FHost: TWASIHost;
|
||||
FWorkerScript: String;
|
||||
FNextIDRange : Integer;
|
||||
FNextThreadID : Integer;
|
||||
procedure SetWasiHost(AValue: TWASIHost);
|
||||
Protected
|
||||
function thread_spawn(start_arg : longint) : longint; override;
|
||||
Function thread_detach(thread_id : longint) : Integer; override;
|
||||
Function thread_cancel(thread_id : longint) : Integer; override;
|
||||
Function thread_self() : Integer; override;
|
||||
function AllocateThreadID : Integer;
|
||||
Protected
|
||||
FIdleWorkers : Array of TWasmThread;
|
||||
FBusyWorkers : Array of TWasmThread;
|
||||
FThreads : TThreadHash; // ThreadID is key,
|
||||
// Send load commands to all workers that still need it.
|
||||
procedure SendLoadCommands;
|
||||
// Allocate new thread ID range
|
||||
function GetNextThreadIDRange: Integer;
|
||||
// Handle worker messages. If it is a command, it is set to handlecommand.
|
||||
procedure DoWorkerMessage(aEvent: TJSEvent);
|
||||
// Create & set up new worker
|
||||
Function AllocateNewWorker(Const aWorkerScript : string) : TWasmThread;
|
||||
// Send a load command
|
||||
procedure SendLoadCommand(aThreadWorker: TWasmThread); virtual;
|
||||
// Get new worker from pool, create new if needed.
|
||||
Function GetNewWorker : TWasmThread;
|
||||
// Spawn & prepare to run a new thread.
|
||||
Function SpawnThread(aInfo : TThreadInfo) : Integer;
|
||||
// Actually send run command.
|
||||
Procedure SendRunCommand(aThreadWorker: TWasmThread);
|
||||
//
|
||||
// Handle Various commands sent from worker threads.
|
||||
//
|
||||
// Allocate a new worker for a thread and run the thread if the worker is loaded.
|
||||
procedure HandleSpawnCommand(aWorker: TWasmThread; aCommand: TWorkerSpawnThreadCommand); virtual;
|
||||
// Cancel command: stop the thread
|
||||
procedure HandleCancelCommand(aWorker: TWasmThread; aCommand: TWorkerCancelCommand); virtual;
|
||||
// Cleanup thread : after join (or stopped if detached), free worker.
|
||||
procedure HandleCleanupCommand(aWorker: TWasmThread; aCommand: TWorkerCleanupCommand); virtual;
|
||||
// forward KILL signal to thread.
|
||||
procedure HandleKillCommand(aWorker: TWasmThread; aCommand: TWorkerKillCommand); virtual;
|
||||
// Worker script is loaded, has loaded webassembly and is ready to run.
|
||||
procedure HandleLoadedCommand(aWorker: TWasmThread; aCommand: TWorkerLoadedCommand); overload;
|
||||
// Console output from worker.
|
||||
procedure HandleConsoleCommand(aWorker: TWasmThread; aCommand: TWorkerConsoleCommand);
|
||||
Public
|
||||
Constructor Create(aEnv : TPas2JSWASIEnvironment); override;
|
||||
Constructor Create(aEnv : TPas2JSWASIEnvironment; aWorkerScript : String; aSpawnWorkerCount : integer); virtual; overload;
|
||||
Procedure HandleCommand(aWorker : TWasmThread; aCommand : TWorkerCommand); overload; virtual;
|
||||
Property WorkerScript : String Read FWorkerScript;
|
||||
// Initial number of threads, set by constructor
|
||||
Property InitialWorkerCount : Integer Read FInitialWorkerCount;
|
||||
// Maximum number of workers. If more workers are requested, the GetNewWorker will return Nil.
|
||||
Property MaxWorkerCount : Integer Read FMaxWorkerCount Write FMaxWorkerCount;
|
||||
Property OnUnknownMessage : TJSRawEventHandler Read FOnUnknownMessage Write FOnUnknownMessage;
|
||||
// The WASI host, used to run routines.
|
||||
Property Host : TWASIHost Read FHost Write SetWasiHost;
|
||||
end;
|
||||
TMainThreadSupport = class(TThreadController);
|
||||
|
||||
{ TBrowserWASIThreadedHostApplication }
|
||||
|
||||
TBrowserWASIThreadedHostApplication = class(TBrowserWASIHostApplication)
|
||||
private
|
||||
FThreadSupport: TMainThreadSupport;
|
||||
FConsoleChannel : TJSBroadCastChannel;
|
||||
procedure HandleConsoleMessage(aEvent: TJSEvent);
|
||||
protected
|
||||
Function CreateThreadSupport(aEnv : TPas2JSWASIEnvironment) : TMainThreadSupport; virtual;
|
||||
Function CreateHost: TWASIHost; override;
|
||||
Public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
Property ThreadSupport : TMainThreadSupport Read FThreadSupport;
|
||||
end;
|
||||
@ -152,9 +50,6 @@ Type
|
||||
|
||||
implementation
|
||||
|
||||
Resourcestring
|
||||
SErrMaxWorkersReached = 'Cannot create thread worker, Maximum number of workers (%d) reached.';
|
||||
|
||||
{ ThreadAppWASIHost }
|
||||
|
||||
procedure ThreadAppWASIHost.SetThreadSupport(AValue: TMainThreadSupport);
|
||||
@ -164,7 +59,6 @@ begin
|
||||
FThreadSupport.Host:=Self;
|
||||
end;
|
||||
|
||||
|
||||
procedure ThreadAppWASIHost.DoAfterInstantiate;
|
||||
begin
|
||||
inherited DoAfterInstantiate;
|
||||
@ -172,7 +66,6 @@ begin
|
||||
FThreadSupport.SendLoadCommands;
|
||||
end;
|
||||
|
||||
|
||||
{ TBrowserWASIThreadedHostApplication }
|
||||
|
||||
function TBrowserWASIThreadedHostApplication.CreateThreadSupport(
|
||||
@ -190,380 +83,39 @@ begin
|
||||
Res:=ThreadAppWASIHost.Create(Self);
|
||||
Res.UseSharedMemory:=True;
|
||||
Res.ThreadSupport:=CreateThreadSupport(Res.WasiEnvironment);
|
||||
|
||||
Result:=Res;
|
||||
end;
|
||||
|
||||
procedure TBrowserWASIThreadedHostApplication.HandleConsoleMessage(aEvent : TJSEvent);
|
||||
|
||||
var
|
||||
E : TJSMessageEvent absolute aEvent;
|
||||
D : TWorkerCommand;
|
||||
|
||||
begin
|
||||
if not isObject(E.Data) then exit;
|
||||
D:=TWorkerCommand(E.Data);
|
||||
if D.Command=cmdConsole then
|
||||
Writeln(TWorkerConsoleCommand(d).ConsoleMessage);
|
||||
end;
|
||||
|
||||
constructor TBrowserWASIThreadedHostApplication.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
FConsoleChannel:=TJSBroadCastChannel.New(channelConsole);
|
||||
FConsoleChannel.addEventListener('message',@HandleConsoleMessage);
|
||||
end;
|
||||
|
||||
|
||||
destructor TBrowserWASIThreadedHostApplication.Destroy;
|
||||
begin
|
||||
FConsoleChannel.Close;
|
||||
FConsoleChannel:=Nil;
|
||||
FreeAndNil(FThreadSupport);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
{ TWasmThread }
|
||||
|
||||
|
||||
class function TWasmThreadHelper.Create(aScript: String): TWasmThread;
|
||||
begin
|
||||
Result:=TJSWorker.new(aScript);
|
||||
Result.ThreadID:=-1;
|
||||
Result.Loaded:=False;
|
||||
Result.LoadSent:=False;
|
||||
Result.ThreadIDRange:=-1;
|
||||
Result.ThreadInfo:=Default(TThreadInfo);
|
||||
end;
|
||||
|
||||
function TWasmThreadHelper.GetLoaded: Boolean;
|
||||
Var
|
||||
S : JSValue;
|
||||
begin
|
||||
S:=Properties['FLoaded'];
|
||||
if isBoolean(S) then
|
||||
Result:=Boolean(S)
|
||||
else
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
function TWasmThreadHelper.GetLoadSent: Boolean;
|
||||
|
||||
Var
|
||||
S : JSValue;
|
||||
begin
|
||||
S:=Properties['FLoadSent'];
|
||||
if isBoolean(S) then
|
||||
Result:=Boolean(S)
|
||||
else
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
function TWasmThreadHelper.GetThreadID: Integer;
|
||||
begin
|
||||
Result:=ThreadInfo.ThreadID;
|
||||
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;
|
||||
Var
|
||||
S : JSValue;
|
||||
begin
|
||||
S:=Properties['FThreadInfo'];
|
||||
if isObject(S) then
|
||||
Result:=TThreadinfo(S)
|
||||
else
|
||||
Result:=Default(TThreadInfo);
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetLoaded(AValue: Boolean);
|
||||
begin
|
||||
Properties['FLoaded']:=aValue
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetLoadSent(AValue: Boolean);
|
||||
begin
|
||||
Properties['FLoadSent']:=aValue;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TWasmThreadHelper.SetThreadID(AValue: Integer);
|
||||
begin
|
||||
ThreadInfo.ThreadID:=aValue;
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetThreadIDRange(AValue: Integer);
|
||||
begin
|
||||
Properties['FThreadIDRange']:=aValue
|
||||
end;
|
||||
|
||||
procedure TWasmThreadHelper.SetThreadInfo(AValue: TThreadinfo);
|
||||
begin
|
||||
Properties['FThreadInfo']:=aValue
|
||||
end;
|
||||
|
||||
|
||||
procedure TWasmThreadHelper.SendCommand(aCommand: TWorkerCommand);
|
||||
begin
|
||||
// Writeln('Sending command '+TJSJSON.Stringify(aCommand));
|
||||
PostMessage(aCommand);
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.DoWorkerMessage(aEvent: TJSEvent);
|
||||
|
||||
Var
|
||||
aMessageEvent : TJSMessageEvent absolute aEvent;
|
||||
aData : TWorkerCommand;
|
||||
aWorker : TWasmThread;
|
||||
|
||||
begin
|
||||
// Writeln('Received worker message '+TJSJSON.Stringify(aMessageEvent.Data));
|
||||
if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
|
||||
begin
|
||||
aData:=TWorkerCommand(aMessageEvent.Data);
|
||||
aWorker:=TWasmThread(aMessageEvent.Target);
|
||||
HandleCommand(aWorker,aData);
|
||||
end
|
||||
else if Assigned(FOnUnknownMessage) then
|
||||
FOnUnknownMessage(aEvent)
|
||||
else
|
||||
Writeln('Unknown worker message : ',TJSJSON.stringify(aEvent));
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.GetNextThreadIDRange : Integer;
|
||||
|
||||
begin
|
||||
Inc(FNextIDRange,ThreadIDInterval);
|
||||
Result:=FNextIDRange;
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.AllocateNewWorker(const aWorkerScript: string): TWasmThread;
|
||||
|
||||
begin
|
||||
// Writeln('Allocating new worker for: '+aWorkerScript);
|
||||
Result:=TWasmThread.Create(aWorkerScript);
|
||||
Result.ThreadIDRange:=GetNextThreadIDRange;
|
||||
Result.addEventListener('message',@DoWorkerMessage);
|
||||
if Assigned(Host) and Host.StartDescriptorReady then
|
||||
SendLoadCommand(Result)
|
||||
else
|
||||
Writeln('Host not set, delaying sending load command.'+aWorkerScript);
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.SendLoadCommand(aThreadWorker: TWasmThread);
|
||||
|
||||
Var
|
||||
WLC: TWorkerLoadCommand;
|
||||
|
||||
begin
|
||||
WLC:=TWorkerLoadCommand.Create(aThreadWorker.ThreadIDRange, Host.PreparedStartDescriptor.Module, Host.PreparedStartDescriptor.Memory);
|
||||
aThreadWorker.SendCommand(WLC);
|
||||
aThreadWorker.LoadSent:=True;
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.GetNewWorker: TWasmThread;
|
||||
|
||||
Var
|
||||
WT : TWasmThread;
|
||||
|
||||
begin
|
||||
if Length(FIdleWorkers)=0 then
|
||||
begin
|
||||
// Writeln('No idle workers, creating new one');
|
||||
if Length(FBusyWorkers)<MaxWorkerCount then
|
||||
WT:=AllocateNewWorker(FWorkerScript)
|
||||
else
|
||||
Raise EWasmThreads.Create(SErrMaxWorkersReached);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WT:=TWasmThread(TJSArray(FIdleWorkers).pop);
|
||||
end;
|
||||
TJSArray(FBusyWorkers).Push(WT);
|
||||
Result:=WT;
|
||||
end;
|
||||
|
||||
|
||||
procedure TMainThreadSupport.SendRunCommand(aThreadWorker: TWasmThread);
|
||||
|
||||
Var
|
||||
WRC : TWorkerRunCommand;
|
||||
|
||||
begin
|
||||
With aThreadWorker.ThreadInfo do
|
||||
WRC:=TWorkerRunCommand.Create(ThreadID,Arguments);
|
||||
aThreadWorker.SendCommand(Wrc);
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.SetWasiHost(AValue: TWASIHost);
|
||||
|
||||
|
||||
begin
|
||||
// Writeln('Setting wasi host');
|
||||
if FHost=AValue then
|
||||
Exit;
|
||||
FHost:=AValue;
|
||||
If Assigned(FHost) and Host.StartDescriptorReady then
|
||||
SendLoadCommands;
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.thread_spawn(start_arg : longint) : longint;
|
||||
|
||||
var
|
||||
aInfo : TThreadInfo;
|
||||
|
||||
begin
|
||||
Writeln('In host thread_spawn');
|
||||
aInfo.ThreadID:=AllocateThreadID;
|
||||
aInfo.Arguments:=start_arg;
|
||||
aInfo.OriginThreadID:=0;
|
||||
Result:=SpawnThread(aInfo);
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.thread_detach(thread_id: Integer): Integer;
|
||||
begin
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.thread_cancel(thread_id: Integer): Integer;
|
||||
begin
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.thread_self: Integer;
|
||||
begin
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.AllocateThreadID: Integer;
|
||||
begin
|
||||
Inc(FNextThreadID);
|
||||
Result:=FNextThreadID;
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.SendLoadCommands;
|
||||
|
||||
Var
|
||||
WT : TWasmThread;
|
||||
|
||||
begin
|
||||
// Writeln('Sending load command to all workers');
|
||||
For WT in FIdleWorkers do
|
||||
if not WT.LoadSent then
|
||||
SendLoadCommand(WT);
|
||||
end;
|
||||
|
||||
function TMainThreadSupport.SpawnThread(aInfo: TThreadInfo): Integer;
|
||||
|
||||
Var
|
||||
WT : TWasmThread;
|
||||
|
||||
begin
|
||||
// Writeln('Enter TMainThreadSupport.SpawnThread for ID ',aInfo.ThreadID);
|
||||
WT:=GetNewWorker;
|
||||
if WT=nil then
|
||||
begin
|
||||
Writeln('Error: no worker !');
|
||||
exit(-1)
|
||||
end;
|
||||
WT.ThreadInfo:=aInfo;
|
||||
FThreads[aInfo.ThreadID]:=WT;
|
||||
if WT.Loaded then
|
||||
begin
|
||||
// Writeln('Worker is loaded. Sending run command to worker');
|
||||
SendRunCommand(WT);
|
||||
end;
|
||||
Result:=aInfo.ThreadID
|
||||
// Writeln('Exit: TMainThreadSupport.SpawnThread for ID ',WT.ThreadID);
|
||||
end;
|
||||
|
||||
|
||||
constructor TMainThreadSupport.Create(aEnv: TPas2JSWASIEnvironment);
|
||||
begin
|
||||
Create(aEnv,DefaultThreadWorker,DefaultThreadCount)
|
||||
end;
|
||||
|
||||
constructor TMainThreadSupport.Create(aEnv: TPas2JSWASIEnvironment;
|
||||
aWorkerScript: String; aSpawnWorkerCount: integer);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Inherited Create(aEnv);
|
||||
FThreads:=TThreadHash.new;
|
||||
FWorkerScript:=aWorkerScript;
|
||||
FInitialWorkerCount:=aSpawnWorkerCount;
|
||||
FMaxWorkerCount:=DefaultMaxWorkerCount;
|
||||
For I:=1 to aSpawnWorkerCount do
|
||||
TJSArray(FIdleWorkers).Push(AllocateNewWorker(aWorkerScript));
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.HandleSpawnCommand(aWorker : TWasmThread; aCommand: TWorkerSpawnThreadCommand);
|
||||
|
||||
Var
|
||||
aInfo: TThreadInfo;
|
||||
|
||||
begin
|
||||
aInfo.OriginThreadID:=aWorker.ThreadID;
|
||||
aInfo.ThreadID:=aCommand.ThreadID;
|
||||
aInfo.Arguments:=aCommand.Arguments;
|
||||
SpawnThread(aInfo);
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.HandleKillCommand(aWorker : TWasmThread; aCommand: TWorkerKillCommand);
|
||||
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.HandleCancelCommand(aWorker : TWasmThread; aCommand: TWorkerCancelCommand);
|
||||
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.HandleLoadedCommand(aWorker : TWasmThread; aCommand: TWorkerLoadedCommand);
|
||||
|
||||
begin
|
||||
// Writeln('Host: Entering TMainThreadSupport.HandleLoadedCommand');
|
||||
aWorker.Loaded:=True;
|
||||
// if a thread is scheduled to run in this thread, run it.
|
||||
if aWorker.ThreadID>0 then
|
||||
SendRunCommand(aWorker);
|
||||
// Writeln('Host: exiting TMainThreadSupport.HandleLoadedCommand');
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.HandleCleanupCommand(aWorker : TWasmThread; aCommand: TWorkerCleanupCommand);
|
||||
|
||||
Var
|
||||
Idx : Integer;
|
||||
|
||||
begin
|
||||
aWorker.ThreadInfo:=Default(TThreadInfo);
|
||||
Idx:=TJSarray(FBusyWorkers).indexOf(aWorker);
|
||||
if Idx<>-1 then
|
||||
Delete(FBusyWorkers,Idx,1);
|
||||
Idx:=TJSarray(FIdleWorkers).indexOf(aWorker);
|
||||
if Idx=-1 then
|
||||
FIdleWorkers:=Concat(FIdleWorkers,[aWorker]);
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.HandleConsoleCommand(aWorker : TWasmThread; aCommand: TWorkerConsoleCommand);
|
||||
|
||||
Var
|
||||
Prefix : string;
|
||||
|
||||
begin
|
||||
Prefix:=Format('Wasm thread %d: ',[aWorker.ThreadID]);
|
||||
if Assigned(Host.OnConsoleWrite) then
|
||||
Host.OnConsoleWrite(Host,Prefix+aCommand.ConsoleMessage)
|
||||
else
|
||||
Writeln(Prefix+aCommand.ConsoleMessage);
|
||||
end;
|
||||
|
||||
procedure TMainThreadSupport.HandleCommand(aWorker : TWasmThread; aCommand: TWorkerCommand);
|
||||
begin
|
||||
Case aCommand.Command of
|
||||
cmdSpawn : HandleSpawnCommand(aWorker, TWorkerSpawnThreadCommand(aCommand));
|
||||
cmdCleanup : HandleCleanupCommand(aWorker, TWorkerCleanupCommand(aCommand));
|
||||
cmdKill : HandleKillCommand(aWorker, TWorkerKillCommand(aCommand));
|
||||
cmdCancel : HandleCancelCommand(aWorker, TWorkerCancelCommand(aCommand));
|
||||
cmdLoaded : HandleLoadedCommand(aWorker, TWorkerLoadedCommand(aCommand));
|
||||
cmdConsole : HandleConsoleCommand(aWorker, TWorkerConsoleCommand(aCommand));
|
||||
else
|
||||
HandleCommand(aCommand);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -10,9 +10,11 @@ interface
|
||||
uses
|
||||
{$IFDEF FPC_DOTTEDUNITS}
|
||||
System.Classes, System.SysUtils, JSApi.JS, Fcl.CustApp, BrowserApi.WebOrWorker,
|
||||
BrowserApi.Worker, BrowserApi.WebAssembly, Wasi.Env, System.WebThreads;
|
||||
BrowserApi.Worker, BrowserApi.WebAssembly, Wasi.Env, System.WebThreads,
|
||||
Rtl.ThreadController;
|
||||
{$ELSE}
|
||||
Classes, SysUtils, JS, custapp, weborworker, webworker, webassembly, wasienv, Rtl.WebThreads;
|
||||
Classes, SysUtils, JS, custapp, weborworker, webworker, webassembly, wasienv,
|
||||
Rtl.WebThreads, Rtl.ThreadController;
|
||||
{$ENDIF}
|
||||
|
||||
Type
|
||||
@ -24,12 +26,11 @@ Type
|
||||
private
|
||||
FSendOutputToBrowserWindow: Boolean;
|
||||
FThreadEntryPoint: String;
|
||||
FThreadInitInstanceEntry : String;
|
||||
FThreadSupport: TWorkerThreadSupport;
|
||||
procedure PrepareWebAssemblyThread(aDescr: TWebAssemblyStartDescriptor);
|
||||
procedure SetThreadSupport(AValue: TWorkerThreadSupport);
|
||||
Protected
|
||||
Procedure RunWebAssemblyThread(aProc : TRunWebassemblyProc); virtual;
|
||||
Procedure PrepareWebAssemblyThread(aDescr : TWebAssemblyStartDescriptor); virtual;
|
||||
procedure DoStdWrite(Sender: TObject; const aOutput: String); override;
|
||||
Public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
@ -48,6 +49,11 @@ Type
|
||||
|
||||
TWorkerThreadSupport = class(TWasmThreadSupport)
|
||||
Private
|
||||
Type
|
||||
TWorkerState = (wsNeutral, wsLoading, wsLoaded, wsRunWaiting, wsRunning);
|
||||
procedure DoRunThread(aExports: TWASIExports);
|
||||
Private
|
||||
FState: TWorkerState;
|
||||
FStartThreadID : Integer;
|
||||
FNextThreadID : Integer;
|
||||
FCurrentThreadInfo : TThreadinfo;
|
||||
@ -86,14 +92,13 @@ Type
|
||||
Property Host : TWASIThreadHost Read FWasiHost Write FWasiHost;
|
||||
end;
|
||||
|
||||
|
||||
{ TWorkerWASIHostApplication }
|
||||
|
||||
TWorkerWASIHostApplication = class(TCustomApplication)
|
||||
private
|
||||
FHost : TWASIHost;
|
||||
FThreadSupport : TWorkerThreadSupport;
|
||||
FSendOutputToBrowser: Boolean;
|
||||
FConsoleChannel: TJSBroadcastChannel;
|
||||
function GetAfterStart: TAfterStartEvent;
|
||||
function GetBeforeStart: TBeforeStartEvent;
|
||||
function GetcPredefinedConsoleInput: TStrings;
|
||||
@ -109,18 +114,20 @@ Type
|
||||
procedure SetPredefinedConsoleInput(AValue: TStrings);
|
||||
procedure SetRunEntryFunction(AValue: String);
|
||||
protected
|
||||
procedure HandleMessage(aEvent: TJSEvent); virtual;
|
||||
procedure HandleMessage(aEvent: TJSEvent); virtual; abstract;
|
||||
procedure DoOnSendCommand(Sender : TObject; aCommand : TWorkerCommand);
|
||||
function CreateHost: TWASIHost; virtual;
|
||||
function CreateHost: TWASIHost; virtual; abstract;
|
||||
procedure DoRun; override;
|
||||
function GetConsoleApplication: boolean; override;
|
||||
function GetLocation: String; override;
|
||||
property ConsoleChannel : TJSBroadCastChannel Read FConsoleChannel;
|
||||
public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
// Send a command to the process that started the worker.
|
||||
procedure SendCommand(aCommand: TWorkerCommand); virtual;
|
||||
// Get the list of environment variables.
|
||||
procedure GetEnvironmentList(List: TStrings; NamesOnly: Boolean); override;
|
||||
procedure ShowException(E: Exception); override;
|
||||
// Load and start webassembly. If DoRun is true, then Webassembly entry point is called.
|
||||
// If aBeforeStart is specified, then it is called prior to calling run, and can disable running.
|
||||
// If aAfterStart is specified, then it is called after calling run. It is not called is running was disabled.
|
||||
@ -143,10 +150,55 @@ Type
|
||||
property OnConsoleRead : TConsoleReadEvent Read GetOnConsoleRead Write SetOnConsoleRead;
|
||||
// Called when writing to console (stdout). If not set, console.log is used.
|
||||
property OnConsoleWrite : TConsoleWriteEvent Read GetOnConsoleWrite Write SetOnConsoleWrite;
|
||||
end;
|
||||
|
||||
{ TWorkerThreadRunnerApplication }
|
||||
|
||||
TWorkerThreadRunnerApplication = class(TWorkerWASIHostApplication)
|
||||
Private
|
||||
FThreadSupport : TWorkerThreadSupport;
|
||||
procedure HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
Protected
|
||||
function CreateHost: TWASIHost; override;
|
||||
procedure HandleMessage(aEvent: TJSEvent); override;
|
||||
procedure ShowException(aError: Exception); override;
|
||||
// Our thread support object
|
||||
Property ThreadSupport : TWorkerThreadSupport Read FThreadSupport Write FThreadSupport;
|
||||
end;
|
||||
|
||||
{ TWASIThreadHost }
|
||||
|
||||
{ TWASIThreadControllerHost }
|
||||
|
||||
TWASIThreadControllerHost = class(TWASIHost)
|
||||
private
|
||||
FSendOutputToBrowserWindow: Boolean;
|
||||
FThreadSupport: TThreadController;
|
||||
procedure SetThreadSupport(AValue: TThreadController);
|
||||
Protected
|
||||
procedure DoAfterInstantiate; override;
|
||||
Public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
// Send output to main window
|
||||
Property SendOutputToBrowserWindow : Boolean Read FSendOutputToBrowserWindow Write FSendOutputToBrowserWindow;
|
||||
// our thread
|
||||
Property ThreadSupport : TThreadController Read FThreadSupport Write SetThreadSupport;
|
||||
end;
|
||||
|
||||
{ TWorkerThreadControllerApplication }
|
||||
|
||||
TWorkerThreadControllerApplication = class(TWorkerWASIHostApplication)
|
||||
Private
|
||||
FThreadSupport : TThreadController;
|
||||
procedure HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
procedure HandleExecuteCommand(aCmd: TWorkerExecuteCommand);
|
||||
Protected
|
||||
procedure ShowException(aError: Exception); override;
|
||||
procedure HandleMessage(aEvent: TJSEvent); override;
|
||||
function CreateHost: TWASIHost; override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -229,25 +281,8 @@ end;
|
||||
|
||||
procedure TWASIThreadHost.PrepareWebAssemblyThread( aDescr: TWebAssemblyStartDescriptor);
|
||||
|
||||
Var
|
||||
func : JSValue;
|
||||
// InitFunc : TThreadInitInstanceFunction absolute func;
|
||||
res : Integer;
|
||||
|
||||
begin
|
||||
PrepareWebAssemblyInstance(aDescr);
|
||||
(*
|
||||
func:=aDescr.Exported[ThreadInitInstanceEntry];
|
||||
if Assigned(func) then
|
||||
begin
|
||||
res:=InitFunc(1,0,1);
|
||||
if Res<>0 then
|
||||
if Assigned(ThreadSupport) then
|
||||
ThreadSupport.SendConsoleMessage('Could not init assembly thread: %d', [Res])
|
||||
else
|
||||
Writeln('Could not init assembly thread: ',Res);
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
|
||||
procedure TWASIThreadHost.DoStdWrite(Sender: TObject; const aOutput: String);
|
||||
@ -370,20 +405,19 @@ begin
|
||||
SendCommand(E);
|
||||
end;
|
||||
|
||||
Procedure TWorkerThreadSupport.DoRunThread(aExports : TWASIExports);
|
||||
|
||||
procedure TWorkerThreadSupport.RunWasmModule(aCommand : TWorkerRunCommand);
|
||||
|
||||
Procedure DoRun (aExports : TWASIExports);
|
||||
|
||||
Var
|
||||
Var
|
||||
aResult : Integer;
|
||||
|
||||
begin
|
||||
begin
|
||||
try
|
||||
FState:=wsRunning;
|
||||
// Writeln('About to run webassembly entry point (',Host.ThreadEntryPoint,') for thread ID ',aCommand.ThreadID);
|
||||
aResult:=TThreadEntryPointFunction(aExports[Host.ThreadEntryPoint])(aCommand.ThreadID,aCommand.args);
|
||||
aResult:=TThreadEntryPointFunction(aExports[Host.ThreadEntryPoint])(FCurrentThreadInfo.ThreadID,FCurrentThreadInfo.Arguments);
|
||||
FState:=wsLoaded;
|
||||
if aResult>0 then
|
||||
Writeln('Thread run function result ',aResult);
|
||||
SendConsoleMessage('Thread run function result= %d ',[aResult]);
|
||||
except
|
||||
on E : Exception do
|
||||
SendException(E);
|
||||
@ -392,15 +426,30 @@ procedure TWorkerThreadSupport.RunWasmModule(aCommand : TWorkerRunCommand);
|
||||
on JE : TJSError do
|
||||
SendException(JE)
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadSupport.RunWasmModule(aCommand : TWorkerRunCommand);
|
||||
|
||||
begin
|
||||
if (FState=wsNeutral) then
|
||||
begin
|
||||
Writeln('No webassembly loaded');
|
||||
exit; // Todo: send error back
|
||||
end;
|
||||
if (FState in [wsRunning,wsRunWaiting]) then
|
||||
begin
|
||||
Writeln('Webassembly already running');
|
||||
exit; // Todo: send error back
|
||||
end;
|
||||
// Writeln('Entering TWorkerThreadSupport.RunWasmModule '+TJSJSON.Stringify(aCommand));
|
||||
// initialize current thread info
|
||||
FCurrentThreadInfo.ThreadID:=aCommand.ThreadID;
|
||||
FCurrentThreadInfo.Arguments:=aCommand.Args;
|
||||
Host.RunWebAssemblyThread(@DoRun);
|
||||
if FState=wsLoaded then
|
||||
Host.RunWebAssemblyThread(@DoRunThread)
|
||||
else
|
||||
FState:=wsRunWaiting;
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadSupport.LoadWasmModule(aCommand: TWorkerLoadCommand);
|
||||
@ -423,7 +472,10 @@ Var
|
||||
WASD.CallRun:=Nil;
|
||||
Host.PrepareWebAssemblyThread(WASD);
|
||||
SendLoaded;
|
||||
// These 2 prevent running different instances simultaneously.
|
||||
if FState=wsRunWaiting then
|
||||
Host.RunWebAssemblyThread(@DoRunThread)
|
||||
else
|
||||
FState:=wsLoaded;
|
||||
end;
|
||||
|
||||
function DoFail(aValue: JSValue): JSValue;
|
||||
@ -432,6 +484,7 @@ Var
|
||||
E: Exception;
|
||||
|
||||
begin
|
||||
FState:=wsNeutral;
|
||||
Result:=True;
|
||||
E:=Exception.Create('Failed to create webassembly. Reason: '+TJSJSON.Stringify(aValue));
|
||||
SendException(E);
|
||||
@ -440,6 +493,7 @@ Var
|
||||
|
||||
|
||||
begin
|
||||
FState:=wsLoading;
|
||||
FMemory:=aCommand.Memory;
|
||||
FModule:=aCommand.Module;
|
||||
InitThreadRange(aCommand.ThreadRangeStart);
|
||||
@ -455,7 +509,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TWorkerThreadSupport.InitThreadRange(aRange: Integer);
|
||||
|
||||
begin
|
||||
@ -565,39 +618,12 @@ begin
|
||||
FHost.RunEntryFunction:=aValue;
|
||||
end;
|
||||
|
||||
function TWorkerWASIHostApplication.CreateHost : TWASIHost;
|
||||
|
||||
Var
|
||||
TH : TWasiThreadHost;
|
||||
|
||||
begin
|
||||
TH:=TWASIThreadHost.Create(Self);
|
||||
FThreadSupport:=TWorkerThreadSupport.Create(TH.WasiEnvironment);
|
||||
FThreadSupport.OnSendCommand:=@DoOnSendCommand;
|
||||
TH.ThreadSupport:=FThreadSupport; // Sets FThreadSupport.host
|
||||
Result:=TH;
|
||||
end;
|
||||
|
||||
procedure TWorkerWASIHostApplication.DoRun;
|
||||
begin
|
||||
Self_.addEventListener('message',@HandleMessage);
|
||||
end;
|
||||
|
||||
procedure TWorkerWASIHostApplication.HandleMessage(aEvent: TJSEvent);
|
||||
|
||||
Var
|
||||
aMessageEvent : TJSMessageEvent absolute aEvent;
|
||||
aData : TWorkerCommand;
|
||||
|
||||
begin
|
||||
if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
|
||||
begin
|
||||
aData:=TWorkerCommand(aMessageEvent.Data);
|
||||
FThreadSupport.HandleCommand(aData);
|
||||
end
|
||||
else
|
||||
FThreadSupport.SendConsoleMessage('Unknown message received: '+TJSJSON.Stringify(aMessageEvent.Data));
|
||||
end;
|
||||
|
||||
procedure TWorkerWASIHostApplication.DoOnSendCommand(Sender: TObject;
|
||||
aCommand: TWorkerCommand);
|
||||
@ -624,10 +650,12 @@ constructor TWorkerWASIHostApplication.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
FHost:=CreateHost;
|
||||
FConsoleChannel:=TJSBroadcastChannel.new(channelConsole);
|
||||
end;
|
||||
|
||||
destructor TWorkerWASIHostApplication.Destroy;
|
||||
begin
|
||||
FConsoleChannel.Close;
|
||||
FreeAndNil(FHost);
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -648,11 +676,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkerWASIHostApplication.ShowException(E: Exception);
|
||||
|
||||
begin
|
||||
ThreadSupport.SendException(E);
|
||||
end;
|
||||
|
||||
procedure TWorkerWASIHostApplication.StartWebAssembly(aPath: string; DoRun: Boolean;
|
||||
aBeforeStart: TBeforeStartCallback = nil; aAfterStart: TAfterStartCallback = nil);
|
||||
@ -661,6 +684,150 @@ begin
|
||||
FHost.StartWebAssembly(aPath,DoRun,aBeforeStart,aAfterStart);
|
||||
end;
|
||||
|
||||
{ TWorkerThreadRunnerApplication }
|
||||
|
||||
procedure TWorkerThreadRunnerApplication.HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
begin
|
||||
Writeln('Console write ',aOutput);
|
||||
ConsoleChannel.postMessage(TWorkerConsoleCommand.Create(aOutput));
|
||||
end;
|
||||
|
||||
function TWorkerThreadRunnerApplication.CreateHost: TWASIHost;
|
||||
|
||||
var
|
||||
TH : TWasiThreadHost;
|
||||
|
||||
begin
|
||||
TH:=TWASIThreadHost.Create(Self);
|
||||
TH.OnConsoleWrite:=@HandleConsoleWrite;
|
||||
FThreadSupport:=TWorkerThreadSupport.Create(TH.WasiEnvironment);
|
||||
FThreadSupport.OnSendCommand:=@DoOnSendCommand;
|
||||
TH.ThreadSupport:=FThreadSupport; // Sets FThreadSupport.host
|
||||
Result:=TH;
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadRunnerApplication.ShowException(aError: Exception);
|
||||
|
||||
Var
|
||||
Ex : TWorkerExceptionCommand;
|
||||
|
||||
begin
|
||||
Ex:=TWorkerExceptionCommand.CreateNew(aError.ClassName,aError.Message);
|
||||
SendCommand(Ex);
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadRunnerApplication.HandleMessage(aEvent: TJSEvent);
|
||||
|
||||
Var
|
||||
aMessageEvent : TJSMessageEvent absolute aEvent;
|
||||
aData : TWorkerCommand;
|
||||
|
||||
begin
|
||||
if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
|
||||
begin
|
||||
aData:=TWorkerCommand(aMessageEvent.Data);
|
||||
FThreadSupport.HandleCommand(aData);
|
||||
end
|
||||
else
|
||||
FThreadSupport.SendConsoleMessage('Unknown message received: '+TJSJSON.Stringify(aMessageEvent.Data));
|
||||
end;
|
||||
|
||||
{ TWASIThreadControllerHost }
|
||||
|
||||
procedure TWASIThreadControllerHost.SetThreadSupport(AValue: TThreadController);
|
||||
begin
|
||||
if Assigned(FThreadSupport) then
|
||||
FThreadSupport.Host:=Nil;
|
||||
FThreadSupport:=AValue;
|
||||
if Assigned(FThreadSupport) then
|
||||
FThreadSupport.Host:=Self;
|
||||
end;
|
||||
|
||||
procedure TWASIThreadControllerHost.DoAfterInstantiate;
|
||||
begin
|
||||
inherited DoAfterInstantiate;
|
||||
If Assigned(FThreadSupport) then
|
||||
FThreadSupport.SendLoadCommands;
|
||||
end;
|
||||
|
||||
constructor TWASIThreadControllerHost.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
end;
|
||||
|
||||
|
||||
{ TWorkerThreadControllerApplication }
|
||||
|
||||
procedure TWorkerThreadControllerApplication.ShowException(aError: Exception);
|
||||
Var
|
||||
Ex : TWorkerExceptionCommand;
|
||||
|
||||
begin
|
||||
Ex:=TWorkerExceptionCommand.CreateNew(aError.ClassName,aError.Message);
|
||||
SendCommand(Ex);
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadControllerApplication.HandleExecuteCommand(aCmd : TWorkerExecuteCommand);
|
||||
|
||||
(*
|
||||
Function DoPrepare(Sender : TObject; aDescriptor : TWebAssemblyStartDescriptor) : Boolean;
|
||||
|
||||
begin
|
||||
// aDescriptor.
|
||||
Result:=True;
|
||||
end;
|
||||
*)
|
||||
|
||||
begin
|
||||
if isObject(aCmd.Env) then
|
||||
EnvNames:=aCmd.Env;
|
||||
if isString(aCmd.executeFunc) then
|
||||
FHost.RunEntryFunction:=aCmd.executeFunc;
|
||||
StartWebAssembly(aCmd.Url,True,Nil {@DoPrepare}, Nil)
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadControllerApplication.HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
begin
|
||||
FConsoleChannel.postMessage(TWorkerConsoleCommand.Create(aOutput,0));
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadControllerApplication.HandleMessage(aEvent: TJSEvent);
|
||||
|
||||
var
|
||||
aMessageEvent : TJSMessageEvent absolute aEvent;
|
||||
aData: TWorkerCommand;
|
||||
|
||||
begin
|
||||
if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
|
||||
begin
|
||||
aData:=TWorkerCommand(aMessageEvent.Data);
|
||||
case aData.Command of
|
||||
cmdExecute : HandleExecuteCommand(TWorkerExecuteCommand(aData));
|
||||
else
|
||||
FThreadSupport.HandleCommand(aData);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWorkerThreadControllerApplication.CreateHost: TWASIHost;
|
||||
var
|
||||
TH : TWASIThreadControllerHost;
|
||||
Mem : TJSWebAssemblyMemoryDescriptor;
|
||||
begin
|
||||
TH:=TWASIThreadControllerHost.Create(Self);
|
||||
TH.OnConsoleWrite:=@HandleConsoleWrite;
|
||||
FThreadSupport:=TThreadController.Create(TH.WasiEnvironment);
|
||||
Mem.Initial:=256;
|
||||
Mem.maximum:=1024;
|
||||
Mem.shared:=True;
|
||||
TH.MemoryDescriptor:=Mem;
|
||||
FThreadSupport.OnSendCommand:=@DoOnSendCommand;
|
||||
TH.ThreadSupport:=FThreadSupport; // Sets FThreadSupport.host
|
||||
Result:=TH;
|
||||
// TThreadController
|
||||
|
||||
end;
|
||||
|
||||
Initialization
|
||||
ReloadEnvironmentStrings;
|
||||
OnGetEnvironmentVariable:=@MyGetEnvironmentVariable;
|
||||
|
||||
@ -8,7 +8,7 @@ uses
|
||||
type
|
||||
{ TApplication }
|
||||
|
||||
TApplication = class(TWorkerWASIHostApplication)
|
||||
TApplication = class(TWorkerThreadRunnerApplication)
|
||||
end;
|
||||
|
||||
{ TApplication }
|
||||
|
||||
77
packages/wasi/worker/wasmthreadcontroller.lpi
Normal file
77
packages/wasi/worker/wasmthreadcontroller.lpi
Normal file
@ -0,0 +1,77 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
<Runnable Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="wasmthreadcontroller"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="wasmthreadcontroller.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target FileExt=".js">
|
||||
<Filename Value="wasmthreadcontroller"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="js"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
<CPPInline Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<TargetOS Value="nodejs"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-Jeutf-8 -Jminclude -Jirtl.js"/>
|
||||
<CompilerPath Value="$(pas2js)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
22
packages/wasi/worker/wasmthreadcontroller.pas
Normal file
22
packages/wasi/worker/wasmthreadcontroller.pas
Normal file
@ -0,0 +1,22 @@
|
||||
program wasmthreadcontroller;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
Classes, WasiWorkerThreadHost;
|
||||
|
||||
type
|
||||
{ TApplication }
|
||||
|
||||
TApplication = class(TWorkerThreadControllerApplication)
|
||||
end;
|
||||
|
||||
{ TApplication }
|
||||
|
||||
var
|
||||
App: TApplication;
|
||||
|
||||
begin
|
||||
App:=TApplication.Create(nil);
|
||||
App.Run;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user