浏览代码

* Fix thread ID to be in line with current FPC wasm

Michael Van Canneyt 7 月之前
父节点
当前提交
e8a434cd7a

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

@@ -68,8 +68,6 @@ Type
     FOnUnknownMessage: TJSRawEventHandler;
     FOnUnknownMessage: TJSRawEventHandler;
     FHost: TWASIHost;
     FHost: TWASIHost;
     FWorkerScript: String;
     FWorkerScript: String;
-    FNextIDRange : Integer;
-    FNextThreadID : Integer;
     procedure SetWasiHost(AValue: TWASIHost);
     procedure SetWasiHost(AValue: TWASIHost);
   Protected
   Protected
     procedure RunTimeOut(aInfo: TThreadInfo; aInterval: Integer); virtual;
     procedure RunTimeOut(aInfo: TThreadInfo; aInterval: Integer); virtual;
@@ -77,13 +75,10 @@ Type
     Function thread_detach(thread_id : longint) : Integer; override;
     Function thread_detach(thread_id : longint) : Integer; override;
     Function thread_cancel(thread_id : longint) : Integer; override;
     Function thread_cancel(thread_id : longint) : Integer; override;
     Function thread_self() : Integer; override;
     Function thread_self() : Integer; override;
-    function AllocateThreadID : Integer;
   Protected
   Protected
     FIdleWorkers : Array of TWasmThread;
     FIdleWorkers : Array of TWasmThread;
     FBusyWorkers : Array of TWasmThread;
     FBusyWorkers : Array of TWasmThread;
     FThreads : TThreadHash; // ThreadID is key,
     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.
     // Handle worker messages. If it is a command, it is set to handlecommand.
     procedure DoWorkerMessage(aEvent: TJSEvent);
     procedure DoWorkerMessage(aEvent: TJSEvent);
     // Create & set up new worker
     // Create & set up new worker
@@ -259,13 +254,6 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
-function TThreadController.GetNextThreadIDRange : Integer;
-
-begin
-  Inc(FNextIDRange,ThreadIDInterval);
-  Result:=FNextIDRange;
-end;
-
 function TThreadController.AllocateNewWorker(const aWorkerScript: string): TWasmThread;
 function TThreadController.AllocateNewWorker(const aWorkerScript: string): TWasmThread;
 
 
 begin
 begin
@@ -273,7 +261,6 @@ begin
   DoLog('Allocating new worker for: '+aWorkerScript);
   DoLog('Allocating new worker for: '+aWorkerScript);
   {$ENDIF}
   {$ENDIF}
   Result:=TWasmThread.Create(aWorkerScript);
   Result:=TWasmThread.Create(aWorkerScript);
-  Result.ThreadIDRange:=GetNextThreadIDRange;
   Result.addEventListener('message',@DoWorkerMessage);
   Result.addEventListener('message',@DoWorkerMessage);
   if Assigned(Host) and Host.StartDescriptorReady then
   if Assigned(Host) and Host.StartDescriptorReady then
     SendLoadCommand(Result)
     SendLoadCommand(Result)
@@ -349,7 +336,7 @@ var
   aInfo : TThreadInfo;
   aInfo : TThreadInfo;
 
 
 begin
 begin
-  aInfo.ThreadID:=AllocateThreadID;
+  aInfo.ThreadID:=start_arg;
   aInfo.Arguments:=start_arg;
   aInfo.Arguments:=start_arg;
   aInfo.OriginThreadID:=0;
   aInfo.OriginThreadID:=0;
   Result:=SpawnThread(aInfo);
   Result:=SpawnThread(aInfo);
@@ -372,11 +359,6 @@ begin
   Result:=-1;
   Result:=-1;
 end;
 end;
 
 
-function TThreadController.AllocateThreadID: Integer;
-begin
-  Inc(FNextThreadID);
-  Result:=FNextThreadID;
-end;
 
 
 procedure TThreadController.SendLoadCommands;
 procedure TThreadController.SendLoadCommands;
 
 

+ 0 - 52
packages/wasi/src/rtl.webthreads.pas

@@ -42,8 +42,6 @@ Const
   cmdCancel = 'cancel';
   cmdCancel = 'cancel';
   cmdLoaded = 'loaded';
   cmdLoaded = 'loaded';
   cmdKill = 'kill';
   cmdKill = 'kill';
-  cmdNeedIdBlock = 'needidblock';
-  cmdThreadIdRange = 'threadidrange';
   cmdSpawn = 'spawn';
   cmdSpawn = 'spawn';
   cmdLoad = 'load';
   cmdLoad = 'load';
   cmdRun = 'run';
   cmdRun = 'run';
@@ -172,17 +170,6 @@ Type
     Class function Create: TWorkerLoadedCommand; static; reintroduce;
     Class function Create: TWorkerLoadedCommand; static; reintroduce;
   end;
   end;
 
 
-  // Sent to notify main thread that a new range of IDs is needed.
-  TWorkerNeedIdBlockCommand = class external name 'Object' (TWorkerCommand)
-    Current : NativeInt;
-  end;
-
-  { TWorkerNeedIdBlockCommandHelper }
-
-  TWorkerNeedIdBlockCommandHelper = class helper for TWorkerNeedIdBlockCommand
-    Class function CommandName : string; static;
-    Class function Create(aCurrent : NativeInt): TWorkerNeedIdBlockCommand; static; reintroduce;
-  end;
 
 
 
 
   // Sent to notify main thread that a new thread must be started.
   // Sent to notify main thread that a new thread must be started.
@@ -284,18 +271,6 @@ Type
 
 
 
 
 
 
-  // Sent to worker with new range of thread IDs.
-  TWorkerThreadIDRangeCommand = class external name 'Object' (TWorkerCommand)
-    RangeStart : NativeInt;
-  end;
-
-  { TWorkerThreadIDRangeCommandHelper }
-
-  TWorkerThreadIDRangeCommandHelper = class helper for TWorkerThreadIDRangeCommand
-    Class function CommandName : string; static;
-    class function Create(aRangeStart: NativeInt): TWorkerThreadIDRangeCommand;  static; reintroduce;
-  end;
-
 
 
 
 
   TThreadinfo = record
   TThreadinfo = record
@@ -425,33 +400,6 @@ begin
   Result.Arguments:=aArgs;
   Result.Arguments:=aArgs;
 end;
 end;
 
 
-{ TWorkerThreadIDRangeCommandHelper }
-
-class function TWorkerThreadIDRangeCommandHelper.CommandName: string;
-begin
-  Result:=cmdThreadIdRange;
-end;
-
-class function TWorkerThreadIDRangeCommandHelper.Create(aRangeStart: NativeInt
-  ): TWorkerThreadIDRangeCommand;
-begin
-  Result:=TWorkerThreadIDRangeCommand(TWorkerCommand.NewWorker(CommandName));
-  Result.RangeStart:=aRangeStart;
-end;
-
-{ TWorkerNeedIdBlockCommandHelper }
-
-class function TWorkerNeedIdBlockCommandHelper.CommandName: string;
-begin
-  Result:=cmdNeedIdBlock;
-end;
-
-class function TWorkerNeedIdBlockCommandHelper.Create(aCurrent: NativeInt
-  ): TWorkerNeedIdBlockCommand;
-begin
-  Result:=TWorkerNeedIdBlockCommand(TWorkerCommand.NewWorker(CommandName));
-  Result.Current:=aCurrent;
-end;
 
 
 
 
 { TWorkerLoadedCommandHelper }
 { TWorkerLoadedCommandHelper }

+ 3 - 46
packages/wasi/src/wasiworkerthreadhost.pas

@@ -58,24 +58,15 @@ Type
     procedure DoRunThread(aExports: TWASIExports);
     procedure DoRunThread(aExports: TWASIExports);
   Private
   Private
     FState: TWorkerState;
     FState: TWorkerState;
-    FStartThreadID : Integer;
-    FNextThreadID : Integer;
     FCurrentThreadInfo : TThreadinfo;
     FCurrentThreadInfo : TThreadinfo;
     FModule : TJSWebAssemblyModule;
     FModule : TJSWebAssemblyModule;
     FMemory : TJSWebAssemblyMemory;
     FMemory : TJSWebAssemblyMemory;
     FWasiHost: TWASIThreadHost;
     FWasiHost: TWASIThreadHost;
   Protected
   Protected
-    // Set new thread range
-    procedure InitThreadRange(aRange: Integer);
-    // allocate new thread ID.
-    Function AllocateNewThreadID : NativeInt;
     // Incoming messages
     // Incoming messages
     procedure LoadWasmModule(aCommand: TWorkerLoadCommand); virtual;
     procedure LoadWasmModule(aCommand: TWorkerLoadCommand); virtual;
     procedure RunWasmModule(aCommand: TWorkerRunCommand); virtual;
     procedure RunWasmModule(aCommand: TWorkerRunCommand); virtual;
     procedure CancelWasmModule(aCommand: TWorkerCancelCommand); virtual;
     procedure CancelWasmModule(aCommand: TWorkerCancelCommand); virtual;
-    procedure SetThreadRange(aCommand: TWorkerThreadIDRangeCommand); virtual;
-    // outgoing messages
-    procedure RequestNewThreadBlock; virtual;
     procedure SendLoaded; virtual;
     procedure SendLoaded; virtual;
     Procedure SendConsoleMessage(aMessage : String); overload;
     Procedure SendConsoleMessage(aMessage : String); overload;
     Procedure SendConsoleMessage(aFmt : String; const aArgs : array of const); overload;
     Procedure SendConsoleMessage(aFmt : String; const aArgs : array of const); overload;
@@ -322,12 +313,11 @@ function TWorkerThreadSupport.thread_spawn(start_arg: longint): longint;
 
 
 Var
 Var
   P : TWorkerSpawnThreadCommand;
   P : TWorkerSpawnThreadCommand;
-  lThreadID : Integer;
+
 begin
 begin
-  lThreadID:=AllocateNewThreadID;
-  P:=TWorkerSpawnThreadCommand.Create(lThreadID,start_arg);
+  P:=TWorkerSpawnThreadCommand.Create(start_arg,start_arg);
   SendCommand(P);
   SendCommand(P);
-  Result:=lThreadID;
+  Result:=start_arg;
 end;
 end;
 
 
 function TWorkerThreadSupport.thread_detach(thread_id: Integer): Integer;
 function TWorkerThreadSupport.thread_detach(thread_id: Integer): Integer;
@@ -347,17 +337,6 @@ begin
   Result:=0;
   Result:=0;
 end;
 end;
 
 
-function TWorkerThreadSupport.AllocateNewThreadID: NativeInt;
-
-begin
-  if (FNextThreadID-FStartThreadID)>=ThreadIDInterval then
-    FNextThreadID:=FStartThreadID;
-  Inc(FNextThreadID);
-  if (FNextThreadID-FStartThreadID)=ThreadIDInterval-ThreadIDMargin then
-    RequestNewThreadBlock;
-  Result:=FNextThreadID;
-end;
-
 procedure TWorkerThreadSupport.SendLoaded;
 procedure TWorkerThreadSupport.SendLoaded;
 
 
 Var
 Var
@@ -520,7 +499,6 @@ begin
   FState:=wsLoading;
   FState:=wsLoading;
   FMemory:=aCommand.Memory;
   FMemory:=aCommand.Memory;
   FModule:=aCommand.Module;
   FModule:=aCommand.Module;
-  InitThreadRange(aCommand.ThreadRangeStart);
   try
   try
     aTable:=TJSWebAssemblyTable.New(Host.TableDescriptor);
     aTable:=TJSWebAssemblyTable.New(Host.TableDescriptor);
     WASD:=Host.InitStartDescriptor(FMemory,aTable,Nil);
     WASD:=Host.InitStartDescriptor(FMemory,aTable,Nil);
@@ -533,26 +511,6 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TWorkerThreadSupport.InitThreadRange(aRange: Integer);
-
-begin
-  FStartThreadID:=aRange;
-  FNextThreadID:=FStartThreadID;
-end;
-
-procedure TWorkerThreadSupport.RequestNewThreadBlock;
-
-begin
-  SendCommand(TWorkerNeedIdBlockCommand.Create(FNextThreadID));
-end;
-
-procedure TWorkerThreadSupport.SetThreadRange(
-  aCommand: TWorkerThreadIDRangeCommand);
-
-begin
-  InitThreadRange(aCommand.RangeStart);
-end;
-
 procedure TWorkerThreadSupport.HandleCommand(aCommand: TWorkerCommand);
 procedure TWorkerThreadSupport.HandleCommand(aCommand: TWorkerCommand);
 
 
 begin
 begin
@@ -560,7 +518,6 @@ begin
     cmdload : LoadWasmModule(TWorkerLoadCommand(aCommand));
     cmdload : LoadWasmModule(TWorkerLoadCommand(aCommand));
     cmdRun : RunWasmModule(TWorkerRunCommand(aCommand));
     cmdRun : RunWasmModule(TWorkerRunCommand(aCommand));
     cmdCancel : CancelWasmModule(TWorkerCancelCommand(aCommand));
     cmdCancel : CancelWasmModule(TWorkerCancelCommand(aCommand));
-    cmdThreadIdRange : SetThreadRange(TWorkerThreadIDRangeCommand(aCommand));
   end;
   end;
 end;
 end;