* Refactor so we can start threaded wasm application in a webworker

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)<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.
+

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 }
+  TMainThreadSupport = class(TThreadController);
-  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;
 
   { 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.
 

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;

packages/wasi/worker/pas2jsthreadworker.pas

@@ -8,7 +8,7 @@ uses
 type
   { TApplication }
 
-  TApplication = class(TWorkerWASIHostApplication)
+  TApplication = class(TWorkerThreadRunnerApplication)
   end;
 
 { TApplication }

packages/wasi/worker/wasmthreadcontroller.lpi

@@ -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>

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.