From de318266476cd066939b060cb09751b5e2df8a33 Mon Sep 17 00:00:00 2001 From: Michael Van Canneyt Date: Wed, 6 Nov 2024 00:00:48 +0100 Subject: [PATCH] * Refactor so we can start threaded wasm application in a webworker --- packages/wasi/src/rtl.threadcontroller.pas | 535 ++++++++++++++++++ packages/wasi/src/wasithreadedapp.pas | 506 +---------------- packages/wasi/src/wasiworkerthreadhost.pas | 333 ++++++++--- packages/wasi/worker/pas2jsthreadworker.pas | 2 +- packages/wasi/worker/wasmthreadcontroller.lpi | 77 +++ packages/wasi/worker/wasmthreadcontroller.pas | 22 + 6 files changed, 914 insertions(+), 561 deletions(-) create mode 100644 packages/wasi/src/rtl.threadcontroller.pas create mode 100644 packages/wasi/worker/wasmthreadcontroller.lpi create mode 100644 packages/wasi/worker/wasmthreadcontroller.pas diff --git a/packages/wasi/src/rtl.threadcontroller.pas b/packages/wasi/src/rtl.threadcontroller.pas new file mode 100644 index 0000000..a430f74 --- /dev/null +++ b/packages/wasi/src/rtl.threadcontroller.pas @@ -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)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. + diff --git a/packages/wasi/src/wasithreadedapp.pas b/packages/wasi/src/wasithreadedapp.pas index 5b331c2..639508f 100644 --- a/packages/wasi/src/wasithreadedapp.pas +++ b/packages/wasi/src/wasithreadedapp.pas @@ -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)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. diff --git a/packages/wasi/src/wasiworkerthreadhost.pas b/packages/wasi/src/wasiworkerthreadhost.pas index 42fd949..a746ed1 100644 --- a/packages/wasi/src/wasiworkerthreadhost.pas +++ b/packages/wasi/src/wasiworkerthreadhost.pas @@ -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,37 +405,51 @@ begin SendCommand(E); end; +Procedure TWorkerThreadSupport.DoRunThread(aExports : TWASIExports); + +Var + aResult : Integer; + +begin + try + FState:=wsRunning; + // Writeln('About to run webassembly entry point (',Host.ThreadEntryPoint,') for thread ID ',aCommand.ThreadID); + aResult:=TThreadEntryPointFunction(aExports[Host.ThreadEntryPoint])(FCurrentThreadInfo.ThreadID,FCurrentThreadInfo.Arguments); + FState:=wsLoaded; + if aResult>0 then + SendConsoleMessage('Thread run function result= %d ',[aResult]); + except + on E : Exception do + SendException(E); + on JE : TJSError do + SendException(JE); + on JE : TJSError do + SendException(JE) + end; +end; + procedure TWorkerThreadSupport.RunWasmModule(aCommand : TWorkerRunCommand); - Procedure DoRun (aExports : TWASIExports); - - Var - aResult : Integer; - - begin - try - // Writeln('About to run webassembly entry point (',Host.ThreadEntryPoint,') for thread ID ',aCommand.ThreadID); - aResult:=TThreadEntryPointFunction(aExports[Host.ThreadEntryPoint])(aCommand.ThreadID,aCommand.args); - if aResult>0 then - Writeln('Thread run function result ',aResult); - except - on E : Exception do - SendException(E); - on JE : TJSError do - SendException(JE); - on JE : TJSError do - SendException(JE) - end; - - end; - 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; diff --git a/packages/wasi/worker/pas2jsthreadworker.pas b/packages/wasi/worker/pas2jsthreadworker.pas index 1f762f6..4a85ead 100644 --- a/packages/wasi/worker/pas2jsthreadworker.pas +++ b/packages/wasi/worker/pas2jsthreadworker.pas @@ -8,7 +8,7 @@ uses type { TApplication } - TApplication = class(TWorkerWASIHostApplication) + TApplication = class(TWorkerThreadRunnerApplication) end; { TApplication } diff --git a/packages/wasi/worker/wasmthreadcontroller.lpi b/packages/wasi/worker/wasmthreadcontroller.lpi new file mode 100644 index 0000000..0c9b787 --- /dev/null +++ b/packages/wasi/worker/wasmthreadcontroller.lpi @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + <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> diff --git a/packages/wasi/worker/wasmthreadcontroller.pas b/packages/wasi/worker/wasmthreadcontroller.pas new file mode 100644 index 0000000..0deef15 --- /dev/null +++ b/packages/wasi/worker/wasmthreadcontroller.pas @@ -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.