Browse Source

* Register ready command

Michael Van Canneyt 3 months ago
parent
commit
1fd96e3a1c
1 changed files with 63 additions and 55 deletions
  1. 63 55
      packages/wasi/src/rtl.threadcontroller.pas

+ 63 - 55
packages/wasi/src/rtl.threadcontroller.pas

@@ -20,22 +20,24 @@ Type
   TWasmThread = TJSWorker;
   TWasmThread = TJSWorker;
 
 
   { TWasmThreadHelper }
   { TWasmThreadHelper }
-
+  TThreadWorkerState = (twsInit,      // Worker is started
+                        twsReady,     // Worker is ready to listen to commands
+                        twsLoadSent,  // We sent a load command
+                        twsIdle,      // The worker has a webassembly loaded and is ready to execute a thread
+                        twsExecuting  // The worker is executing a thread
+                        );
   TWasmThreadHelper = Class helper for TWasmThread
   TWasmThreadHelper = Class helper for TWasmThread
   private
   private
-    function GetLoaded: Boolean;
-    function GetLoadSent: Boolean;
     function GetThreadID: Integer;
     function GetThreadID: Integer;
     function GetThreadInfo: TThreadinfo;
     function GetThreadInfo: TThreadinfo;
-    procedure SetLoaded(AValue: Boolean);
-    procedure SetLoadSent(AValue: Boolean);
+    function GetWorkerState: TThreadWorkerState;
     procedure SetThreadID(AValue: Integer);
     procedure SetThreadID(AValue: Integer);
     procedure SetThreadInfo(AValue: TThreadinfo);
     procedure SetThreadInfo(AValue: TThreadinfo);
+    procedure SetWorkerState(AValue: TThreadWorkerState);
   Public
   Public
     Class function Create(aScript : String) : TWasmThread; reintroduce; static;
     Class function Create(aScript : String) : TWasmThread; reintroduce; static;
     Procedure SendCommand(aCommand : TThreadWorkerCommand);
     Procedure SendCommand(aCommand : TThreadWorkerCommand);
-    Property LoadSent : Boolean Read GetLoadSent Write SetLoadSent;
-    Property Loaded : Boolean Read GetLoaded Write SetLoaded;
+    Property WorkerState : TThreadWorkerState read GetWorkerState Write SetWorkerState;
     Property ThreadInfo : TThreadinfo Read GetThreadInfo Write SetThreadInfo;
     Property ThreadInfo : TThreadinfo Read GetThreadInfo Write SetThreadInfo;
     Property ThreadID : Integer Read GetThreadID Write SetThreadID;
     Property ThreadID : Integer Read GetThreadID Write SetThreadID;
   end;
   end;
@@ -71,6 +73,7 @@ Type
     FOnUnknownMessage: TJSRawEventHandler;
     FOnUnknownMessage: TJSRawEventHandler;
     FWorkerScript: String;
     FWorkerScript: String;
     procedure HandleRawCleanupCommand(aCommand: TCustomWorkerCommand);
     procedure HandleRawCleanupCommand(aCommand: TCustomWorkerCommand);
+    procedure HandleRawReadyCommand(aCommand: TCustomWorkerCommand);
     procedure HandleRawSpawnCommand(aCommand: TCustomWorkerCommand);
     procedure HandleRawSpawnCommand(aCommand: TCustomWorkerCommand);
     procedure HandleRawLoadedCommand(aCommand: TCustomWorkerCommand);
     procedure HandleRawLoadedCommand(aCommand: TCustomWorkerCommand);
     procedure HandleRawConsoleCommand(aCommand: TCustomWorkerCommand);
     procedure HandleRawConsoleCommand(aCommand: TCustomWorkerCommand);
@@ -100,6 +103,8 @@ Type
     //
     //
     // Allocate a new worker for a thread and run the thread if the worker is loaded.
     // Allocate a new worker for a thread and run the thread if the worker is loaded.
     procedure HandleSpawnCommand(aWorker: TWasmThread; aCommand: TWorkerSpawnThreadCommand); virtual;
     procedure HandleSpawnCommand(aWorker: TWasmThread; aCommand: TWorkerSpawnThreadCommand); virtual;
+    // A new worker was started and is ready to handle commands (message handler is set).
+    procedure HandleReadyCommand(aWorker: TWasmThread; aCommand: TWorkerReadyCommand); virtual;
     // Cancel command: stop the thread
     // Cancel command: stop the thread
     procedure HandleCancelCommand(aWorker: TWasmThread; aCommand: TWorkerCancelCommand); virtual;
     procedure HandleCancelCommand(aWorker: TWasmThread; aCommand: TWorkerCancelCommand); virtual;
     // Cleanup thread : after join (or stopped if detached), free worker.
     // Cleanup thread : after join (or stopped if detached), free worker.
@@ -112,11 +117,11 @@ Type
     procedure HandleConsoleCommand(aWorker: TWasmThread;  aCommand: TWorkerConsoleCommand);
     procedure HandleConsoleCommand(aWorker: TWasmThread;  aCommand: TWorkerConsoleCommand);
     // Register callbacks
     // Register callbacks
     procedure InitMessageCallBacks;
     procedure InitMessageCallBacks;
-    // Spawn initial workers;
-    procedure AllocateInitialworkers;
   Public
   Public
     Constructor Create; override;
     Constructor Create; override;
     Constructor Create(aWorkerScript : String; aSpawnWorkerCount : integer); virtual; overload;
     Constructor Create(aWorkerScript : String; aSpawnWorkerCount : integer); virtual; overload;
+    // Spawn initial workers; Best called manually, but will be called at the end.
+    procedure AllocateInitialworkers;
     // Find thread based on thread ID
     // Find thread based on thread ID
     function FindThreadWorker(aThreadID: integer): TWasmThread;
     function FindThreadWorker(aThreadID: integer): TWasmThread;
     // the interface needed by wasmP1
     // the interface needed by wasmP1
@@ -162,34 +167,10 @@ class function TWasmThreadHelper.Create(aScript: String): TWasmThread;
 begin
 begin
   Result:=TJSWorker.new(aScript);
   Result:=TJSWorker.new(aScript);
   Result.ThreadID:=-1;
   Result.ThreadID:=-1;
-  Result.Loaded:=False;
-  Result.LoadSent:=False;
+  Result.WorkerState:=twsInit;
   Result.ThreadInfo:=Default(TThreadInfo);
   Result.ThreadInfo:=Default(TThreadInfo);
 end;
 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;
 function TWasmThreadHelper.GetThreadID: Integer;
 begin
 begin
   Result:=ThreadInfo.ThreadID;
   Result:=ThreadInfo.ThreadID;
@@ -207,18 +188,17 @@ begin
     Result:=Default(TThreadInfo);
     Result:=Default(TThreadInfo);
 end;
 end;
 
 
-procedure TWasmThreadHelper.SetLoaded(AValue: Boolean);
-begin
-  Properties['FLoaded']:=aValue
-end;
-
-procedure TWasmThreadHelper.SetLoadSent(AValue: Boolean);
+function TWasmThreadHelper.GetWorkerState: TThreadWorkerState;
+var
+  S : JSValue;
 begin
 begin
-  Properties['FLoadSent']:=aValue;
+  S:=Properties['FState'];
+  if isNumber(S) then
+    Result:=TThreadWorkerState(Integer(S))
+  else
+    Result:=twsInit;
 end;
 end;
 
 
-
-
 procedure TWasmThreadHelper.SetThreadID(AValue: Integer);
 procedure TWasmThreadHelper.SetThreadID(AValue: Integer);
 begin
 begin
   ThreadInfo.ThreadID:=aValue;
   ThreadInfo.ThreadID:=aValue;
@@ -230,6 +210,11 @@ begin
   Properties['FThreadInfo']:=aValue
   Properties['FThreadInfo']:=aValue
 end;
 end;
 
 
+procedure TWasmThreadHelper.SetWorkerState(AValue: TThreadWorkerState);
+begin
+  Properties['FState']:=aValue;
+end;
+
 
 
 procedure TWasmThreadHelper.SendCommand(aCommand: TThreadWorkerCommand);
 procedure TWasmThreadHelper.SendCommand(aCommand: TThreadWorkerCommand);
 begin
 begin
@@ -253,9 +238,7 @@ begin
   lWorkerUrl:=lWorkerUrl+'worker='+IntToStr(FWorkerCount);
   lWorkerUrl:=lWorkerUrl+'worker='+IntToStr(FWorkerCount);
   Result:=TWasmThread.Create(lWorkerUrl);
   Result:=TWasmThread.Create(lWorkerUrl);
   TCommandDispatcher.Instance.RegisterWorker(Result,'threadworker'+inttostr(FWorkerCount));
   TCommandDispatcher.Instance.RegisterWorker(Result,'threadworker'+inttostr(FWorkerCount));
-  if Assigned(WasmMemory) and Assigned(WasmModule) then
-    SendLoadCommand(Result)
-  else if LogAPI then
+  if LogAPI then
     {$IFNDEF NOLOGAPICALLS}
     {$IFNDEF NOLOGAPICALLS}
     DoLog('Host not set, delaying sending load command to: '+aWorkerScript)
     DoLog('Host not set, delaying sending load command to: '+aWorkerScript)
     {$ENDIF}
     {$ENDIF}
@@ -270,9 +253,10 @@ Var
   WLC: TWorkerLoadCommand;
   WLC: TWorkerLoadCommand;
 
 
 begin
 begin
+  Writeln('Sending load command to worker.');
   WLC:=TWorkerLoadCommand.Create(WasmModule, WasmMemory);
   WLC:=TWorkerLoadCommand.Create(WasmModule, WasmMemory);
   aThreadWorker.SendCommand(WLC);
   aThreadWorker.SendCommand(WLC);
-  aThreadWorker.LoadSent:=True;
+  aThreadWorker.WorkerState:=twsLoadSent;
 end;
 end;
 
 
 function TThreadController.GetNewWorker: TWasmThread;
 function TThreadController.GetNewWorker: TWasmThread;
@@ -335,11 +319,12 @@ Var
   WT : TWasmThread;
   WT : TWasmThread;
 
 
 begin
 begin
+  Writeln('Send load commands');
   {$IFNDEF NOLOGAPICALLS}
   {$IFNDEF NOLOGAPICALLS}
   DoLog('Sending load command to all workers');
   DoLog('Sending load command to all workers');
   {$ENDIF}
   {$ENDIF}
   For WT in FIdleWorkers do
   For WT in FIdleWorkers do
-    if not WT.LoadSent then
+    if WT.WorkerState=twsReady then
       SendLoadCommand(WT);
       SendLoadCommand(WT);
 end;
 end;
 
 
@@ -450,7 +435,7 @@ var
   lCmd : TWorkerSpawnThreadCommand absolute aCommand;
   lCmd : TWorkerSpawnThreadCommand absolute aCommand;
   lWorker : TWasmThread;
   lWorker : TWasmThread;
 begin
 begin
-  lWorker:=FindThreadWorker(lCmd.ThreadID);
+  lWorker:=TWasmThread(aCommand.Sender);
   HandleSpawnCommand(lWorker,lCmd);
   HandleSpawnCommand(lWorker,lCmd);
 end;
 end;
 
 
@@ -467,12 +452,13 @@ begin
   SpawnThread(aInfo);
   SpawnThread(aInfo);
 end;
 end;
 
 
+
 procedure TThreadController.HandleRawKillCommand(aCommand: TCustomWorkerCommand);
 procedure TThreadController.HandleRawKillCommand(aCommand: TCustomWorkerCommand);
 var
 var
   lCmd : TWorkerKillCommand absolute aCommand;
   lCmd : TWorkerKillCommand absolute aCommand;
   lWorker : TWasmThread;
   lWorker : TWasmThread;
 begin
 begin
-  lWorker:=FindThreadWorker(lCmd.ThreadID);
+  lWorker:=TWasmThread(aCommand.Sender);
   HandleKillCommand(lWorker,lCmd);
   HandleKillCommand(lWorker,lCmd);
 end;
 end;
 
 
@@ -488,7 +474,7 @@ var
   lCmd : TWorkerCancelCommand absolute aCommand;
   lCmd : TWorkerCancelCommand absolute aCommand;
   lWorker : TWasmThread;
   lWorker : TWasmThread;
 begin
 begin
-  lWorker:=FindThreadWorker(lCmd.ThreadID);
+  lWorker:=TWasmThread(aCommand.Sender);
   HandleCancelCommand(lWorker,lCmd);
   HandleCancelCommand(lWorker,lCmd);
 end;
 end;
 
 
@@ -510,7 +496,8 @@ var
   lCmd : TWorkerLoadedCommand absolute aCommand;
   lCmd : TWorkerLoadedCommand absolute aCommand;
   lWorker : TWasmThread;
   lWorker : TWasmThread;
 begin
 begin
-  lWorker:=FindThreadWorker(lCmd.ThreadID);
+  Writeln('Receiving loaded command');
+  lWorker:=TWasmThread(aCommand.Sender);
   HandleLoadedCommand(lWorker,lCmd);
   HandleLoadedCommand(lWorker,lCmd);
 end;
 end;
 
 
@@ -520,7 +507,7 @@ begin
   {$IFNDEF NOLOGAPICALLS}
   {$IFNDEF NOLOGAPICALLS}
   DoLog('Entering TThreadController.HandleLoadedCommand');
   DoLog('Entering TThreadController.HandleLoadedCommand');
   {$ENDIF}
   {$ENDIF}
-  aWorker.Loaded:=True;
+  aWorker.WorkerState:=twsIdle;
   // if a thread is scheduled to run in this thread, run it.
   // if a thread is scheduled to run in this thread, run it.
   if aWorker.ThreadID>0 then
   if aWorker.ThreadID>0 then
     SendRunCommand(aWorker);
     SendRunCommand(aWorker);
@@ -535,10 +522,29 @@ var
   lCmd : TWorkerCleanupCommand absolute aCommand;
   lCmd : TWorkerCleanupCommand absolute aCommand;
   lWorker : TWasmThread;
   lWorker : TWasmThread;
 begin
 begin
-  lWorker:=FindThreadWorker(lCmd.ThreadID);
+  lWorker:=TWasmThread(aCommand.Sender);
   HandleCleanupCommand(lWorker,lCmd);
   HandleCleanupCommand(lWorker,lCmd);
 end;
 end;
 
 
+procedure TThreadController.HandleRawReadyCommand(aCommand: TCustomWorkerCommand);
+var
+  lCmd : TWorkerReadyCommand absolute aCommand;
+  lWorker : TWasmThread;
+begin
+  Writeln('Had ready command');
+  lWorker:=TWasmThread(aCommand.Sender);
+  HandleReadyCommand(lWorker,lCmd);
+end;
+
+procedure TThreadController.HandleReadyCommand(aWorker : TWasmThread; aCommand: TWorkerReadyCommand);
+
+begin
+  // Send load command to worker
+  aWorker.WorkerState:=twsReady;
+  if Assigned(WasmMemory) and Assigned(WasmModule) then
+    SendLoadCommand(aWorker);
+end;
+
 procedure TThreadController.HandleCleanupCommand(aWorker : TWasmThread; aCommand: TWorkerCleanupCommand);
 procedure TThreadController.HandleCleanupCommand(aWorker : TWasmThread; aCommand: TWorkerCleanupCommand);
 
 
 Var
 Var
@@ -546,6 +552,7 @@ Var
 
 
 begin
 begin
   aWorker.ThreadInfo:=Default(TThreadInfo);
   aWorker.ThreadInfo:=Default(TThreadInfo);
+  aWorker.WorkerState:=twsIdle;
   Idx:=TJSarray(FBusyWorkers).indexOf(aWorker);
   Idx:=TJSarray(FBusyWorkers).indexOf(aWorker);
   if Idx<>-1 then
   if Idx<>-1 then
     Delete(FBusyWorkers,Idx,1);
     Delete(FBusyWorkers,Idx,1);
@@ -560,7 +567,7 @@ var
   lCmd : TWorkerConsoleCommand absolute aCommand;
   lCmd : TWorkerConsoleCommand absolute aCommand;
   lWorker : TWasmThread;
   lWorker : TWasmThread;
 begin
 begin
-  lWorker:=FindThreadWorker(lCmd.ThreadID);
+  lWorker:=TWasmThread(aCommand.Sender);
   HandleConsoleCommand(lWorker,lCmd);
   HandleConsoleCommand(lWorker,lCmd);
 end;
 end;
 
 
@@ -594,6 +601,7 @@ begin
     RegisterCommandHandler(cmdCancel,@HandleRawCancelCommand);
     RegisterCommandHandler(cmdCancel,@HandleRawCancelCommand);
     RegisterCommandHandler(cmdLoaded,@HandleRawLoadedCommand);
     RegisterCommandHandler(cmdLoaded,@HandleRawLoadedCommand);
     RegisterCommandHandler(cmdConsole,@HandleRawConsoleCommand);
     RegisterCommandHandler(cmdConsole,@HandleRawConsoleCommand);
+    RegisterCommandHandler(cmdReady,@HandleRawReadyCommand);
     end;
     end;
 end;
 end;