فهرست منبع

* Centralized logging, add sending message to all workers

Michael Van Canneyt 7 ماه پیش
والد
کامیت
0b6ae88cb3
1فایلهای تغییر یافته به همراه58 افزوده شده و 19 حذف شده
  1. 58 19
      packages/wasi/src/rtl.threadcontroller.pas

+ 58 - 19
packages/wasi/src/rtl.threadcontroller.pas

@@ -4,6 +4,8 @@ unit rtl.threadcontroller;
 {$modeswitch externalclass}
 {$modeswitch typehelpers}
 
+{ $define NOLOGAPICALLS}
+
 interface
 
 uses
@@ -56,11 +58,13 @@ Type
   // This object has the thread support that is needed  by the 'main' program
 
   { TThreadController }
+  TWasmThreadEvent = procedure (Sender : TObject; aWorker : TWasmThread) of object;
 
   TThreadController = class(TWasmThreadSupport)
   private
     FInitialWorkerCount: Integer;
     FMaxWorkerCount: Integer;
+    FOnAllocateWorker: TWasmThreadEvent;
     FOnUnknownMessage: TJSRawEventHandler;
     FHost: TWASIHost;
     FWorkerScript: String;
@@ -83,7 +87,7 @@ Type
     // 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;
+    Function AllocateNewWorker(Const aWorkerScript : string) : TWasmThread; virtual;
     // Send a load command
     procedure SendLoadCommand(aThreadWorker: TWasmThread); virtual;
     // Get new worker from pool, create new if needed.
@@ -113,6 +117,8 @@ Type
     Procedure HandleCommand(aWorker : TWasmThread; aCommand : TWorkerCommand); overload; virtual;
     // Send load commands to all workers that still need it.
     procedure SendLoadCommands;
+    // Send a command to all workers
+    procedure SendCommandToAllWorkers(aCommand : TWorkerCommand);
     // Name of worker script
     Property WorkerScript : String Read FWorkerScript;
     // Initial number of threads, set by constructor
@@ -120,6 +126,7 @@ Type
     // 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;
+    Property OnAllocateWorker : TWasmThreadEvent Read FOnAllocateWorker Write FonAllocateWorker;
     // The WASI host, used to run routines.
     Property Host : TWASIHost Read FHost Write SetWasiHost;
   end;
@@ -223,7 +230,6 @@ end;
 
 procedure TWasmThreadHelper.SendCommand(aCommand: TWorkerCommand);
 begin
-  // Writeln('Sending command '+TJSJSON.Stringify(aCommand));
   PostMessage(aCommand);
 end;
 
@@ -235,7 +241,10 @@ Var
   aWorker : TWasmThread;
 
 begin
-  // Writeln('Received worker message '+TJSJSON.Stringify(aMessageEvent.Data));
+  {$IFNDEF NOLOGAPICALLS}
+  if LogAPI then
+    DoLog('Received worker message '+TJSJSON.Stringify(aMessageEvent.Data));
+  {$ENDIF}
   if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
     begin
     aData:=TWorkerCommand(aMessageEvent.Data);
@@ -244,8 +253,10 @@ begin
     end
   else if Assigned(FOnUnknownMessage) then
     FOnUnknownMessage(aEvent)
-  else
-    Writeln('Unknown worker message : ',TJSJSON.stringify(aEvent));
+  {$IFNDEF NOLOGAPICALLS}
+  else if LogAPI then
+    DoLog('Unknown worker message : '+TJSJSON.stringify(aEvent));
+  {$ENDIF}
 end;
 
 function TThreadController.GetNextThreadIDRange : Integer;
@@ -258,14 +269,21 @@ end;
 function TThreadController.AllocateNewWorker(const aWorkerScript: string): TWasmThread;
 
 begin
-  // Writeln('Allocating new worker for: '+aWorkerScript);
+  {$IFNDEF NOLOGAPICALLS}
+  DoLog('Allocating new worker for: '+aWorkerScript);
+  {$ENDIF}
   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);
+  else if LogAPI then
+    {$IFNDEF NOLOGAPICALLS}
+    DoLog('Host not set, delaying sending load command to: '+aWorkerScript)
+    {$ENDIF}
+    ;
+  If Assigned(OnAllocateWorker) then
+    OnAllocateWorker(Self,Result);
 end;
 
 procedure TThreadController.SendLoadCommand(aThreadWorker: TWasmThread);
@@ -287,7 +305,8 @@ Var
 begin
   if Length(FIdleWorkers)=0 then
     begin
-    // Writeln('No idle workers, creating new one');
+    if LogAPI then
+      DoLog('No idle workers, creating new one');
     if Length(FBusyWorkers)<MaxWorkerCount then
       WT:=AllocateNewWorker(FWorkerScript)
     else
@@ -317,7 +336,6 @@ procedure TThreadController.SetWasiHost(AValue: TWASIHost);
 
 
 begin
-  // Writeln('Setting wasi host');
   if FHost=AValue then
     Exit;
   FHost:=AValue;
@@ -331,7 +349,6 @@ var
   aInfo : TThreadInfo;
 
 begin
-  Writeln('In host thread_spawn');
   aInfo.ThreadID:=AllocateThreadID;
   aInfo.Arguments:=start_arg;
   aInfo.OriginThreadID:=0;
@@ -367,12 +384,26 @@ Var
   WT : TWasmThread;
 
 begin
-  // Writeln('Sending load command to all workers');
+  {$IFNDEF NOLOGAPICALLS}
+  DoLog('Sending load command to all workers');
+  {$ENDIF}
   For WT in FIdleWorkers do
     if not WT.LoadSent then
       SendLoadCommand(WT);
 end;
 
+procedure TThreadController.SendCommandToAllWorkers(aCommand: TWorkerCommand);
+
+Var
+  WT : TWasmThread;
+
+begin
+  For WT in FIdleWorkers do
+    WT.postMessage(aCommand);
+  For WT in FBusyWorkers do
+    WT.postMessage(aCommand);
+end;
+
 procedure TThreadController.RunTimeOut(aInfo: TThreadInfo; aInterval: Integer);
 
 var
@@ -380,7 +411,7 @@ var
 
 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);
+  DoLog(msg);
 end;
 
 function TThreadController.SpawnThread(aInfo: TThreadInfo): Integer;
@@ -390,18 +421,22 @@ Var
 
 
 begin
-  // Writeln('Enter TThreadController.SpawnThread for ID ',aInfo.ThreadID);
+  {$IFNDEF NOLOGAPICALLS}
+  DoLog('Enter SpawnThread for ID %d',[aInfo.ThreadID]);
+  {$ENDIF}
   WT:=GetNewWorker;
   if WT=nil then
     begin
-    Writeln('Error: no worker !');
+    DoError('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);
+  Result:=aInfo.ThreadID;
+  {$IFNDEF NOLOGAPICALLS}
+  DoLog('Exit: SpawnThread for ID %d',[WT.ThreadID]);
+  {$ENDIF}
 end;
 
 
@@ -455,12 +490,16 @@ end;
 procedure TThreadController.HandleLoadedCommand(aWorker : TWasmThread; aCommand: TWorkerLoadedCommand);
 
 begin
-  // Writeln('Host: Entering TThreadController.HandleLoadedCommand');
+  {$IFNDEF NOLOGAPICALLS}
+  DoLog('Entering TThreadController.HandleLoadedCommand');
+  {$ENDIF}
   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');
+  {$IFNDEF NOLOGAPICALLS}
+  DoLog('Host: exiting TThreadController.HandleLoadedCommand');
+  {$ENDIF}
   if (aCommand<>Nil) then ;
 end;