paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-05 07:48:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix threading, in accordance with new specs

Browse Source
This commit is contained in:
Michael Van Canneyt 2024-11-04 16:11:02 +01:00
parent 8ea570af56
commit 9f2392d4fd
7 changed files with 67 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
demo/wasienv/threads/demothreads.lpi
View File

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

10
demo/wasienv/threads/demothreads.lpr
View File

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

9
demo/wasienv/threads/threadapp.lpi
View File

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

13
demo/wasienv/threads/threadapp.lpr
View File

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

47
packages/wasi/src/rtl.webthreads.pas
View File

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

75
packages/wasi/src/wasithreadedapp.pas
View File

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

25
packages/wasi/src/wasiworkerthreadhost.pas
View File

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