Browse Source

* Fix threading, in accordance with new specs

Michael Van Canneyt 9 months ago
parent
commit
9f2392d4fd

+ 5 - 16
demo/wasienv/threads/demothreads.lpi

@@ -4,6 +4,7 @@
     <Version Value="12"/>
     <General>
       <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
@@ -14,10 +15,11 @@
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
-    <CustomData Count="3">
+    <CustomData Count="4">
       <Item0 Name="MaintainHTML" Value="1"/>
       <Item1 Name="Pas2JSProject" Value="1"/>
-      <Item2 Name="PasJSWebBrowserProject" Value="1"/>
+      <Item2 Name="PasJSLocation" Value="demowasithreads"/>
+      <Item3 Name="PasJSWebBrowserProject" Value="1"/>
     </CustomData>
     <BuildModes>
       <Item Name="Default" Default="True"/>
@@ -42,19 +44,6 @@
           <Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
         </CustomData>
       </Unit>
-      <Unit>
-        <Filename Value="../../../packages/rtl/rtl.webthreads.pas"/>
-        <IsPartOfProject Value="True"/>
-        <UnitName Value="Rtl.WebThreads"/>
-      </Unit>
-      <Unit>
-        <Filename Value="../../../packages/wasi/wasiworkerthreadhost.pas"/>
-        <IsPartOfProject Value="True"/>
-      </Unit>
-      <Unit>
-        <Filename Value="../../../packages/wasi/wasithreadedapp.pas"/>
-        <IsPartOfProject Value="True"/>
-      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -69,8 +58,8 @@
     <Parsing>
       <SyntaxOptions>
         <AllowLabel Value="False"/>
-        <CPPInline Value="False"/>
         <UseAnsiStrings Value="False"/>
+        <CPPInline Value="False"/>
       </SyntaxOptions>
     </Parsing>
     <CodeGeneration>

+ 8 - 2
demo/wasienv/threads/demothreads.lpr

@@ -28,10 +28,16 @@ begin
 end;
 
 function TMyApplication.DoStartClick(aEvent: TJSMouseEvent): boolean;
+
+type
+  TProcedure = procedure;
+
 begin
   Result:=false;
-  Writeln('Host: Starting program');
-  Host.Exported.start;
+  Writeln('Host: initializing lib');
+  Host.Exported.initialize;
+  Writeln('Host: running thread');
+  TProcedure(Host.Exported['runthread'])();
 end;
 
 procedure TMyApplication.DoBeforeWasmInstantiate(Sender: TObject);

+ 7 - 2
demo/wasienv/threads/threadapp.lpi

@@ -4,6 +4,7 @@
     <Version Value="12"/>
     <General>
       <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
@@ -33,7 +34,7 @@
   <CompilerOptions>
     <Version Value="11"/>
     <Target>
-      <Filename Value="threadapp"/>
+      <Filename Value="threadapp.wasm" ApplyConventions="False"/>
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
@@ -42,15 +43,19 @@
     <CodeGeneration>
       <TargetCPU Value="wasm32"/>
       <TargetOS Value="wasi"/>
+      <Subtarget Value="browser-threaded"/>
     </CodeGeneration>
     <Linking>
       <Debugging>
         <UseLineInfoUnit Value="False"/>
       </Debugging>
+      <Options>
+        <ExecutableType Value="Library"/>
+      </Options>
     </Linking>
     <Other>
       <CustomOptions Value="-CTwasmthreads"/>
-      <CompilerPath Value="/usr/lib/fpc/3.3.1/ppcrosswasm32"/>
+      <CompilerPath Value="ppcrosswasm32"/>
     </Other>
   </CompilerOptions>
   <Debugging>

+ 10 - 3
demo/wasienv/threads/threadapp.lpr

@@ -1,4 +1,4 @@
-program threadapp;
+library threadlib;
 {$mode objfpc}
 {$h+}
 {$i-}
@@ -38,13 +38,20 @@ begin
   DebugWriteln('Fibonacci(10) = '+IntToStr(Fibonacci(10)));
 end;
 
+procedure runthread;
+
 begin
   DebugWriteln('Starting thread');
   With TCalcThread.Create(False) do
     begin
     DebugWriteln('Thread created');
-    WaitFor;
-    DebugWriteln('thread ended');
+//    While true do
+//      DebugWriteln('Waiting for thread');
+//    DebugWriteln('thread ended');
     end;
+end;
+
+exports runthread;
+    
 end.
 

+ 15 - 32
packages/wasi/src/rtl.webthreads.pas

@@ -53,12 +53,10 @@ Const
   DefaultMaxWorkerCount = 100;
 
   // Default exported thread entry point. Must have signature TThreadEntryPointFunction
-  DefaultThreadEntryPoint = 'FPC_WASM_THREAD_ENTRY';
-  // Default exported thread instance point. Must have signature TThreadInitInstanceFunction
-  DefaultThreadInstanceInitPoint = 'FPC_WASM_THREAD_INIT';
+  DefaultThreadEntryPoint = 'wasi_thread_start';
 
   // Imports to wasi env.
-  sThreadSpawn = 'thread_spawn';
+  sThreadSpawn = 'thread-spawn';
   sThreadDetach = 'thread_detach';
   sThreadCancel = 'thread_cancel';
   sThreadSelf = 'thread_self';
@@ -67,8 +65,7 @@ Const
 
 Type
   // aRunProc and aArgs are pointers inside wasm.
-  TThreadEntryPointFunction = Function(ThreadId: Integer; aRunProc : Integer; aArgs: Integer) : Integer;
-  TThreadInitInstanceFunction = Function(IsWorkerThread : Longint; IsMainThread : Integer; CanBlock : Integer) : Integer;
+  TThreadEntryPointFunction = Function(ThreadId: Integer; aArgs: Integer) : Integer;
 
   EWasmThreads = class(Exception);
 
@@ -187,17 +184,14 @@ Type
   // Worker cannot start new thread. It allocates the ID (threadId)
   // It sends RunFunction, Attributes and Arguments received by thread_spawn call.
   TWorkerSpawnThreadCommand = class external name 'Object' (TWorkerCommand)
-    Attributes : Integer;
     Arguments : Integer;
-    RunFunction : Integer;
-    ThreadInfo : integer;
   end;
 
   { TWorkerSpawnThreadCommandHelper }
 
   TWorkerSpawnThreadCommandHelper = class helper for TWorkerSpawnThreadCommand
     Class function CommandName : string; static;
-    Class function Create(aThreadID : integer; aAttrs,aArgs,aRun,aThreadInfo : Integer): TWorkerSpawnThreadCommand; static;reintroduce;
+    class function Create(aThreadID: integer; aArgs: Integer): TWorkerSpawnThreadCommand; static; reintroduce;
   end;
 
 
@@ -222,7 +216,6 @@ Type
   TWorkerRunCommand = class external name 'Object' (TWorkerCommand)
   public
     ThreadInfo : Integer;
-    RunThreadProc : Integer;
     Attrs : Integer;
     Args : Integer;
   end;
@@ -231,7 +224,7 @@ Type
 
   TWorkerRunCommandHelper = class helper for TWorkerRunCommand
     Class function CommandName : string; static;
-    Class function Create(aThreadID, aRunProc, aAttrs, aArgs, aThreadInfoLocation : integer): TWorkerRunCommand; static; reintroduce;
+    Class function Create(aThreadID, aArgs : Longint): TWorkerRunCommand; static; reintroduce;
   end;
 
 
@@ -250,12 +243,9 @@ Type
 
 
   TThreadinfo = record
-    OriginThreadID : Integer; // Numerical thread ID
-    ThreadID : Integer; // Numerical thread ID
-    ThreadInfoLocation : Integer; // Location of thread block (pointer)
-    RunFunction : Integer; // Location of thread function (pointer)
-    Attributes : Integer;  // Unused for the moment
-    Arguments : Integer;  // Arguments (pointer)
+    OriginThreadID : longint; // Numerical thread ID
+    ThreadID : longint; // Numerical thread ID
+    Arguments : longint;  // Arguments (pointer)
   end;
 
   // This basis object has the thread support that is needed by the WASM module.
@@ -263,14 +253,15 @@ Type
 
   { TWasmThreadSupport }
 
+  TWasmPointer = Longint;
   TWasmThreadSupport = Class (TImportExtension)
   private
     FOnSendCommand: TCommandNotifyEvent;
   Protected
     // Proposed WASI standard, modeled after POSIX pthreads.
-    Function thread_spawn(thread_id : Integer; attrs: Integer; thread_start_func : Integer; args : Integer) : Integer;  virtual; abstract;
-    Function thread_detach(thread_id : Integer) : Integer; virtual; abstract;
-    Function thread_cancel(thread_id : Integer) : Integer; virtual; abstract;
+    function thread_spawn(start_arg : longint) : longint; virtual; abstract;
+    Function thread_detach(thread_id : longint) : Integer; virtual; abstract;
+    Function thread_cancel(thread_id : longint) : Integer; virtual; abstract;
     Function thread_self() : Integer; virtual; abstract;
   Public
     Function ImportName : String; override;
@@ -291,14 +282,10 @@ begin
   Result:=cmdRun;
 end;
 
-class function TWorkerRunCommandHelper.Create(aThreadID, aRunProc, aAttrs,
-  aArgs, aThreadInfoLocation: integer): TWorkerRunCommand;
+class function TWorkerRunCommandHelper.Create(aThreadID, aArgs: integer): TWorkerRunCommand;
 begin
   Result:=TWorkerRunCommand(TWorkerCommand.NewWorker(CommandName));
   Result.ThreadID:=aThreadID;
-  Result.ThreadInfo:=aThreadInfoLocation;
-  Result.RunThreadProc:=aRunProc;
-  Result.Attrs:=aAttrs;
   Result.Args:=aArgs;
 end;
 
@@ -326,14 +313,10 @@ begin
   Result:=cmdSpawn
 end;
 
-class function TWorkerSpawnThreadCommandHelper.Create(aThreadID: integer;
-  aAttrs, aArgs, aRun, aThreadInfo: Integer): TWorkerSpawnThreadCommand;
+class function TWorkerSpawnThreadCommandHelper.Create(aThreadID: integer; aArgs : Integer): TWorkerSpawnThreadCommand;
 begin
   Result:=TWorkerSpawnThreadCommand(TWorkerCommand.NewWorker(CommandName,aThreadID));
   Result.Arguments:=aArgs;
-  Result.Attributes:=aAttrs;
-  Result.RunFunction:=aRun;
-  Result.ThreadInfo:=aThreadInfo;
 end;
 
 { TWorkerThreadIDRangeCommandHelper }
@@ -463,7 +446,7 @@ end;
 
 function TWasmThreadSupport.ImportName: String;
 begin
-  Result:='FPCThreading';
+  Result:='wasi';
 end;
 
 procedure TWasmThreadSupport.FillImportObject(aObject: TJSObject);

+ 12 - 63
packages/wasi/src/wasithreadedapp.pas

@@ -29,13 +29,11 @@ Type
     function GetThreadID: Integer;
     function GetThreadIDRange: Integer;
     function GetThreadInfo: TThreadinfo;
-    function GetThreadLocation: Integer;
     procedure SetLoaded(AValue: Boolean);
     procedure SetLoadSent(AValue: Boolean);
     procedure SetThreadID(AValue: Integer);
     procedure SetThreadIDRange(AValue: Integer);
     procedure SetThreadInfo(AValue: TThreadinfo);
-    procedure SetThreadLocation(AValue: Integer);
   Public
     Class function Create(aScript : String) : TWasmThread; reintroduce; static;
     Procedure SendCommand(aCommand : TWorkerCommand);
@@ -44,7 +42,6 @@ Type
     Property ThreadInfo : TThreadinfo Read GetThreadInfo Write SetThreadInfo;
     Property ThreadID : Integer Read GetThreadID Write SetThreadID;
     Property ThreadIDRange : Integer Read GetThreadIDRange Write SetThreadIDRange;
-    Property ThreadLocation : Integer Read GetThreadLocation Write SetThreadLocation;
   end;
 
 
@@ -73,9 +70,9 @@ Type
     FNextThreadID : Integer;
     procedure SetWasiHost(AValue: TWASIHost);
   Protected
-    Function thread_spawn(thread_id : Integer; attrs: Integer; thread_start_func : Integer; args : Integer) : Integer;  override;
-    Function thread_detach(thread_id : Integer) : Integer; override;
-    Function thread_cancel(thread_id : Integer) : Integer; override;
+    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
@@ -144,19 +141,12 @@ Type
 
   ThreadAppWASIHost = class(TWASIHost)
   private
-    FThreadInitInstanceEntry: String;
     FThreadSupport: TMainThreadSupport;
-
     procedure SetThreadSupport(AValue: TMainThreadSupport);
   Protected
-    Procedure PrepareWebAssemblyInstance(aDescr: TWebAssemblyStartDescriptor); override;
     Procedure DoAfterInstantiate; override;
   Public
-     constructor Create(aOwner: TComponent); override;
-
     Property ThreadSupport : TMainThreadSupport Read FThreadSupport Write SetThreadSupport;
-    // Thread instance Init point name for the WASI Host.
-    Property ThreadInitInstanceEntry : String Read FThreadInitInstanceEntry Write FThreadInitInstanceEntry;
   end;
 
 
@@ -174,25 +164,6 @@ begin
   FThreadSupport.Host:=Self;
 end;
 
-procedure ThreadAppWASIHost.PrepareWebAssemblyInstance(
-  aDescr: TWebAssemblyStartDescriptor);
-Var
-  func : JSValue;
-  InitFunc : TThreadInitInstanceFunction absolute func;
-  Res : Integer;
-
-begin
-  inherited;
-  Writeln('PrepareWebAssemblyInstance: check init thread');
-  func:=aDescr.Exported[ThreadInitInstanceEntry];
-  if Assigned(func) then
-    begin
-    Writeln('Initializing main thread instance');
-    res:=InitFunc(0,1,0);
-    if Res<>0 then
-      Writeln('Failed to initialize thread');
-    end;
-end;
 
 procedure ThreadAppWASIHost.DoAfterInstantiate;
 begin
@@ -201,12 +172,6 @@ begin
     FThreadSupport.SendLoadCommands;
 end;
 
-constructor ThreadAppWASIHost.Create(aOwner: TComponent);
-begin
-  inherited Create(aOwner);
-  ThreadInitInstanceEntry:=DefaultThreadInstanceInitPoint;
-end;
-
 
 { TBrowserWASIThreadedHostApplication }
 
@@ -299,11 +264,6 @@ begin
     Result:=Default(TThreadInfo);
 end;
 
-function TWasmThreadHelper.GetThreadLocation: Integer;
-begin
-  Result:=ThreadInfo.ThreadInfoLocation;
-end;
-
 procedure TWasmThreadHelper.SetLoaded(AValue: Boolean);
 begin
   Properties['FLoaded']:=aValue
@@ -331,11 +291,6 @@ begin
   Properties['FThreadInfo']:=aValue
 end;
 
-procedure TWasmThreadHelper.SetThreadLocation(AValue: Integer);
-begin
-  ThreadInfo.ThreadInfoLocation:=aValue
-end;
-
 
 procedure TWasmThreadHelper.SendCommand(aCommand: TWorkerCommand);
 begin
@@ -425,7 +380,7 @@ Var
 
 begin
   With aThreadWorker.ThreadInfo do
-    WRC:=TWorkerRunCommand.Create(ThreadID,RunFunction,Attributes,Arguments,ThreadInfoLocation);
+    WRC:=TWorkerRunCommand.Create(ThreadID,Arguments);
   aThreadWorker.SendCommand(Wrc);
 end;
 
@@ -441,37 +396,32 @@ begin
     SendLoadCommands;
 end;
 
-function TMainThreadSupport.thread_spawn(thread_id: Integer; attrs: Integer;
-  thread_start_func: Integer; args: Integer): Integer;
+function TMainThreadSupport.thread_spawn(start_arg : longint) : longint;
 
 var
   aInfo : TThreadInfo;
 
 begin
-  // Writeln('In host thread_spawn');
+  Writeln('In host thread_spawn');
   aInfo.ThreadID:=AllocateThreadID;
-  aInfo.RunFunction:=thread_start_func;
-  aInfo.Arguments:=Args;
-  aInfo.Attributes:=Attrs;
+  aInfo.Arguments:=start_arg;
   aInfo.OriginThreadID:=0;
-  aInfo.ThreadInfoLocation:=thread_id;
-  Env.SetMemInfoInt32(thread_id,aInfo.ThreadID);
   Result:=SpawnThread(aInfo);
 end;
 
 function TMainThreadSupport.thread_detach(thread_id: Integer): Integer;
 begin
-  Result:=0;
+  Result:=-1;
 end;
 
 function TMainThreadSupport.thread_cancel(thread_id: Integer): Integer;
 begin
-  Result:=0;
+  Result:=-1;
 end;
 
 function TMainThreadSupport.thread_self: Integer;
 begin
-  Result:=0;
+  Result:=-1;
 end;
 
 function TMainThreadSupport.AllocateThreadID: Integer;
@@ -512,7 +462,8 @@ begin
     // Writeln('Worker is loaded. Sending run command to worker');
     SendRunCommand(WT);
     end;
-  // Writeln('Exit: TMainThreadSupport.SpawnThread for ID ',WT.ThreadID);
+  Result:=aInfo.ThreadID
+ // Writeln('Exit: TMainThreadSupport.SpawnThread for ID ',WT.ThreadID);
 end;
 
 
@@ -544,10 +495,8 @@ Var
 
 begin
   aInfo.OriginThreadID:=aWorker.ThreadID;
-  aInfo.RunFunction:=aCommand.RunFunction;
   aInfo.ThreadID:=aCommand.ThreadID;
   aInfo.Arguments:=aCommand.Arguments;
-  aInfo.Attributes:=aCommand.Attributes;
   SpawnThread(aInfo);
 end;
 

+ 10 - 15
packages/wasi/src/wasiworkerthreadhost.pas

@@ -35,8 +35,6 @@ Type
     constructor Create(aOwner: TComponent); override;
     // Thread entry point name for the WASI Host.
     Property ThreadEntryPoint : String Read FThreadEntryPoint Write FThreadEntryPoint;
-    // Thread instance Init point name for the WASI Host.
-    Property ThreadInitInstanceEntry : String Read FThreadInitInstanceEntry Write FThreadInitInstanceEntry;
     // Send output to main window
     Property SendOutputToBrowserWindow : Boolean Read FSendOutputToBrowserWindow Write FSendOutputToBrowserWindow;
     // our thread
@@ -75,7 +73,7 @@ Type
     procedure SendException(aError: Exception); overload;
     procedure SendException(aError: TJSError); overload;
   Protected
-    Function thread_spawn(thread_id : Integer; attrs: Integer; thread_start_func : Integer; args : Integer) : Integer;  override;
+    function thread_spawn(start_arg : longint) : longint; override;
     Function thread_detach(thread_id : Integer) : Integer; override;
     Function thread_cancel(thread_id : Integer) : Integer; override;
     Function thread_self() : Integer; override;
@@ -233,11 +231,12 @@ procedure TWASIThreadHost.PrepareWebAssemblyThread( aDescr: TWebAssemblyStartDes
 
 Var
   func : JSValue;
-  InitFunc : TThreadInitInstanceFunction absolute func;
+//  InitFunc : TThreadInitInstanceFunction absolute func;
   res : Integer;
 
 begin
   PrepareWebAssemblyInstance(aDescr);
+  (*
   func:=aDescr.Exported[ThreadInitInstanceEntry];
   if Assigned(func) then
     begin
@@ -248,6 +247,7 @@ begin
       else
         Writeln('Could not init assembly thread: ',Res);
     end;
+  *)
 end;
 
 procedure TWASIThreadHost.DoStdWrite(Sender: TObject; const aOutput: String);
@@ -261,23 +261,21 @@ constructor TWASIThreadHost.Create(aOwner: TComponent);
 begin
   inherited Create(aOwner);
   FThreadEntryPoint:=DefaultThreadEntryPoint;
-  FThreadInitInstanceEntry:=DefaultThreadInstanceInitPoint;
   FSendOutputToBrowserWindow:=True;
 end;
 
 { TWorkerThreadSupport }
 
-function TWorkerThreadSupport.thread_spawn(thread_id: Integer; attrs: Integer;
-  thread_start_func: Integer; args: Integer): Integer;
+function TWorkerThreadSupport.thread_spawn(start_arg: longint): longint;
 
 Var
   P : TWorkerSpawnThreadCommand;
-
+  lThreadID : Integer;
 begin
-  P:=TWorkerSpawnThreadCommand.Create(AllocateNewThreadID,Attrs,Args,thread_start_func,Thread_id);
+  lThreadID:=AllocateNewThreadID;
+  P:=TWorkerSpawnThreadCommand.Create(lThreadID,start_arg);
   SendCommand(P);
-  Env.SetMemInfoInt32(thread_id,P.ThreadID);
-  Result:=0;
+  Result:=lThreadID;
 end;
 
 function TWorkerThreadSupport.thread_detach(thread_id: Integer): Integer;
@@ -383,7 +381,7 @@ procedure TWorkerThreadSupport.RunWasmModule(aCommand : TWorkerRunCommand);
   begin
     try
       // Writeln('About to run webassembly entry point (',Host.ThreadEntryPoint,') for thread ID ',aCommand.ThreadID);
-      aResult:=TThreadEntryPointFunction(aExports[Host.ThreadEntryPoint])(aCommand.ThreadInfo,aCommand.RunThreadProc, aCommand.args);
+      aResult:=TThreadEntryPointFunction(aExports[Host.ThreadEntryPoint])(aCommand.ThreadID,aCommand.args);
       if aResult>0 then
         Writeln('Thread run function result ',aResult);
     except
@@ -402,9 +400,6 @@ begin
   // initialize current thread info
   FCurrentThreadInfo.ThreadID:=aCommand.ThreadID;
   FCurrentThreadInfo.Arguments:=aCommand.Args;
-  FCurrentThreadInfo.ThreadInfoLocation:=aCommand.ThreadInfo;
-  FCurrentThreadInfo.Attributes:=aCommand.Attrs;
-  FCurrentThreadInfo.RunFunction:=aCommand.RunThreadProc;
   Host.RunWebAssemblyThread(@DoRun);
 end;