* WebAssembly thread support

demo/wasienv/threads/demothreads.lpi

@@ -0,0 +1,103 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <Runnable Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="WASI Threads Demo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <CustomData Count="3">
+      <Item0 Name="MaintainHTML" Value="1"/>
+      <Item1 Name="Pas2JSProject" Value="1"/>
+      <Item2 Name="PasJSWebBrowserProject" Value="1"/>
+    </CustomData>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="demothreads.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="demowasithreads"/>
+      </Unit>
+      <Unit>
+        <Filename Value="index.html"/>
+        <IsPartOfProject Value="True"/>
+        <CustomData Count="1">
+          <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>
+    <Version Value="11"/>
+    <Target FileExt=".js">
+      <Filename Value="demothreads"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="js"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <TargetOS Value="browser"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+        <UseLineInfoUnit Value="False"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
+      <CompilerPath Value="$(pas2js)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

demo/wasienv/threads/demothreads.lpr

@@ -0,0 +1,73 @@
+program demowasithreads;
+
+{$mode objfpc}
+
+uses
+  browserconsole, browserapp, JS, Classes, SysUtils, Web, WebAssembly, types,
+  wasienv, Rtl.WebThreads, wasihostapp, wasithreadedapp ;
+
+Type
+
+  { TMyApplication }
+
+  TMyApplication = class(TBrowserWASIThreadedHostApplication)
+  Private
+    BtnStart : TJSHTMLButtonElement;
+    procedure DoBeforeWasmInstantiate(Sender: TObject);
+    function DoStartClick(aEvent: TJSMouseEvent): boolean;
+    procedure DoWasmLoaded(Sender: TObject);
+    procedure DoWrite(Sender: TObject; aOutput: String);
+  Public
+    procedure doRun; override;
+  end;
+
+procedure TMyApplication.DoWrite(Sender: TObject; aOutput: String);
+
+begin
+  Writeln('Wasm: '+aOutput);
+end;
+
+function TMyApplication.DoStartClick(aEvent: TJSMouseEvent): boolean;
+begin
+  Result:=false;
+  Writeln('Host: Starting program');
+  Host.Exported.start;
+end;
+
+procedure TMyApplication.DoBeforeWasmInstantiate(Sender: TObject);
+begin
+  Writeln('Host: Webassembly downloaded, instantiating VM');
+end;
+
+procedure TMyApplication.DoWasmLoaded(Sender: TObject);
+begin
+  Writeln('Host: wasm loaded, ready to run');
+  BtnStart.Disabled:=False;
+end;
+
+procedure TMyApplication.doRun;
+
+begin
+  // Your code here
+  Terminate;
+  btnStart:=TJSHTMLButtonElement(GetHTMLElement('btnStart'));
+  btnStart.onclick:=@DoStartClick;
+  BtnStart.Disabled:=True;
+  Host.MemoryDescriptor.initial:=256;
+  Host.MemoryDescriptor.maximum:=512;
+  Host.OnConsoleWrite:=@DoWrite;
+  Host.AfterInstantation:=@DoWasmLoaded;
+  Host.BeforeInstantation:=@DoBeforeWasmInstantiate;
+  Writeln('Host: Loading wasm...');
+  StartWebAssembly('threadapp.wasm',False);
+end;
+
+var
+  Application : TMyApplication;
+
+begin
+  MaxConsoleLines:=250;
+  Application:=TMyApplication.Create(nil);
+  Application.Initialize;
+  Application.Run;
+end.

demo/wasienv/threads/index.html

@@ -0,0 +1,53 @@
+
+<!doctype html>
+<html lang="en">
+<head>
+  <meta http-equiv="Content-type" content="text/html; charset=utf-8">
+  <meta name="viewport" content="width=device-width, initial-scale=1">
+  <title>FPC-Webassembly and Pas2JS Demo</title>
+  <link href="bulma.min.css" rel="stylesheet">
+  <!-- <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/[email protected]/css/bulma.min.css"> -->
+  <script src="demothreads.js"></script>
+  <style>
+
+  .source {
+    /* width: 730px; */
+    margin: -45px auto;
+    font-size: 0.9em;
+  }
+
+  .source-inner {
+    display: flex;
+    justify-content: space-between;
+    align-items: center;
+    /* width: 482px; */
+  }
+  </style>
+</head>
+<body>
+
+  <div class="section pb-4">
+    <h1 class="title is-4">FPC compiled Browser Host/Webassembly programs console output:</h1>
+    <div class="box" id="pasjsconsole"></div>
+  </div>
+  <div class="section pb-4">
+    <button id="btnStart" class="button is-primary" disabled>Start program</button>
+  </div>
+  <!-- <hr> -->
+  <div class="section">
+    <div class="source">
+      <div class="source-inner">
+        <div>
+          <p>Created using &nbsp; <a target="_blank" href="https://wiki.freepascal.org/pas2js">pas2js.</a> </p>
+          <p>Pas2JS Sources: &nbsp; <a target="new" href="demothreads.lpr">Pas2JS Program</a></p>
+          <p>Webassembly Sources: &nbsp; <a target="new" href="threadedapp.pp">FPC Program</a></p>
+        </div>
+      </div>
+    </div>
+  </div>
+  <script>
+    rtl.showUncaughtExceptions=true;
+    rtl.run();
+  </script>
+</body>
+</html>

demo/wasienv/threads/threadapp.lpi

@@ -0,0 +1,68 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="WASM Thread demo application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="threadapp.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="threadapp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <TargetCPU Value="wasm32"/>
+      <TargetOS Value="wasi"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <UseLineInfoUnit Value="False"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-CTwasmthreads"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

demo/wasienv/threads/threadapp.lpr

@@ -0,0 +1,50 @@
+program threadapp;
+{$mode objfpc}
+{$h+}
+{$i-}
+
+uses SysUtils, Classes;
+
+Function Fibonacci(N : Integer) : Int64;
+
+Var
+  Next,Last : Int64;
+  I : Integer;
+
+begin
+  if N=0 then
+    exit(0);
+  Result:=1;
+  Last:=0;
+  for I:=1 to N-1 do
+    begin
+    Next:=Result+last;
+    Last:=Result;
+    Result:=Next;
+    end;
+end;
+
+Type
+  { TCalcThread }
+  TCalcThread = Class(TThread)
+    Procedure Execute; override;
+  end;
+
+{ TCalcThread }
+
+procedure TCalcThread.Execute;
+begin
+  FreeOnTerminate:=True;
+  DebugWriteln('Fibonacci(10) = '+IntToStr(Fibonacci(10)));
+end;
+
+begin
+  DebugWriteln('Starting thread');
+  With TCalcThread.Create(False) do
+    begin
+    DebugWriteln('Thread created');
+    WaitFor;
+    DebugWriteln('thread ended');
+    end;
+end.
+

demo/wasienv/threads/wasmthreads.pp

@@ -0,0 +1,927 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2022 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    wasm threading support implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+{$DEFINE DEBUG_MT}
+
+unit wasmthreads;
+
+interface
+
+Procedure SetWasmThreadManager;
+
+implementation
+
+Uses
+  WebAssembly, wasiapi;
+
+{*****************************************************************************
+                             System unit import
+*****************************************************************************}
+
+procedure fpc_threaderror; [external name 'FPC_THREADERROR'];
+
+Type
+  TTimeLockResult = (tlrOK,tlrTimeout,tlrError);
+
+  TFPWasmMutex = record
+    _lock : Longint;
+    _owner : Pointer;
+    function TryLock : Boolean;
+    function Lock : Boolean;
+    function TimedLock(aTimeOut : Longint) : TTimeLockResult;
+    function Unlock : Boolean;
+  end;
+
+  TFPWasmEvent = record
+    _mutex : TFPWasmMutex;
+    _isset : Boolean;
+  end;
+
+  PFPWasmThread = ^TFPWasmThread;
+  TFPWasmThread = record
+    ThreadID : Integer;
+    Next : PFPWasmThread;
+    Previous : PFPWasmThread;
+  end;
+
+Var
+  MainThread : TFPWasmThread;
+  threadvarblocksize : dword = 0;
+  TLSInitialized : Integer = 0;
+
+{$IFDEF DEBUG_MT}
+Type
+  TSmallString = string[100];
+
+
+Procedure SetTLSMemory(aValue : Pointer);
+
+begin
+  fpc_wasm32_init_tls(aValue);
+end;
+
+Function GetTLSMemory : Pointer;
+
+begin
+  Result:=fpc_wasm32_tls_base;
+end;
+
+
+Procedure RawWrite(var S : TSmallString);
+
+begin
+  // ToDo
+end;
+{$ENDIF DEBUG_MT}
+
+procedure WasmInitThreadvar(var offset : dword;size : dword);
+
+begin
+  threadvarblocksize:=align(threadvarblocksize, fpc_wasm32_tls_align);
+  offset:=threadvarblocksize;
+  inc(threadvarblocksize,size);
+end;
+
+
+
+procedure WasmAllocateThreadVars;
+
+var
+  tlsMemBlock : pointer;
+  tlsBlockSize : Integer;
+
+begin
+  tlsBlockSize:=fpc_wasm32_tls_size;
+  if threadvarblocksize<>tlsBlocksize then
+    Writeln('Warning : block sizes differ: ',tlsBlocksize,'<>',threadvarblocksize,'(calculated) !');
+//  DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
+  FillChar(DataIndex^,threadvarblocksize,0);
+//  pthread_setspecific(tlskey,dataindex);
+end;
+
+procedure WasmThreadCleanup(p: pointer); cdecl;
+
+{$ifdef DEBUG_MT}
+var
+  s: TSmallString; // not an ansistring
+{$endif DEBUG_MT}
+
+begin
+{$ifdef DEBUG_MT}
+  s := 'finishing externally started thread'#10;
+  RawWrite(s);
+{$endif DEBUG_MT}
+  { Restore tlskey value as it may already have been set to null,
+    in which case
+      a) DoneThread can't release the memory
+      b) accesses to threadvars from DoneThread or anything it
+         calls would allocate new threadvar memory
+  }
+  { clean up }
+  DoneThread;
+pthread_setspecific(CleanupKey,nil);
+end;
+
+
+
+
+procedure HookThread;
+{ Set up externally created thread }
+begin
+  WasmAllocateThreadVars;
+  InitThread(1000000000);
+  pthread_setspecific(CleanupKey,getTlsMemory);
+end;
+
+
+
+function WasmRelocateThreadvar(offset : dword) : pointer;
+
+var
+  P : Pointer;
+
+begin
+  P:=GetTLSMemory;
+  if (P=Nil) then
+    begin
+    HookThread;
+    P:=GetTLSMemory;
+    end;
+  WasmRelocateThreadvar:=P+Offset;
+end;
+
+
+procedure WasmReleaseThreadVars;
+begin
+  Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
+end;
+
+
+function WasmThreadMain(param : pointer) : pointer;
+
+var
+{$ifdef DEBUG_MT}
+  s: TSmallString; // not an ansistring
+{$endif DEBUG_MT}
+
+begin
+{$ifdef DEBUG_MT}
+  s := 'New thread started, initing threadvars'#10;
+  RawWrite(s);
+{$endif DEBUG_MT}
+  { Must be first, many system unit things depend on threadvars}
+  WasmAllocateThreadVars;
+  { Copy parameter to local data }
+{$ifdef DEBUG_MT}
+  s := 'New thread started, initialising ...'#10;
+  RawWrite(s);
+{$endif DEBUG_MT}
+  ti:=pthreadinfo(param)^;
+
+  { Initialize thread }
+  InitThread(ti.stklen);
+
+  dispose(pthreadinfo(param));
+  { Start thread function }
+{$ifdef DEBUG_MT}
+  writeln('Jumping to thread function');
+{$endif DEBUG_MT}
+  WasmThreadMain:=pointer(ti.f(ti.p));
+  DoneThread;
+  pthread_exit(WasmThreadMain);
+end;
+
+
+
+Procedure InitWasmTLS;
+
+begin
+  if (InterLockedExchange(longint(TLSInitialized),1) = 0) then
+    begin
+      { We're still running in single thread mode, setup the TLS }
+      pthread_key_create(@TLSKey,nil);
+      InitThreadVars(@WasmRelocateThreadvar);
+      { used to clean up threads that we did not create ourselves:
+         a) the default value for a key (and hence also this one) in
+            new threads is NULL, and if it's still like that when the
+            thread terminates, nothing will happen
+         b) if it's non-NULL, the destructor routine will be called
+            when the thread terminates
+       -> we will set it to 1 if the threadvar relocation routine is
+          called from a thread we did not create, so that we can
+          clean up everything at the end }
+      pthread_key_create(@CleanupKey,@WasmthreadCleanup);
+    end
+end;
+
+function WasmBeginThread(sa : Pointer;stacksize : PtrUInt;
+                   ThreadFunction : tthreadfunc;p : pointer;
+                   creationFlags : dword; var ThreadId : TThreadId) : TThreadID;
+var
+  ti : pthreadinfo;
+  thread_attr : pthread_attr_t;
+{$ifdef DEBUG_MT}
+  S : TSmallString;
+{$endif DEBUG_MT}
+begin
+{$ifdef DEBUG_MT}
+  S:='Creating new thread';
+  RawWrite(S);
+{$endif DEBUG_MT}
+  { Initialize multithreading if not done }
+  if not TLSInitialized then
+    InitWasmTLS;
+  if not IsMultiThread then
+    begin
+      { We're still running in single thread mode, lazy initialize thread support }
+       LazyInitThreading;
+       IsMultiThread:=true;
+    end;
+
+  { the only way to pass data to the newly created thread
+    in a MT safe way, is to use the heap }
+  new(ti);
+  ti^.f:=ThreadFunction;
+  ti^.p:=p;
+  ti^.stklen:=stacksize;
+  { call pthread_create }
+{$ifdef DEBUG_MT}
+  S:='Starting new thread';
+  RawWrite(S);
+{$endif DEBUG_MT}
+  pthread_attr_init(@thread_attr);
+  {$if not defined(HAIKU)and not defined(BEOS) and not defined(ANDROID)}
+  {$if defined (solaris) or defined (netbsd) }
+  pthread_attr_setinheritsched(@thread_attr, PTHREAD_INHERIT_SCHED);
+  {$else not solaris}
+  pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
+  {$endif not solaris}
+  {$ifend}
+
+  // will fail under linux -- apparently unimplemented
+  pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
+
+  // don't create detached, we need to be able to join (waitfor) on
+  // the newly created thread!
+  //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
+
+  // set the stack size
+  if (pthread_attr_setstacksize(@thread_attr, stacksize)<>0) or
+     // and create the thread
+     (pthread_create(ppthread_t(@threadid), @thread_attr, @ThreadMain,ti) <> 0) then
+
+    begin
+      dispose(ti);
+      threadid := TThreadID(0);
+    end;
+  CBeginThread:=threadid;
+  pthread_attr_destroy(@thread_attr);
+{$ifdef DEBUG_MT}
+  Str(ptrint(CBeginThread),S);
+  S:= 'BeginThread returning '+S;
+  RawWrite(S);
+{$endif DEBUG_MT}
+end;
+
+
+procedure WasmEndThread(ExitCode : DWord);
+
+begin
+  DoneThread;
+  pthread_detach(pthread_t(pthread_self()));
+  pthread_exit(pointer(ptrint(ExitCode)));
+end;
+
+
+
+function  WasmSuspendThread (threadHandle : TThreadID) : dword;
+// Not supported
+begin
+  result:=dword(-1);
+end;
+
+
+function  WasmResumeThread  (threadHandle : TThreadID) : dword;
+// Not supported
+begin
+  result:=dword(-1);
+end;
+
+
+
+procedure WasmThreadSwitch;  {give time to other threads}
+
+begin
+  // Not supported
+end;
+
+
+function  WasmKillThread (threadHandle : TThreadID) : dword;
+begin
+  pthread_detach(pthread_t(threadHandle));
+  WasmKillThread := pthread_cancel(pthread_t(threadHandle));
+end;
+
+function WasmCloseThread (threadHandle : TThreadID) : dword;
+
+begin
+  result:=0;
+end;
+
+function  WasmWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword;  {0=no timeout}
+
+var
+  LResultP: Pointer;
+
+begin
+  pthread_join(pthread_t(threadHandle), @LResultP);
+  WasmWaitForThreadTerminate := dword(LResultP);
+end;
+
+function  WasmThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
+begin
+  result:=false;
+end;
+
+function  WasmThreadGetPriority (threadHandle : TThreadID): Integer;
+begin
+  result:=0;
+end;
+
+
+  function  CGetCurrentThreadId : TThreadID;
+    begin
+      CGetCurrentThreadId := TThreadID (pthread_self());
+    end;
+
+
+  procedure CSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString);
+{$if defined(Linux) or defined(Android)}
+    var
+      CuttedName: AnsiString;
+{$endif}
+    begin
+{$if defined(Linux) or defined(Android)}
+      if ThreadName = '' then
+        Exit;
+  {$ifdef dynpthreads}
+      if Assigned(pthread_setname_np) then
+  {$endif dynpthreads}
+      begin
+        // length restricted to 16 characters including terminating null byte
+        CuttedName:=Copy(ThreadName, 1, 15);
+        if threadHandle=TThreadID(-1) then
+        begin
+          pthread_setname_np(pthread_self(), @CuttedName[1]);
+        end
+        else
+        begin
+          pthread_setname_np(pthread_t(threadHandle), @CuttedName[1]);
+        end;
+      end;
+{$elseif defined(Darwin) or defined(iphonesim)}
+  {$ifdef dynpthreads}
+      if Assigned(pthread_setname_np) then
+  {$endif dynpthreads}
+      begin
+        // only allowed to set from within the thread
+        if threadHandle=TThreadID(-1) then
+          pthread_setname_np(@ThreadName[1]);
+      end;
+{$else}
+       {$Warning SetThreadDebugName needs to be implemented}
+{$endif}
+    end;
+
+
+  procedure CSetThreadDebugNameU(threadHandle: TThreadID; const ThreadName: UnicodeString);
+    begin
+{$if defined(Linux) or defined(Android)}
+  {$ifdef dynpthreads}
+      if Assigned(pthread_setname_np) then
+  {$endif dynpthreads}
+      begin
+        CSetThreadDebugNameA(threadHandle, AnsiString(ThreadName));
+      end;
+{$elseif defined(Darwin) or defined(iphonesim)}
+  {$ifdef dynpthreads}
+      if Assigned(pthread_setname_np) then
+  {$endif dynpthreads}
+      begin
+        CSetThreadDebugNameA(threadHandle, AnsiString(ThreadName));
+      end;
+{$else}
+       {$Warning SetThreadDebugName needs to be implemented}
+{$endif}
+    end;
+
+
+{*****************************************************************************
+                          Delphi/Win32 compatibility
+*****************************************************************************}
+
+    procedure CInitCriticalSection(var CS);
+
+    var
+      MAttr : pthread_mutexattr_t;
+      res: longint;
+    begin
+      res:=pthread_mutexattr_init(@MAttr);
+      if res=0 then
+        begin
+          res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+          if res=0 then
+            res := pthread_mutex_init(@CS,@MAttr)
+          else
+            { No recursive mutex support :/ }
+            fpc_threaderror
+        end
+      else
+        res:= pthread_mutex_init(@CS,NIL);
+      pthread_mutexattr_destroy(@MAttr);
+      if res <> 0 then
+        fpc_threaderror;
+    end;
+
+    procedure CEnterCriticalSection(var CS);
+      begin
+         if pthread_mutex_lock(@CS) <> 0 then
+           fpc_threaderror
+      end;
+
+    function CTryEnterCriticalSection(var CS):longint;
+      begin
+         if pthread_mutex_Trylock(@CS)=0 then
+           result:=1  // succes
+         else
+           result:=0; // failure
+      end;
+
+    procedure CLeaveCriticalSection(var CS);
+      begin
+         if pthread_mutex_unlock(@CS) <> 0 then
+           fpc_threaderror
+      end;
+
+    procedure CDoneCriticalSection(var CS);
+      begin
+         { unlock as long as unlocking works to unlock it if it is recursive
+           some Delphi code might call this function with a locked mutex      }
+         while pthread_mutex_unlock(@CS)=0 do
+           ;
+
+         if pthread_mutex_destroy(@CS) <> 0 then
+           fpc_threaderror;
+      end;
+
+
+{*****************************************************************************
+                           Semaphore routines
+*****************************************************************************}
+
+
+type
+     TPthreadCondition = pthread_cond_t;
+     TPthreadMutex = pthread_mutex_t;
+     Tbasiceventstate=record
+         FCondVar: TPthreadCondition;
+{$if defined(Linux) and not defined(Android)}         
+         FAttr: pthread_condattr_t;
+         FClockID: longint;
+{$ifend}        
+         FEventSection: TPthreadMutex;
+         FWaiters: longint;
+         FIsSet,
+         FManualReset,
+         FDestroying : Boolean;
+        end;
+     plocaleventstate = ^tbasiceventstate;
+//     peventstate=pointer;
+
+Const
+        wrSignaled = 0;
+        wrTimeout  = 1;
+        wrAbandoned= 2;
+        wrError    = 3;
+
+function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+var
+  MAttr : pthread_mutexattr_t;
+  res   : cint;  
+{$if defined(Linux) and not defined(Android)}  
+  timespec: ttimespec;
+{$ifend}  
+begin
+  new(plocaleventstate(result));
+  plocaleventstate(result)^.FManualReset:=AManualReset;
+  plocaleventstate(result)^.FWaiters:=0;
+  plocaleventstate(result)^.FDestroying:=False;
+  plocaleventstate(result)^.FIsSet:=InitialState;
+{$if defined(Linux) and not defined(Android)}  
+  res := pthread_condattr_init(@plocaleventstate(result)^.FAttr);
+  if (res <> 0) then
+  begin
+    FreeMem(result);
+    fpc_threaderror;  
+  end;
+  
+  if clock_gettime(CLOCK_MONOTONIC_RAW, @timespec) = 0 then
+  begin
+    res := pthread_condattr_setclock(@plocaleventstate(result)^.FAttr, CLOCK_MONOTONIC_RAW);
+  end
+  else
+  begin
+    res := -1; // No support for CLOCK_MONOTONIC_RAW   
+  end;
+  
+  if (res = 0) then
+  begin
+    plocaleventstate(result)^.FClockID := CLOCK_MONOTONIC_RAW;
+  end
+  else
+  begin
+    res := pthread_condattr_setclock(@plocaleventstate(result)^.FAttr, CLOCK_MONOTONIC);
+    if (res = 0) then
+    begin
+      plocaleventstate(result)^.FClockID := CLOCK_MONOTONIC;
+    end
+    else
+    begin
+      pthread_condattr_destroy(@plocaleventstate(result)^.FAttr);
+      FreeMem(result);
+      fpc_threaderror;  
+    end;    
+  end;  
+
+  res := pthread_cond_init(@plocaleventstate(result)^.FCondVar, @plocaleventstate(result)^.FAttr);
+  if (res <> 0) then
+  begin
+    pthread_condattr_destroy(@plocaleventstate(result)^.FAttr);  
+    FreeMem(result);
+    fpc_threaderror;
+  end;
+{$else}
+  res := pthread_cond_init(@plocaleventstate(result)^.FCondVar, nil);
+  if (res <> 0) then
+  begin
+    FreeMem(result);
+    fpc_threaderror;
+  end; 
+{$ifend} 
+
+  res:=pthread_mutexattr_init(@MAttr);
+  if res=0 then
+    begin
+      res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+      if Res=0 then
+        Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr)
+      else
+        res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+    end
+  else
+    res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+
+  pthread_mutexattr_destroy(@MAttr);
+  if res <> 0 then
+    begin
+      pthread_cond_destroy(@plocaleventstate(result)^.FCondVar);
+{$if defined(Linux) and not defined(Android)}  
+      pthread_condattr_destroy(@plocaleventstate(result)^.FAttr);	
+{$ifend}      
+      FreeMem(result);
+      fpc_threaderror;
+    end;
+end;
+
+procedure Intbasiceventdestroy(state:peventstate);
+begin
+  { safely mark that we are destroying this event }
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  plocaleventstate(state)^.FDestroying:=true;
+
+  { send a signal to all threads that are waiting }
+  pthread_cond_broadcast(@plocaleventstate(state)^.FCondVar);
+  pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+
+  { now wait until they've finished their business }
+  while (plocaleventstate(state)^.FWaiters <> 0) do
+    cThreadSwitch;
+
+  { and clean up }
+  pthread_cond_destroy(@plocaleventstate(state)^.Fcondvar);
+{$if defined(Linux) and not defined(Android)}  
+  pthread_condattr_destroy(@plocaleventstate(state)^.FAttr);	
+{$ifend}  
+  pthread_mutex_destroy(@plocaleventstate(state)^.FEventSection);
+  dispose(plocaleventstate(state));
+end;
+
+
+procedure IntbasiceventResetEvent(state:peventstate);
+begin
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  plocaleventstate(state)^.fisset:=false;
+  pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+end;
+
+procedure IntbasiceventSetEvent(state:peventstate);
+begin
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  plocaleventstate(state)^.Fisset:=true;
+  if not(plocaleventstate(state)^.FManualReset) then
+    pthread_cond_signal(@plocaleventstate(state)^.Fcondvar)
+  else
+    pthread_cond_broadcast(@plocaleventstate(state)^.Fcondvar);
+  pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+end;
+
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+var
+  timespec: ttimespec;
+  errres: cint;
+  isset: boolean;
+  tnow : timeval;
+begin
+
+  { safely check whether we are being destroyed, if so immediately return. }
+  { otherwise (under the same mutex) increase the number of waiters        }
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  if (plocaleventstate(state)^.FDestroying) then
+    begin
+      pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+      result := wrAbandoned;
+      exit;
+    end;
+  { not a regular inc() because it may happen simulatneously with the }
+  { interlockeddecrement() at the end                                 }
+  interlockedincrement(plocaleventstate(state)^.FWaiters);
+
+  //Wait without timeout using pthread_cond_wait
+  if Timeout = $FFFFFFFF then
+    begin
+      while (not plocaleventstate(state)^.FIsSet) and (not plocaleventstate(state)^.FDestroying) do
+        pthread_cond_wait(@plocaleventstate(state)^.Fcondvar, @plocaleventstate(state)^.feventsection);
+    end
+  else
+    begin
+      //Wait with timeout using pthread_cond_timedwait
+{$if defined(Linux) and not defined(Android)}
+      if clock_gettime(plocaleventstate(state)^.FClockID, @timespec) <> 0 then
+      begin
+        Result := Ord(wrError);
+        Exit;
+      end;
+      timespec.tv_sec  := timespec.tv_sec + (clong(timeout) div 1000);
+      timespec.tv_nsec := ((clong(timeout) mod 1000) * 1000000) + (timespec.tv_nsec);
+{$else}
+      // TODO: FIX-ME: Also use monotonic clock for other *nix targets
+      fpgettimeofday(@tnow, nil);
+      timespec.tv_sec  := tnow.tv_sec + (clong(timeout) div 1000);
+      timespec.tv_nsec := ((clong(timeout) mod 1000) * 1000000) + (tnow.tv_usec * 1000);
+{$ifend}
+      if timespec.tv_nsec >= 1000000000 then
+        begin
+          inc(timespec.tv_sec);
+          dec(timespec.tv_nsec, 1000000000);
+        end;
+      errres := 0;
+      while (not plocaleventstate(state)^.FDestroying) and
+            (not plocaleventstate(state)^.FIsSet) and 
+            (errres<>ESysETIMEDOUT) do
+        errres := pthread_cond_timedwait(@plocaleventstate(state)^.Fcondvar,
+                                         @plocaleventstate(state)^.feventsection, 
+                                         @timespec);
+    end;
+
+  isset := plocaleventstate(state)^.FIsSet;
+
+  { if ManualReset=false, reset the event immediately. }
+  if (plocaleventstate(state)^.FManualReset=false) then
+    plocaleventstate(state)^.FIsSet := false;
+
+  //check the results...
+  if plocaleventstate(state)^.FDestroying then
+    Result := wrAbandoned
+  else
+    if IsSet then
+      Result := wrSignaled
+    else
+      begin
+        if errres=ESysETIMEDOUT then
+          Result := wrTimeout
+        else
+          Result := wrError;
+      end;
+
+  pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+
+  { don't put this above the previous pthread_mutex_unlock, because    }
+  { otherwise we can get errors in case an object is destroyed between }
+  { end of the wait/sleep loop and the signalling above.               }
+  { The pthread_mutex_unlock above takes care of the memory barrier    }
+  interlockeddecrement(plocaleventstate(state)^.FWaiters);
+end;
+
+function intRTLEventCreate: PRTLEvent;
+
+var p:pintrtlevent;
+
+begin
+  new(p);
+  if not assigned(p) then
+    fpc_threaderror;
+  if pthread_cond_init(@p^.condvar, nil)<>0 then
+    begin
+      dispose(p);
+      fpc_threaderror;
+    end;
+  if pthread_mutex_init(@p^.mutex, nil)<>0 then
+    begin
+      pthread_cond_destroy(@p^.condvar);
+      dispose(p);
+      fpc_threaderror;
+    end;
+  p^.isset:=false;
+  result:=PRTLEVENT(p);
+end;
+
+procedure intRTLEventDestroy(AEvent: PRTLEvent);
+
+var p:pintrtlevent;
+
+begin
+  p:=pintrtlevent(aevent);
+  pthread_cond_destroy(@p^.condvar);
+  pthread_mutex_destroy(@p^.mutex);
+  dispose(p);
+end;
+
+procedure intRTLEventSetEvent(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+  p:=pintrtlevent(aevent);
+  pthread_mutex_lock(@p^.mutex);
+  p^.isset:=true;
+  pthread_cond_signal(@p^.condvar);
+  pthread_mutex_unlock(@p^.mutex);
+end;
+
+
+procedure intRTLEventResetEvent(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+  p:=pintrtlevent(aevent);
+  pthread_mutex_lock(@p^.mutex);
+  p^.isset:=false;
+  pthread_mutex_unlock(@p^.mutex);
+end;
+
+
+procedure intRTLEventWaitFor(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+  p:=pintrtlevent(aevent);
+  pthread_mutex_lock(@p^.mutex);
+  while not p^.isset do pthread_cond_wait(@p^.condvar, @p^.mutex);
+  p^.isset:=false;
+  pthread_mutex_unlock(@p^.mutex);
+end;
+
+procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
+  var
+    p : pintrtlevent;
+    errres : cint;
+    timespec : ttimespec;
+    tnow : timeval;
+
+  begin
+    p:=pintrtlevent(aevent);
+    fpgettimeofday(@tnow,nil);
+    timespec.tv_sec:=tnow.tv_sec+(timeout div 1000);
+    timespec.tv_nsec:=(timeout mod 1000)*1000000 + tnow.tv_usec*1000;
+    if timespec.tv_nsec >= 1000000000 then
+    begin
+      inc(timespec.tv_sec);
+      dec(timespec.tv_nsec, 1000000000);
+    end;
+    errres:=0;
+    pthread_mutex_lock(@p^.mutex);
+    while (not p^.isset) and
+          (errres <> ESysETIMEDOUT) do
+      begin
+        errres:=pthread_cond_timedwait(@p^.condvar, @p^.mutex, @timespec);
+      end;
+    p^.isset:=false;
+    pthread_mutex_unlock(@p^.mutex);
+  end;
+
+
+type
+  threadmethod = procedure of object;
+
+
+Function CInitThreads : Boolean;
+
+begin
+{$ifdef DEBUG_MT}
+  Writeln('Entering InitThreads.');
+{$endif}
+{$ifndef dynpthreads}
+  Result:=True;
+{$else}
+  Result:=LoadPthreads;
+{$endif}
+  ThreadID := TThreadID (pthread_self());
+{$ifdef DEBUG_MT}
+  Writeln('InitThreads : ',Result);
+{$endif DEBUG_MT}
+  // We assume that if you set the thread manager, the application is multithreading.
+  InitCTLS;
+end;
+
+Function CDoneThreads : Boolean;
+
+begin
+{$ifndef dynpthreads}
+  Result:=True;
+{$else}
+  Result:=UnloadPthreads;
+{$endif}
+end;
+
+
+Var
+  CThreadManager : TThreadManager;
+
+Procedure SetCThreadManager;
+
+begin
+  With CThreadManager do begin
+    InitManager            :=@WasmInitThreads;
+    DoneManager            :=@WasmDoneThreads;
+    BeginThread            :=@WasmBeginThread;
+    EndThread              :=@WasmEndThread;
+    SuspendThread          :=@WasmSuspendThread;
+    ResumeThread           :=@WasmResumeThread;
+    KillThread             :=@WasmKillThread;
+    ThreadSwitch           :=@WasmThreadSwitch;
+    CloseThread	           :=@WasmCloseThread;
+    WaitForThreadTerminate :=@WasmWaitForThreadTerminate;
+    ThreadSetPriority      :=@WasmThreadSetPriority;
+    ThreadGetPriority      :=@WasmThreadGetPriority;
+    GetCurrentThreadId     :=@WasmGetCurrentThreadId;
+    SetThreadDebugNameA    :=@WasmSetThreadDebugNameA;
+    SetThreadDebugNameU    :=@WasmSetThreadDebugNameU;
+    InitCriticalSection    :=@WasmInitCriticalSection;
+    DoneCriticalSection    :=@WasmDoneCriticalSection;
+    EnterCriticalSection   :=@WasmEnterCriticalSection;
+    TryEnterCriticalSection:=@WasmTryEnterCriticalSection;
+    LeaveCriticalSection   :=@WasmLeaveCriticalSection;
+    InitThreadVar          :=@WasmInitThreadVar;
+    RelocateThreadVar      :=@WasmRelocateThreadVar;
+    AllocateThreadVars     :=@WasmAllocateThreadVars;
+    ReleaseThreadVars      :=@WasmReleaseThreadVars;
+    BasicEventCreate       :=@intBasicEventCreate;
+    BasicEventDestroy      :=@intBasicEventDestroy;
+    BasicEventResetEvent   :=@intBasicEventResetEvent;
+    BasicEventSetEvent     :=@intBasicEventSetEvent;
+    BasiceventWaitFor      :=@intBasiceventWaitFor;
+    rtlEventCreate         :=@intrtlEventCreate;
+    rtlEventDestroy        :=@intrtlEventDestroy;
+    rtlEventSetEvent       :=@intrtlEventSetEvent;
+    rtlEventResetEvent     :=@intrtlEventResetEvent;
+    rtleventWaitForTimeout :=@intrtleventWaitForTimeout;
+    rtleventWaitFor        :=@intrtleventWaitFor;
+  end;
+  SetThreadManager(CThreadManager);
+end;
+
+
+initialization
+  if ThreadingAlreadyUsed then
+    begin
+      writeln('Threading has been used before cthreads was initialized.');
+      writeln('Make wasmthreads one of the first units in your uses clause.');
+      runerror(211);
+    end;
+  SetWasmThreadManager;
+finalization
+end.

packages/rtl/rtl.webthreads.pas

@@ -0,0 +1,477 @@
+unit Rtl.WebThreads;
+
+{$mode ObjFPC}
+{$modeswitch externalclass}
+
+interface
+
+uses
+  JS, SysUtils, wasienv, webassembly;
+
+Const
+  // Each thread starts spawning at 1000*IndexOfWorker
+  ThreadIDInterval = 1000;
+  // When the thread ID reaches this limit, then it requests a new block
+  ThreadIDMargin = 2;
+
+  // lowercase !!
+  cmdConsole = 'console';
+  cmdException = 'exception';
+  cmdCleanup = 'cleanup';
+  cmdCancel = 'cancel';
+  cmdLoaded = 'loaded';
+  cmdKill = 'kill';
+  cmdNeedIdBlock = 'needidblock';
+  cmdThreadIdRange = 'threadidrange';
+  cmdSpawn = 'spawn';
+  cmdLoad = 'load';
+  cmdRun = 'run';
+
+  DefaultThreadWorker = 'pas2jsthreadworker.js';
+  DefaultThreadCount = 2;
+  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';
+
+  // Imports to wasi env.
+  sThreadSpawn = 'thread_spawn';
+  sThreadDetach = 'thread_detach';
+  sThreadCancel = 'thread_cancel';
+  sThreadSelf = 'thread_self';
+
+
+
+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;
+
+  EWasmThreads = class(Exception);
+
+  // Commands sent between thread workers and main program.
+
+  { Basic TWorkerCommand. Command is the actual command }
+
+  { we do not use Pascal classes for this, to avoid transferring unnecessary metadata present in the pascal class }
+
+  TWorkerCommand = Class external name 'Object' (TJSObject)
+    Command : String;
+    ThreadID : Integer; // Meaning depends on actual command.
+    TargetID : Integer; // Forward to thread ID
+  end;
+  TCommandNotifyEvent = Procedure (Sender : TObject; aCommand : TWorkerCommand) of object;
+
+  { TWorkerCommandHelper }
+
+  TWorkerCommandHelper = class helper for TWorkerCommand
+    Class function NewWorker(const aCommand : string; aThreadID : Integer = -1) : TWorkerCommand; static;
+  end;
+
+  { TWorkerExceptionCommand }
+
+  // When an unexpected error occurred.
+  TWorkerExceptionCommand = class external name 'Object' (TWorkerCommand)
+  public
+    ExceptionClass: String;
+    ExceptionMessage: String;
+  end;
+
+  { TWorkerExceptionCommandHelper }
+
+  TWorkerExceptionCommandHelper = class helper for TWorkerExceptionCommand
+    Class function CommandName : string; static;
+    Class function CreateNew(const aExceptionClass,aExceptionMessage : string; aThreadID : Integer = -1) : TWorkerExceptionCommand; static;
+  end;
+
+  { TWorkerConsoleCommand }
+
+  // Sent by worker to main: write message to console
+  // Thread ID : sending console ID
+  TWorkerConsoleCommand = class external name 'Object' (TWorkerCommand)
+  public
+    ConsoleMessage : String;
+  end;
+
+  { TWorkerConsoleCommandHelper }
+
+  TWorkerConsoleCommandHelper = class helper for TWorkerConsoleCommand
+    Class function CommandName : string; static;
+    Class function Create(const aMessage : string; aThreadID : Integer = -1) : TWorkerConsoleCommand; static; reintroduce;
+    Class function Create(const aMessage : array of JSValue; aThreadID : Integer = -1) : TWorkerConsoleCommand; static; reintroduce;
+  end;
+
+  // Cleanup thread info: put this worker into unusued workers
+  TWorkerCleanupCommand = class external name 'Object' (TWorkerCommand)
+  end;
+
+  { TWorkerCleanupCommandHelper }
+
+  TWorkerCleanupCommandHelper = class helper for TWorkerCleanupCommand
+    Class function CommandName : string; static;
+    Class function Create(aThreadID : Integer): TWorkerCleanupCommand; static;  reintroduce;
+  end;
+
+
+  { TWorkerKillCommand }
+  // Kill thread (thread ID in ThreadID)
+  TWorkerKillCommand = class external name 'Object' (TWorkerCommand)
+  end;
+
+  { TWorkerCleanupCommandHelper }
+
+  TWorkerKillCommandHelper = class helper for TWorkerKillCommand
+    Class function CommandName : string; static;
+    Class function Create(aThreadID : Integer): TWorkerKillCommand; static;reintroduce;
+  end;
+
+  // Cancel thread (thread ID in ThreadID)
+  TWorkerCancelCommand = class external name 'Object' (TWorkerCommand)
+  end;
+
+  { TWorkerCancelCommandHelper }
+
+  TWorkerCancelCommandHelper = class helper for TWorkerCancelCommand
+    Class function CommandName : string; static;
+    Class function Create(aThreadID : Integer): TWorkerCancelCommand; static; reintroduce;
+  end;
+
+  // sent to notify main thread that the wasm module is loaded.
+  TWorkerLoadedCommand = class external name 'Object' (TWorkerCommand)
+  end;
+
+  { TWorkerLoadedCommandHelper }
+
+  TWorkerLoadedCommandHelper = class helper for TWorkerLoadedCommand
+    Class function CommandName : string; static;
+    Class function Create: TWorkerLoadedCommand; static; reintroduce;
+  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.
+  // 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;
+  end;
+
+
+
+  // Sent by main to worker: load wasm module
+  TWorkerLoadCommand = class external name 'Object' (TWorkerCommand)
+  public
+    Memory : TJSWebAssemblyMemory;
+    Module : TJSWebAssemblyModule;
+    ThreadRangeStart : NativeInt;
+  end;
+
+  { TWorkerLoadCommandHelper }
+
+  TWorkerLoadCommandHelper = class helper for TWorkerLoadCommand
+    Class function CommandName : string; static;
+    Class function Create(aStartThreadIdRange : integer; aModule : TJSWebAssemblyModule; aMemory : TJSWebAssemblyMemory): TWorkerLoadCommand; static;reintroduce;
+  end;
+
+
+  // Sent by main to worker: run thread procedure
+  TWorkerRunCommand = class external name 'Object' (TWorkerCommand)
+  public
+    ThreadInfo : Integer;
+    RunThreadProc : Integer;
+    Attrs : Integer;
+    Args : Integer;
+  end;
+
+  { TWorkerRunCommandHelper }
+
+  TWorkerRunCommandHelper = class helper for TWorkerRunCommand
+    Class function CommandName : string; static;
+    Class function Create(aThreadID, aRunProc, aAttrs, aArgs, aThreadInfoLocation : integer): TWorkerRunCommand; static; reintroduce;
+  end;
+
+
+  // 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
+    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)
+  end;
+
+  // This basis object has the thread support that is needed by the WASM module.
+  // It relies on descendents to implement the actual calls.
+
+  { TWasmThreadSupport }
+
+  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_self() : Integer; virtual; abstract;
+  Public
+    Function ImportName : String; override;
+    procedure FillImportObject(aObject: TJSObject); override;
+    Procedure HandleCommand(aCommand : TWorkerCommand); virtual;
+    Procedure SendCommand(aCommand : TWorkerCommand); virtual;
+    // Set this to actually send commands. Normally set by TWorkerWASIHostApplication
+    Property OnSendCommand : TCommandNotifyEvent Read FOnSendCommand Write FOnSendCommand;
+  end;
+
+
+implementation
+
+{ TWorkerRunCommandHelper }
+
+class function TWorkerRunCommandHelper.CommandName: string;
+begin
+  Result:=cmdRun;
+end;
+
+class function TWorkerRunCommandHelper.Create(aThreadID, aRunProc, aAttrs,
+  aArgs, aThreadInfoLocation: integer): TWorkerRunCommand;
+begin
+  Result:=TWorkerRunCommand(TWorkerCommand.NewWorker(CommandName));
+  Result.ThreadID:=aThreadID;
+  Result.ThreadInfo:=aThreadInfoLocation;
+  Result.RunThreadProc:=aRunProc;
+  Result.Attrs:=aAttrs;
+  Result.Args:=aArgs;
+end;
+
+{ TWorkerLoadCommandHelper }
+
+class function TWorkerLoadCommandHelper.CommandName: string;
+begin
+  Result:=cmdLoad;
+end;
+
+class function TWorkerLoadCommandHelper.Create(aStartThreadIdRange: integer;
+  aModule: TJSWebAssemblyModule; aMemory: TJSWebAssemblyMemory
+  ): TWorkerLoadCommand;
+begin
+  Result:=TWorkerLoadCommand(TWorkerCommand.NewWorker(CommandName));
+  Result.ThreadRangeStart:=aStartThreadIdRange;
+  Result.Memory:=aMemory;
+  Result.Module:=aModule;
+end;
+
+{ TWorkerSpawnThreadCommandHelper }
+
+class function TWorkerSpawnThreadCommandHelper.CommandName: string;
+begin
+  Result:=cmdSpawn
+end;
+
+class function TWorkerSpawnThreadCommandHelper.Create(aThreadID: integer;
+  aAttrs, aArgs, aRun, aThreadInfo: Integer): TWorkerSpawnThreadCommand;
+begin
+  Result:=TWorkerSpawnThreadCommand(TWorkerCommand.NewWorker(CommandName,aThreadID));
+  Result.Arguments:=aArgs;
+  Result.Attributes:=aAttrs;
+  Result.RunFunction:=aRun;
+  Result.ThreadInfo:=aThreadInfo;
+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 }
+
+class function TWorkerLoadedCommandHelper.CommandName: string;
+begin
+  Result:=cmdLoaded;
+end;
+
+class function TWorkerLoadedCommandHelper.Create: TWorkerLoadedCommand;
+begin
+  Result:=TWorkerLoadedCommand(TWorkerCommand.NewWorker(CommandName));
+end;
+
+{ TWorkerCancelCommandHelper }
+
+class function TWorkerCancelCommandHelper.CommandName: string;
+begin
+  result:=cmdCancel;
+end;
+
+class function TWorkerCancelCommandHelper.Create(aThreadID: Integer
+  ): TWorkerCancelCommand;
+begin
+  Result:=TWorkerCancelCommand(TWorkerCommand.NewWorker(CommandName,aThreadID));
+end;
+
+{ TWorkerKillCommandHelper }
+
+class function TWorkerKillCommandHelper.CommandName: string;
+begin
+  Result:=cmdKill
+end;
+
+class function TWorkerKillCommandHelper.Create(aThreadID : Integer): TWorkerKillCommand;
+begin
+  Result:=TWorkerKillCommand(TWorkerCommand.NewWorker(CommandName,aThreadID));
+end;
+
+{ TWorkerCleanupCommandHelper }
+
+class function TWorkerCleanupCommandHelper.CommandName: string;
+begin
+  Result:=cmdCleanup
+end;
+
+class function TWorkerCleanupCommandHelper.Create(aThreadID: Integer): TWorkerCleanupCommand;
+begin
+  Result:=TWorkerCleanupCommand(TWorkerCommand.NewWorker(CommandName,aThreadID));
+end;
+
+{ TWorkerConsoleCommandHelper }
+
+class function TWorkerConsoleCommandHelper.CommandName: string;
+begin
+  Result:=cmdConsole;
+end;
+
+class function TWorkerConsoleCommandHelper.Create(
+  const aMessage: string; aThreadID : Integer = -1): TWorkerConsoleCommand;
+begin
+  Result:=TWorkerConsoleCommand(TWorkerCommand.NewWorker(CommandName,aThreadID));
+  Result.ConsoleMessage:=aMessage;
+end;
+
+class function TWorkerConsoleCommandHelper.Create(
+  const aMessage: array of JSValue; aThreadID : Integer = -1): TWorkerConsoleCommand;
+begin
+  Result:=Create(TJSArray(aMessage).join(' '),aThreadID);
+end;
+
+{ TWorkerExceptionCommandHelper }
+
+class function TWorkerExceptionCommandHelper.CommandName: string;
+begin
+  Result:=cmdException;
+end;
+
+class function TWorkerExceptionCommandHelper.CreateNew(const aExceptionClass,aExceptionMessage: string; aThreadID : Integer = -1  ): TWorkerExceptionCommand;
+begin
+  Result:=TWorkerExceptionCommand(TWorkerCommand.NewWorker(CommandName,aThreadID));
+  Result.ExceptionClass:=aExceptionClass;
+  Result.ExceptionMessage:=aExceptionMessage;
+end;
+
+{ TWorkerCommandHelper }
+
+class function TWorkerCommandHelper.NewWorker(const aCommand : string; aThreadID : Integer = -1): TWorkerCommand;
+begin
+  Result:=TWorkerCommand.New;
+  Result.Command:=LowerCase(aCommand);
+  if aThreadID<>-1 then
+    Result.ThreadID:=aThreadID;
+end;
+
+
+{ TWasmThreadSupport }
+
+function TWasmThreadSupport.ImportName: String;
+begin
+  Result:='FPCThreading';
+end;
+
+procedure TWasmThreadSupport.FillImportObject(aObject: TJSObject);
+begin
+  aObject[sThreadSpawn]:=@Thread_Spawn;
+  aObject[sThreadDetach]:=@Thread_Detach;
+  aObject[sThreadCancel]:=@Thread_Cancel;
+  aObject[sThreadSelf]:=@Thread_Self;
+end;
+
+
+procedure TWasmThreadSupport.HandleCommand(aCommand: TWorkerCommand);
+
+Var
+  P : TWorkerExceptionCommand;
+
+begin
+  P:=TWorkerExceptionCommand.New;
+  P.ExceptionClass:='ENotSupportedException';
+  P.ExceptionMessage:='Unsupported command : '+TJSJSON.Stringify(aCommand);
+  SendCommand(aCommand);
+end;
+
+procedure TWasmThreadSupport.SendCommand(aCommand: TWorkerCommand);
+begin
+  if Assigned(FOnSendCommand) then
+    FOnSendCommand(Self,aCommand);
+end;
+
+
+end.
+

packages/rtl/webassembly.pas

@@ -6,7 +6,7 @@ unit webassembly;
 interface
 
 uses
-  js, Weborworker;
+  js;
 
 Type
   { TJSWebAssemblyMemory }
@@ -36,7 +36,7 @@ Type
     FMemory : TJSWebAssemblyMemory; external name 'memory';
     function GetFun(aName : String): TJSFunction; external name '[]';
   public
-    Property Memory : TJSWebAssemblyMemory Read FMemory;
+    Property Memory : TJSWebAssemblyMemory Read FMemory Write fMemory;
     Property functions [aName : String] : TJSFunction read GetFun; default;
   end;
 
@@ -80,9 +80,9 @@ Type
     Class Function instantiate(Buffer : TJSWebAssemblyModule; ImportObject :  TJSObject) : TJSPromise; overload;
     Class Function instantiate(Buffer : TJSWebAssemblyModule) : TJSPromise; overload;
     Class Function compile(Buffer : TJSArrayBuffer): TJSPromise;
-    Class Function compileStreaming(source : TJSResponse): TJSPromise;
-    Class Function instantiateStreaming(source : TJSResponse; ImportObject :  TJSObject) : TJSPromise; overload;
-    Class Function instantiateStreaming(source : TJSResponse) : TJSPromise; overload;
+    Class Function compileStreaming(source : TJSObject): TJSPromise;
+    Class Function instantiateStreaming(source : TJSObject; ImportObject :  TJSObject) : TJSPromise; overload;
+    Class Function instantiateStreaming(source : TJSObject) : TJSPromise; overload;
     Class Function validate(Buffer : TJSArrayBuffer): Boolean;
   end;
 

packages/wasi/pas2jsthreadworker.lpi

@@ -0,0 +1,77 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <Runnable Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="pas2jsthreadworker"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="pas2jsthreadworker.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target FileExt=".js">
+      <Filename Value="pas2jsthreadworker"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="js"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <TargetOS Value="nodejs"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+        <UseLineInfoUnit Value="False"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Jeutf-8 -Jminclude -Jirtl.js"/>
+      <CompilerPath Value="$(pas2js)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/wasi/pas2jsthreadworker.pas

@@ -0,0 +1,22 @@
+program pas2jsthreadworker;
+
+{$mode objfpc}
+
+uses
+  Classes, WasiWorkerThreadHost;
+
+type
+  { TApplication }
+
+  TApplication = class(TWorkerWASIHostApplication)
+  end;
+
+{ TApplication }
+
+var
+  App: TApplication;
+
+begin
+  App:=TApplication.Create(nil);
+  App.Run;
+end.

packages/wasi/wasienv.pas

@@ -4,7 +4,8 @@ unit wasienv;
 {$mode ObjFPC}
 {$modeswitch externalclass}
 {$INTERFACES CORBA}
-
+{$WARN 5024 off}
+{$WARN 4501 off}
 interface
 
 uses
@@ -327,10 +328,12 @@ type
     FOnStdOutputWrite: TWASIWriteEvent;
     FImportExtensions : TFPList;
     FWASIImportName : string;
+    FMemory : TJSWebAssemblyMemory;
     function GetConsoleInputBuffer: TJSUint8Array;
     function GetFileBuffer(FD: NativeInt): TJSUint8Array;
     function GetImportObject: TJSObject;
     function getiovs(view: TJSDataView; iovs, iovsLen: NativeInt): TJSArray;
+    function GetMemory: TJSWebassemblyMemory;
     procedure SetInstance(AValue: TJSWebAssemblyInstance);
   Protected
     Class Var UTF8TextDecoder: TJSTextDecoder;
@@ -392,6 +395,8 @@ type
     function sock_recv() : NativeInt; virtual;
     function sock_send() : NativeInt; virtual;
     function sock_shutdown() : NativeInt; virtual;
+  Protected
+    Procedure SetMemory(aMemory : TJSWebAssemblyMemory);
   Public
     class constructor init;
     Constructor Create;
@@ -414,6 +419,7 @@ type
     Property OnGetConsoleInputBuffer : TGetConsoleInputBufferEvent Read FOnGetConsoleInputBuffer Write FOnGetConsoleInputBuffer;
     Property OnGetConsoleInputString : TGetConsoleInputStringEvent Read FOnGetConsoleInputString Write FOnGetConsoleInputString;
     Property Instance : TJSWebAssemblyInstance Read Finstance Write SetInstance;
+    Property Memory : TJSWebassemblyMemory Read GetMemory;
     Property Exitcode : Nativeint Read FExitCode;
     // Default is set to the one expected by FPC runtime: wasi_snapshot_preview1
     Property WASIImportName : String Read FWASIImportName Write FWASIImportName;
@@ -434,11 +440,25 @@ type
     Property Env : TPas2JSWASIEnvironment Read FEnv;
   end;
 
+  TRunWebassemblyProc = reference to Procedure(aExports : TWASIExports);
   TWebAssemblyStartDescriptor = record
+    // Module
+    Module : TJSWebAssemblyModule;
+    // memory to use
     Memory : TJSWebAssemblyMemory;
+    // Table to use
     Table : TJSWebAssemblyTable;
+    // Exports of module
     Exported : TWASIExports;
+    // Imports of module
+    Imports : TJSOBject;
+    // Instance
     Instance : TJSWebAssemblyInstance;
+    // Procedure to actually run a function.
+    CallRun : TRunWebassemblyProc;
+    // After run, if an exception occurred, this is filled with error class/message.
+    RunExceptionClass : String;
+    RunExceptionMessage : String;
   end;
 
 
@@ -448,6 +468,8 @@ type
   TBeforeStartEvent = Procedure (Sender : TObject; aDescriptor : TWebAssemblyStartDescriptor; var aAllowRun : Boolean) of object;
   TAfterStartEvent = Procedure (Sender : TObject; aDescriptor : TWebAssemblyStartDescriptor) of object;
 
+  TFailEvent =  Procedure (Sender : TObject; aFail : JSValue) of object;
+
   TConsoleReadEvent = Procedure(Sender : TObject; Var AInput : String) of object;
   TConsoleWriteEvent = Procedure (Sender : TObject; aOutput : string) of object;
 
@@ -455,10 +477,15 @@ type
 
   TWASIHost = Class(TComponent)
   Private
+    FAfterInstantation: TNotifyEvent;
     FAfterStart: TAfterStartEvent;
+    FBeforeInstantation: TNotifyEvent;
     FBeforeStart: TBeforeStartEvent;
     FEnv: TPas2JSWASIEnvironment;
     FExported: TWASIExports;
+    FOnInstantiateFail: TFailEvent;
+    FOnLoadFail: TFailEvent;
+    FPreparedStartDescriptor: TWebAssemblyStartDescriptor;
     FMemoryDescriptor : TJSWebAssemblyMemoryDescriptor;
     FOnConsoleRead: TConsoleReadEvent;
     FOnConsoleWrite: TConsoleWriteEvent;
@@ -466,21 +493,51 @@ type
     FReadLineCount : Integer;
     FRunEntryFunction: String;
     FTableDescriptor : TJSWebAssemblyTableDescriptor;
+    function GetStartDescriptorReady: Boolean;
+    function GetUseSharedMemory: Boolean;
     procedure SetPredefinedConsoleInput(AValue: TStrings);
+    procedure SetUseSharedMemory(AValue: Boolean);
   protected
+    // Called after instantiation was OK.
+    Procedure DoAfterInstantiate; virtual;
+    // Called before instantiation starts.
+    Procedure DoBeforeInstantiate; virtual;
+    // Called when loading fails
+    Procedure DoLoadFail(aError : JSValue); virtual;
+    // Called when instantiating fails
+    Procedure DoInstantiateFail(aError : JSValue); virtual;
+    // Prepare start descriptor
+    Procedure PrepareWebAssemblyInstance(aDescr: TWebAssemblyStartDescriptor); virtual;
+    // Call the run function on an instantiated webassembly
+    function RunWebAssemblyInstance(aBeforeStart: TBeforeStartCallback; aAfterStart: TAfterStartCallback; aRun : TRunWebassemblyProc): Boolean; virtual; overload;
+    // Prepare and run web assembly instance.
+    function RunWebAssemblyInstance(aDescr: TWebAssemblyStartDescriptor; aBeforeStart: TBeforeStartCallback; aAfterStart: TAfterStartCallback): Boolean; overload;
+    // Standard Input/Output reads
     procedure DoStdRead(Sender: TObject; var AInput: string); virtual;
     procedure DoStdWrite(Sender: TObject; const aOutput: String); virtual;
+    // Load file from path ans instantiate a webassembly from it.
     function CreateWebAssembly(aPath: string; aImportObject: TJSObject): TJSPromise; virtual;
+    // Create a WASI environment. Called during constructor, override to customize.
     Function CreateWasiEnvironment : TPas2JSWASIEnvironment; virtual;
+    // Create Standard webassembly table description
     function GetTable: TJSWebAssemblyTable; virtual;
+    // Create tandard webassembly memory.
     function GetMemory: TJSWebAssemblyMemory; virtual;
   public
     Constructor Create(aOwner : TComponent); override;
     Destructor Destroy; override;
+    // Will call OnConsoleWrite or write to console
+    procedure WriteOutput(const aOutput: String); virtual;
+    // Get prepared descriptor
+    Property PreparedStartDescriptor : TWebAssemblyStartDescriptor Read FPreparedStartDescriptor;
+    // Initialize a start descriptor.
+    function InitStartDescriptor(aMemory: TJSWebAssemblyMemory; aTable: TJSWebAssemblyTable; aImportObj: TJSObject): TWebAssemblyStartDescriptor;
     // Load and start webassembly. If DoRun is true, then Webassembly entry point is called.
     // If aBeforeStart is specified, then it is called prior to calling run, and can disable running.
     // If aAfterStart is specified, then it is called after calling run. It is not called if running was disabled.
-    Procedure StartWebAssembly(aPath: string; DoRun : Boolean = True;  aBeforeStart : TBeforeStartCallback = Nil; aAfterStart : TAfterStartCallback = Nil);
+    Procedure StartWebAssembly(aPath: string; DoRun: Boolean;  aBeforeStart: TBeforeStartCallback; aAfterStart: TAfterStartCallback);
+    // Run the prepared descriptor
+    Procedure RunPreparedDescriptor;
     // Initial memory descriptor
     Property MemoryDescriptor : TJSWebAssemblyMemoryDescriptor Read FMemoryDescriptor Write FMemoryDescriptor;
     // Import/export table descriptor
@@ -489,8 +546,11 @@ type
     Property WasiEnvironment : TPas2JSWASIEnvironment Read FEnv;
     // Exported functions. Also available in start descriptor.
     Property Exported : TWASIExports Read FExported;
+    // Is the descriptor prepared ?
+    Property StartDescriptorReady : Boolean Read GetStartDescriptorReady;
     // Default console input
     Property PredefinedConsoleInput : TStrings Read FPredefinedConsoleInput Write SetPredefinedConsoleInput;
+
     // Name of function to run. If empty, the FPC default _start is used.
     Property RunEntryFunction : String Read FRunEntryFunction Write FRunEntryFunction;
     // Called after webassembly start was run. Not called if webassembly was not run.
@@ -501,6 +561,17 @@ type
     property OnConsoleRead : TConsoleReadEvent Read FOnConsoleRead Write FOnConsoleRead;
     // Called when writing to console (stdout). If not set, console.log is used.
     property OnConsoleWrite : TConsoleWriteEvent Read FOnConsoleWrite Write FOnConsoleWrite;
+    // Called when fetch of the wasm module fails.
+    Property OnLoadFail : TFailEvent Read FOnLoadFail Write FOnLoadFail;
+    // Called when instantiation of the wasm module fails.
+    Property OnInstantiateFail : TFailEvent Read FOnInstantiateFail Write FOnInstantiateFail;
+    // Use Shared memory for webassembly instances ?
+    Property UseSharedMemory : Boolean Read GetUseSharedMemory Write SetUseSharedMemory;
+    // Executed after instantiation
+    Property AfterInstantation : TNotifyEvent Read FAfterInstantation Write FAfterInstantation;
+    // Executed before instantiation
+    Property BeforeInstantation : TNotifyEvent Read FBeforeInstantation Write FBeforeInstantation;
+
   end;
 
 implementation
@@ -534,30 +605,139 @@ begin
   FPredefinedConsoleInput.Assign(AValue);
 end;
 
+function TWASIHost.GetUseSharedMemory: Boolean;
+begin
+  Result:=FMemoryDescriptor.shared;
+  if isUndefined(Result) then
+    Result:=False;
+end;
+
+function TWASIHost.GetStartDescriptorReady: Boolean;
+begin
+  With FPreparedStartDescriptor do
+    Result:=Assigned(Memory) and Assigned(Module);
+end;
+
+procedure TWASIHost.SetUseSharedMemory(AValue: Boolean);
+begin
+  FMemoryDescriptor.shared:=aValue;
+end;
+
+procedure TWASIHost.DoAfterInstantiate;
+begin
+  If Assigned(FAfterInstantation) then
+    FAfterInstantation(Self);
+end;
+
+procedure TWASIHost.DoBeforeInstantiate;
+begin
+  If Assigned(FBeforeInstantation) then
+    FBeforeInstantation(Self);
+end;
+
+procedure TWASIHost.DoLoadFail(aError: JSValue);
+begin
+  If Assigned(FOnLoadFail) then
+    FOnLoadFail(Self,aError);
+end;
+
+procedure TWASIHost.DoInstantiateFail(aError: JSValue);
+begin
+  If Assigned(FOnInstantiateFail) then
+    FOnInstantiateFail(Self,aError);
+end;
+
+procedure TWASIHost.PrepareWebAssemblyInstance(
+  aDescr: TWebAssemblyStartDescriptor);
+begin
+  FPreparedStartDescriptor:=aDescr;
+  FExported:=aDescr.Exported;
+  WasiEnvironment.Instance:=aDescr.Instance;
+  WasiEnvironment.SetMemory(aDescr.Memory);
+  // We do this here, so in the event, the FPreparedStartDescriptor Is ready.
+  DoAfterInstantiate;
+end;
+
+function TWASIHost.RunWebAssemblyInstance(aBeforeStart: TBeforeStartCallback; aAfterStart: TAfterStartCallback; aRun : TRunWebassemblyProc): Boolean;
+
+begin
+  Result:=True;
+  // Writeln('Entering RunWebAssemblyInstance');
+  if Assigned(aBeforeStart) then
+    Result:=aBeforeStart(Self,FPreparedStartDescriptor);
+  if Assigned(FBeforeStart) then
+    FBeforeStart(Self,FPreparedStartDescriptor,Result);
+  if not Result then
+    exit;
+  try
+    if aRun=Nil then
+      aRun:=FPreparedStartDescriptor.CallRun;
+    aRun(FPreparedStartDescriptor.Exported);
+    if Assigned(aAfterStart) then
+      aAfterStart(Self,FPreparedStartDescriptor);
+    if Assigned(FAfterStart) then
+      FAfterStart(Self,FPreparedStartDescriptor)
+  except
+    On E : exception do
+      begin
+      FPreparedStartDescriptor.RunExceptionClass:=E.ClassName;
+      FPreparedStartDescriptor.RunExceptionMessage:=E.Message;
+      end;
+    On JE : TJSError do
+      begin
+      FPreparedStartDescriptor.RunExceptionClass:=jsTypeOf(JE);
+      FPreparedStartDescriptor.RunExceptionMessage:=JE.Message;
+      end;
+    On OE : TJSObject do
+      begin
+      FPreparedStartDescriptor.RunExceptionClass:=jsTypeOf(OE);
+      FPreparedStartDescriptor.RunExceptionMessage:=TJSJSON.Stringify(OE);
+      end;
+  end;
+end;
+
 procedure TWASIHost.DoStdWrite(Sender: TObject; const aOutput: String);
 begin
-  if assigned(FOnConsoleWrite) then
-    FOnConsoleWrite(Self,aOutput)
-  else
-    Console.log('Webassembly output: ', aOutput);
+  WriteOutput(aOutput);
 end;
 
 function TWASIHost.CreateWebAssembly(aPath: string; aImportObject: TJSObject
   ): TJSPromise;
 
+  Function InstantiateOK(Res : JSValue) : JSValue;
+
+  begin
+    Result:=res;
+  end;
+
+  Function InstantiateFail(Res : JSValue) : JSValue;
+
+  begin
+    Result:=False;
+    DoInstantiateFail(res);
+  end;
+
+
   Function ArrayOK(res2 : jsValue) : JSValue;
 
   begin
-    Result:=TJSWebAssembly.instantiate(TJSArrayBuffer(res2),aImportObject);
+    DoBeforeInstantiate;
+    Result:=TJSWebAssembly.instantiate(TJSArrayBuffer(res2),aImportObject)._then(@InstantiateOK,@InstantiateFail);
   end;
 
   function fetchOK(res : jsValue) : JSValue;
   begin
-    Result:=TJSResponse(Res).arrayBuffer._then(@ArrayOK,Nil)
+    Result:=TJSResponse(Res).arrayBuffer._then(@ArrayOK,Nil);
+  end;
+
+  function DoFail(res : jsValue) : JSValue;
+  begin
+    Result:=False;
+    DoLoadFail(res);
   end;
 
 begin
-  Result:=fetch(aPath)._then(@fetchOK);
+  Result:=fetch(aPath)._then(@fetchOK,@DoFail).Catch(@DoFail);
 end;
 
 function TWASIHost.CreateWasiEnvironment: TPas2JSWASIEnvironment;
@@ -598,39 +778,48 @@ begin
   inherited Destroy;
 end;
 
-procedure TWASIHost.StartWebAssembly(aPath: string; DoRun: Boolean;
-  aBeforeStart: TBeforeStartCallback; aAfterStart: TAfterStartCallback);
+procedure TWASIHost.WriteOutput(const aOutput: String);
+begin
+  if assigned(FOnConsoleWrite) then
+    FOnConsoleWrite(Self,aOutput)
+  else
+    Writeln(aOutput);
+end;
+
+
+function TWASIHost.RunWebAssemblyInstance(aDescr: TWebAssemblyStartDescriptor;
+  aBeforeStart: TBeforeStartCallback;
+  aAfterStart: TAfterStartCallback): Boolean;
+
+begin
+  Result:=RunWebAssemblyInstance(aBeforeStart,aAfterStart,Nil);
+end;
+
+procedure TWASIHost.StartWebAssembly(aPath: string; DoRun: Boolean; aBeforeStart: TBeforeStartCallback; aAfterStart: TAfterStartCallback);
+
 Var
-  ImportObj : TJSObject;
-  Res : TWebAssemblyStartDescriptor;
+  WASD : TWebAssemblyStartDescriptor;
 
   function InitEnv(aValue: JSValue): JSValue;
 
   Var
-    Module : TJSInstantiateResult absolute aValue;
+    InstResult : TJSInstantiateResult absolute aValue;
 
   begin
     Result:=True;
-    Res.Instance:=Module.Instance;
-    Res.Exported:=TWASIExports(TJSObject(Module.Instance.exports_));
-    // These 2 prevent running different instances simultaneously.
-    FExported:=Res.Exported;
-    WasiEnvironment.Instance:=Module.Instance;
-    if Assigned(aBeforeStart) then
-      DoRun:=aBeforeStart(Self,Res) and DoRun;
-    if Assigned(FBeforeStart) then
-      FBeforeStart(Self,Res,DoRun);
-    if DoRun then
+    WASD.Instance:=InstResult.Instance;
+    WASD.Module:=InstResult.Module;
+    WASD.Exported:=TWASIExports(TJSObject(WASD.Instance.exports_));
+    WASD.CallRun:=Procedure(aExports : TWASIExports)
       begin
       if FRunEntryFunction='' then
-        Res.Exported.Start
+        aExports.Start
       else
-        TProcedure(Res.Exported[RunEntryFunction])();
-      if Assigned(aAfterStart) then
-        aAfterStart(Self,Res);
-      if Assigned(FAfterStart) then
-        FAfterStart(Self,Res)
+        TProcedure(aExports[RunEntryFunction])();
       end;
+    PrepareWebAssemblyInstance(WASD);
+    if DoRun then
+      RunWebAssemblyInstance(aBeforeStart,aAfterStart,Nil);
   end;
 
   function DoFail(aValue: JSValue): JSValue;
@@ -643,16 +832,32 @@ Var
 
 begin
   FReadLineCount:=0;
-  Res.Memory:=GetMemory;
-  Res.Table:=GetTable;
-  ImportObj:=new([
-    'js', new([
-      'mem', Res.Memory,
-      'tbl', Res.Table
-    ])
+  // Clear current descriptor.
+  FPreparedStartDescriptor:=Default(TWebAssemblyStartDescriptor);
+  WASD:=InitStartDescriptor(GetMemory,GetTable,Nil);
+  CreateWebAssembly(aPath,WASD.Imports)._then(@initEnv,@DoFail).catch(@DoFail);
+end;
+
+procedure TWASIHost.RunPreparedDescriptor;
+begin
+  RunWebAssemblyInstance(Nil,Nil,Nil)
+end;
+
+function TWASIHost.InitStartDescriptor(aMemory: TJSWebAssemblyMemory;
+  aTable: TJSWebAssemblyTable; aImportObj: TJSObject
+  ): TWebAssemblyStartDescriptor;
+
+begin
+  Result.Memory:=aMemory;
+  Result.Table:=aTable;
+  if Not assigned(aImportObj) then
+    aImportObj:=TJSObject.New;
+  aImportObj['env']:=new([
+    'memory', Result.Memory,
+    'tbl', Result.Table
   ]);
-  FEnv.AddImports(ImportObj);
-  CreateWebAssembly(aPath,ImportObj)._then(@initEnv,@DoFail)
+  FEnv.AddImports(aImportObj);
+  Result.Imports:=aImportObj;
 end;
 
 function TImportExtension.getModuleMemoryDataView : TJSDataView;  
@@ -711,7 +916,7 @@ end;
 
 function TPas2JSWASIEnvironment.getModuleMemoryDataView: TJSDataView;
 begin
-  Result:=TJSDataView.New(FModuleInstanceExports.memory.buffer);
+  Result:=TJSDataView.New(Memory.buffer);
 end;
 
 function TPas2JSWASIEnvironment.fd_prestat_get(fd, bufPtr: NativeInt
@@ -813,6 +1018,8 @@ begin
   if Finstance=AValue then Exit;
   Finstance:=AValue;
   FModuleInstanceExports:=Finstance.exports_;
+  if Not Assigned(FMemory) and Assigned(FModuleInstanceExports.Memory) then
+    FMemory:=FModuleInstanceExports.Memory;
 end;
 
 function TPas2JSWASIEnvironment.GetTime(aClockID: NativeInt): NativeInt;
@@ -873,11 +1080,19 @@ begin
     ptr:=iovs + i * 8;
     buf:=view.getUint32(ptr, IsLittleEndian);
     bufLen:=view.getUint32(ptr + 4, IsLittleEndian);
-    ArrayBuf:=TJSUint8Array.New(FModuleInstanceExports.memory.buffer, buf, bufLen);
+    ArrayBuf:=TJSUint8Array.New(Memory.buffer, buf, bufLen);
     Result.Push(ArrayBuf);
     end;
 end;
 
+function TPas2JSWASIEnvironment.GetMemory: TJSWebassemblyMemory;
+begin
+  if Assigned(FMemory) then
+    Result:=FMemory
+  else
+    Result:= FModuleInstanceExports.Memory;
+end;
+
 function TPas2JSWASIEnvironment.fd_write(fd, iovs, iovsLen, nwritten: NativeInt): NativeInt;
 
 var
@@ -1089,6 +1304,11 @@ begin
   Result:=WASI_ENOSYS;
 end;
 
+procedure TPas2JSWASIEnvironment.SetMemory(aMemory: TJSWebAssemblyMemory);
+begin
+  FMemory:=aMemory;
+end;
+
 class constructor TPas2JSWASIEnvironment.init;
 Var
   Opts : TJSTextDecoderOptions;

packages/wasi/wasihostapp.pas

@@ -14,24 +14,27 @@ Type
   TBrowserWASIHostApplication = class(TBrowserApplication)
   private
     FHost : TWASIHost;
-    FOnConsoleRead: TConsoleReadEvent;
-    FOnConsoleWrite: TConsoleWriteEvent;
     FPredefinedConsoleInput: TStrings;
     function GetAfterStart: TAfterStartEvent;
     function GetBeforeStart: TBeforeStartEvent;
     function GetEnv: TPas2JSWASIEnvironment;
     function GetExported: TWASIExports;
     function GetMemoryDescriptor: TJSWebAssemblyMemoryDescriptor;
+    function GetOnConsoleRead: TConsoleReadEvent;
+    function GetOnConsoleWrite: TConsoleWriteEvent;
     function GetRunEntryFunction: String;
     function GetTableDescriptor: TJSWebAssemblyTableDescriptor;
     procedure SetAfterStart(AValue: TAfterStartEvent);
     procedure SetBeforeStart(AValue: TBeforeStartEvent);
     procedure SetMemoryDescriptor(AValue: TJSWebAssemblyMemoryDescriptor);
+    procedure SetOnConsoleRead(AValue: TConsoleReadEvent);
+    procedure SetOnConsoleWrite(AValue: TConsoleWriteEvent);
     procedure SetPredefinedConsoleInput(AValue: TStrings);
     procedure SetRunEntryFunction(AValue: String);
     procedure SetTableDescriptor(AValue: TJSWebAssemblyTableDescriptor);
   protected
     function CreateHost: TWASIHost; virtual;
+    Property Host : TWASIHost Read FHost;
   public
     Constructor Create(aOwner : TComponent); override;
     Destructor Destroy; override;
@@ -56,9 +59,9 @@ Type
     // Default console input
     Property PredefinedConsoleInput : TStrings Read FPredefinedConsoleInput Write SetPredefinedConsoleInput;
     // Called when reading from console (stdin). If not set, PredefinedConsoleinput is used.
-    property OnConsoleRead : TConsoleReadEvent Read FOnConsoleRead Write FOnConsoleRead;
+    property OnConsoleRead : TConsoleReadEvent Read GetOnConsoleRead Write SetOnConsoleRead;
     // Called when writing to console (stdout). If not set, console.log is used.
-    property OnConsoleWrite : TConsoleWriteEvent Read FOnConsoleWrite Write FOnConsoleWrite;
+    property OnConsoleWrite : TConsoleWriteEvent Read GetOnConsoleWrite Write SetOnConsoleWrite;
   end;
 
   // For backwards compatibility
@@ -94,6 +97,16 @@ begin
   Result:=FHost.MemoryDescriptor;
 end;
 
+function TBrowserWASIHostApplication.GetOnConsoleRead: TConsoleReadEvent;
+begin
+  Result:=FHost.OnConsoleRead;
+end;
+
+function TBrowserWASIHostApplication.GetOnConsoleWrite: TConsoleWriteEvent;
+begin
+  Result:=FHost.OnConsoleWrite;
+end;
+
 function TBrowserWASIHostApplication.GetRunEntryFunction: String;
 begin
   Result:=FHost.RunEntryFunction;
@@ -120,6 +133,18 @@ begin
   FHost.MemoryDescriptor:=aValue;
 end;
 
+procedure TBrowserWASIHostApplication.SetOnConsoleRead(AValue: TConsoleReadEvent
+  );
+begin
+  FHost.OnConsoleRead:=aValue
+end;
+
+procedure TBrowserWASIHostApplication.SetOnConsoleWrite(
+  AValue: TConsoleWriteEvent);
+begin
+  FHost.OnConsoleWrite:=aValue;
+end;
+
 procedure TBrowserWASIHostApplication.SetPredefinedConsoleInput(AValue: TStrings);
 begin
   FHost.PredefinedConsoleInput:=aValue;
@@ -139,7 +164,7 @@ end;
 function TBrowserWASIHostApplication.CreateHost : TWASIHost;
 
 begin
-  Result:=TWASIHost.Create(Nil);
+  Result:=TWASIHost.Create(Self);
 end;
 
 constructor TBrowserWASIHostApplication.Create(aOwner: TComponent);

packages/wasi/wasithreadedapp.pas

@@ -0,0 +1,613 @@
+unit wasithreadedapp;
+
+{$mode ObjFPC}
+{$modeswitch externalclass}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  JS, Classes, SysUtils, Rtl.WebThreads, wasienv, wasihostapp, weborworker;
+
+Type
+  { TWasmThread }
+  TWasmThread = TJSWorker;
+
+  { TWasmThreadHelper }
+
+  TWasmThreadHelper = Class helper for TWasmThread
+  private
+    function GetLoaded: Boolean;
+    function GetLoadSent: Boolean;
+    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);
+    Property LoadSent : Boolean Read GetLoadSent Write SetLoadSent;
+    Property Loaded : Boolean Read GetLoaded Write SetLoaded;
+    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;
+
+
+
+  TThreadHash = class external name 'Object' (TJSObject)
+  Private
+    function GetThreadData(aIndex: NativeInt): TWasmThread; external name '[]';
+    procedure SetThreadData(aIndex: NativeInt; const AValue: TWasmThread); external name '[]';
+  Public
+    Property ThreadData[aIndex : NativeInt] : TWasmThread Read GetThreadData Write SetThreadData; default;
+  end;
+
+
+  // This object has the thread support that is needed  by the 'main' program
+
+  { TMainThreadSupport }
+
+  TMainThreadSupport = class(TWasmThreadSupport)
+  private
+    FInitialWorkerCount: Integer;
+    FMaxWorkerCount: Integer;
+    FOnUnknownMessage: TJSRawEventHandler;
+    FHost: TWASIHost;
+    FWorkerScript: String;
+    FNextIDRange : Integer;
+    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_self() : Integer; override;
+    function AllocateThreadID : Integer;
+  Protected
+    FIdleWorkers : Array of TWasmThread;
+    FBusyWorkers : Array of TWasmThread;
+    FThreads : TThreadHash; // ThreadID is key,
+    // Send load commands to all workers that still need it.
+    procedure SendLoadCommands;
+    // Allocate new thread ID range
+    function GetNextThreadIDRange: Integer;
+    // 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;
+    // Send a load command
+    procedure SendLoadCommand(aThreadWorker: TWasmThread); virtual;
+    // Get new worker from pool, create new if needed.
+    Function GetNewWorker : TWasmThread;
+    // Spawn & prepare to run a new thread.
+    Function SpawnThread(aInfo : TThreadInfo) : Integer;
+    // Actually send run command.
+    Procedure SendRunCommand(aThreadWorker: TWasmThread);
+    //
+    // Handle Various commands sent from worker threads.
+    //
+    // Allocate a new worker for a thread and run the thread if the worker is loaded.
+    procedure HandleSpawnCommand(aWorker: TWasmThread; aCommand: TWorkerSpawnThreadCommand); virtual;
+    // Cancel command: stop the thread
+    procedure HandleCancelCommand(aWorker: TWasmThread; aCommand: TWorkerCancelCommand); virtual;
+    // Cleanup thread : after join (or stopped if detached), free worker.
+    procedure HandleCleanupCommand(aWorker: TWasmThread; aCommand: TWorkerCleanupCommand); virtual;
+    // forward KILL signal to thread.
+    procedure HandleKillCommand(aWorker: TWasmThread; aCommand: TWorkerKillCommand); virtual;
+    // Worker script is loaded, has loaded webassembly and is ready to run.
+    procedure HandleLoadedCommand(aWorker: TWasmThread; aCommand: TWorkerLoadedCommand); overload;
+    // Console output from worker.
+    procedure HandleConsoleCommand(aWorker: TWasmThread;  aCommand: TWorkerConsoleCommand);
+  Public
+    Constructor Create(aEnv : TPas2JSWASIEnvironment); override;
+    Constructor Create(aEnv : TPas2JSWASIEnvironment; aWorkerScript : String; aSpawnWorkerCount : integer); virtual; overload;
+    Procedure HandleCommand(aWorker : TWasmThread; aCommand : TWorkerCommand); overload; virtual;
+    Property WorkerScript : String Read FWorkerScript;
+    // Initial number of threads, set by constructor
+    Property InitialWorkerCount : Integer Read FInitialWorkerCount;
+    // 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;
+    // The WASI host, used to run routines.
+    Property Host : TWASIHost Read FHost Write SetWasiHost;
+  end;
+
+  { TBrowserWASIThreadedHostApplication }
+
+  TBrowserWASIThreadedHostApplication = class(TBrowserWASIHostApplication)
+  private
+    FThreadSupport: TMainThreadSupport;
+  protected
+    Function CreateThreadSupport(aEnv : TPas2JSWASIEnvironment) : TMainThreadSupport; virtual;
+    Function CreateHost: TWASIHost; override;
+  Public
+    Destructor Destroy; override;
+    Property ThreadSupport : TMainThreadSupport Read FThreadSupport;
+  end;
+
+  { ThreadAppWASIHost }
+
+  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;
+
+
+implementation
+
+Resourcestring
+  SErrMaxWorkersReached = 'Cannot create thread worker, Maximum number of workers (%d) reached.';
+
+{ ThreadAppWASIHost }
+
+procedure ThreadAppWASIHost.SetThreadSupport(AValue: TMainThreadSupport);
+begin
+  if FThreadSupport=AValue then Exit;
+  FThreadSupport:=AValue;
+  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
+  inherited DoAfterInstantiate;
+  If Assigned(FThreadSupport) then
+    FThreadSupport.SendLoadCommands;
+end;
+
+constructor ThreadAppWASIHost.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  ThreadInitInstanceEntry:=DefaultThreadInstanceInitPoint;
+end;
+
+
+{ TBrowserWASIThreadedHostApplication }
+
+function TBrowserWASIThreadedHostApplication.CreateThreadSupport(
+  aEnv: TPas2JSWASIEnvironment): TMainThreadSupport;
+begin
+  Result:=TMainThreadSupport.Create(aEnv);
+end;
+
+function TBrowserWASIThreadedHostApplication.CreateHost: TWASIHost;
+
+Var
+  Res : ThreadAppWASIHost;
+
+begin
+  Res:=ThreadAppWASIHost.Create(Self);
+  Res.UseSharedMemory:=True;
+  Res.ThreadSupport:=CreateThreadSupport(Res.WasiEnvironment);
+  Result:=Res;
+end;
+
+
+destructor TBrowserWASIThreadedHostApplication.Destroy;
+begin
+  FreeAndNil(FThreadSupport);
+  inherited Destroy;
+end;
+
+
+{ TWasmThread }
+
+
+class function TWasmThreadHelper.Create(aScript: String): TWasmThread;
+begin
+  Result:=TJSWorker.new(aScript);
+  Result.ThreadID:=-1;
+  Result.Loaded:=False;
+  Result.LoadSent:=False;
+  Result.ThreadIDRange:=-1;
+  Result.ThreadInfo:=Default(TThreadInfo);
+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;
+begin
+  Result:=ThreadInfo.ThreadID;
+end;
+
+function TWasmThreadHelper.GetThreadIDRange: Integer;
+Var
+  S : JSValue;
+begin
+  S:=Properties['FThreadIDRange'];
+  if isNumber(S) then
+    Result:=Integer(S)
+  else
+    Result:=0;
+end;
+
+function TWasmThreadHelper.GetThreadInfo: TThreadinfo;
+Var
+  S : JSValue;
+begin
+  S:=Properties['FThreadInfo'];
+  if isObject(S) then
+    Result:=TThreadinfo(S)
+  else
+    Result:=Default(TThreadInfo);
+end;
+
+function TWasmThreadHelper.GetThreadLocation: Integer;
+begin
+  Result:=ThreadInfo.ThreadInfoLocation;
+end;
+
+procedure TWasmThreadHelper.SetLoaded(AValue: Boolean);
+begin
+  Properties['FLoaded']:=aValue
+end;
+
+procedure TWasmThreadHelper.SetLoadSent(AValue: Boolean);
+begin
+  Properties['FLoadSent']:=aValue;
+end;
+
+
+
+procedure TWasmThreadHelper.SetThreadID(AValue: Integer);
+begin
+  ThreadInfo.ThreadID:=aValue;
+end;
+
+procedure TWasmThreadHelper.SetThreadIDRange(AValue: Integer);
+begin
+  Properties['FThreadIDRange']:=aValue
+end;
+
+procedure TWasmThreadHelper.SetThreadInfo(AValue: TThreadinfo);
+begin
+  Properties['FThreadInfo']:=aValue
+end;
+
+procedure TWasmThreadHelper.SetThreadLocation(AValue: Integer);
+begin
+  ThreadInfo.ThreadInfoLocation:=aValue
+end;
+
+
+procedure TWasmThreadHelper.SendCommand(aCommand: TWorkerCommand);
+begin
+  // Writeln('Sending command '+TJSJSON.Stringify(aCommand));
+  PostMessage(aCommand);
+end;
+
+procedure TMainThreadSupport.DoWorkerMessage(aEvent: TJSEvent);
+
+Var
+  aMessageEvent : TJSMessageEvent absolute aEvent;
+  aData : TWorkerCommand;
+  aWorker : TWasmThread;
+
+begin
+  // Writeln('Received worker message '+TJSJSON.Stringify(aMessageEvent.Data));
+  if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
+    begin
+    aData:=TWorkerCommand(aMessageEvent.Data);
+    aWorker:=TWasmThread(aMessageEvent.Target);
+    HandleCommand(aWorker,aData);
+    end
+  else if Assigned(FOnUnknownMessage) then
+    FOnUnknownMessage(aEvent)
+  else
+    Writeln('Unknown worker message : ',TJSJSON.stringify(aEvent));
+end;
+
+function TMainThreadSupport.GetNextThreadIDRange : Integer;
+
+begin
+  Inc(FNextIDRange,ThreadIDInterval);
+  Result:=FNextIDRange;
+end;
+
+function TMainThreadSupport.AllocateNewWorker(const aWorkerScript: string): TWasmThread;
+
+begin
+  // Writeln('Allocating new worker for: '+aWorkerScript);
+  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);
+end;
+
+procedure TMainThreadSupport.SendLoadCommand(aThreadWorker: TWasmThread);
+
+Var
+  WLC: TWorkerLoadCommand;
+
+begin
+  WLC:=TWorkerLoadCommand.Create(aThreadWorker.ThreadIDRange, Host.PreparedStartDescriptor.Module, Host.PreparedStartDescriptor.Memory);
+  aThreadWorker.SendCommand(WLC);
+  aThreadWorker.LoadSent:=True;
+end;
+
+function TMainThreadSupport.GetNewWorker: TWasmThread;
+
+Var
+  WT : TWasmThread;
+
+begin
+  if Length(FIdleWorkers)=0 then
+    begin
+    // Writeln('No idle workers, creating new one');
+    if Length(FBusyWorkers)<MaxWorkerCount then
+      WT:=AllocateNewWorker(FWorkerScript)
+    else
+      Raise EWasmThreads.Create(SErrMaxWorkersReached);
+    end
+  else
+    begin
+    WT:=TWasmThread(TJSArray(FIdleWorkers).pop);
+    end;
+  TJSArray(FBusyWorkers).Push(WT);
+  Result:=WT;
+end;
+
+
+procedure TMainThreadSupport.SendRunCommand(aThreadWorker: TWasmThread);
+
+Var
+  WRC : TWorkerRunCommand;
+
+begin
+  With aThreadWorker.ThreadInfo do
+    WRC:=TWorkerRunCommand.Create(ThreadID,RunFunction,Attributes,Arguments,ThreadInfoLocation);
+  aThreadWorker.SendCommand(Wrc);
+end;
+
+procedure TMainThreadSupport.SetWasiHost(AValue: TWASIHost);
+
+
+begin
+  // Writeln('Setting wasi host');
+  if FHost=AValue then
+    Exit;
+  FHost:=AValue;
+  If Assigned(FHost) and Host.StartDescriptorReady then
+    SendLoadCommands;
+end;
+
+function TMainThreadSupport.thread_spawn(thread_id: Integer; attrs: Integer;
+  thread_start_func: Integer; args: Integer): Integer;
+
+var
+  aInfo : TThreadInfo;
+
+begin
+  // Writeln('In host thread_spawn');
+  aInfo.ThreadID:=AllocateThreadID;
+  aInfo.RunFunction:=thread_start_func;
+  aInfo.Arguments:=Args;
+  aInfo.Attributes:=Attrs;
+  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;
+end;
+
+function TMainThreadSupport.thread_cancel(thread_id: Integer): Integer;
+begin
+  Result:=0;
+end;
+
+function TMainThreadSupport.thread_self: Integer;
+begin
+  Result:=0;
+end;
+
+function TMainThreadSupport.AllocateThreadID: Integer;
+begin
+  Inc(FNextThreadID);
+  Result:=FNextThreadID;
+end;
+
+procedure TMainThreadSupport.SendLoadCommands;
+
+Var
+  WT : TWasmThread;
+
+begin
+  // Writeln('Sending load command to all workers');
+  For WT in FIdleWorkers do
+    if not WT.LoadSent then
+      SendLoadCommand(WT);
+end;
+
+function TMainThreadSupport.SpawnThread(aInfo: TThreadInfo): Integer;
+
+Var
+  WT : TWasmThread;
+
+begin
+  // Writeln('Enter TMainThreadSupport.SpawnThread for ID ',aInfo.ThreadID);
+  WT:=GetNewWorker;
+  if WT=nil then
+    begin
+    Writeln('Error: no worker !');
+    exit(-1)
+    end;
+  WT.ThreadInfo:=aInfo;
+  FThreads[aInfo.ThreadID]:=WT;
+  if WT.Loaded then
+    begin
+    // Writeln('Worker is loaded. Sending run command to worker');
+    SendRunCommand(WT);
+    end;
+  // Writeln('Exit: TMainThreadSupport.SpawnThread for ID ',WT.ThreadID);
+end;
+
+
+constructor TMainThreadSupport.Create(aEnv: TPas2JSWASIEnvironment);
+begin
+  Create(aEnv,DefaultThreadWorker,DefaultThreadCount)
+end;
+
+constructor TMainThreadSupport.Create(aEnv: TPas2JSWASIEnvironment;
+  aWorkerScript: String; aSpawnWorkerCount: integer);
+
+Var
+  I : Integer;
+
+begin
+  Inherited Create(aEnv);
+  FThreads:=TThreadHash.new;
+  FWorkerScript:=aWorkerScript;
+  FInitialWorkerCount:=aSpawnWorkerCount;
+  FMaxWorkerCount:=DefaultMaxWorkerCount;
+  For I:=1 to aSpawnWorkerCount do
+    TJSArray(FIdleWorkers).Push(AllocateNewWorker(aWorkerScript));
+end;
+
+procedure TMainThreadSupport.HandleSpawnCommand(aWorker : TWasmThread; aCommand: TWorkerSpawnThreadCommand);
+
+Var
+  aInfo: TThreadInfo;
+
+begin
+  aInfo.OriginThreadID:=aWorker.ThreadID;
+  aInfo.RunFunction:=aCommand.RunFunction;
+  aInfo.ThreadID:=aCommand.ThreadID;
+  aInfo.Arguments:=aCommand.Arguments;
+  aInfo.Attributes:=aCommand.Attributes;
+  SpawnThread(aInfo);
+end;
+
+procedure TMainThreadSupport.HandleKillCommand(aWorker : TWasmThread; aCommand: TWorkerKillCommand);
+
+begin
+
+end;
+
+procedure TMainThreadSupport.HandleCancelCommand(aWorker : TWasmThread; aCommand: TWorkerCancelCommand);
+
+begin
+
+end;
+
+procedure TMainThreadSupport.HandleLoadedCommand(aWorker : TWasmThread; aCommand: TWorkerLoadedCommand);
+
+begin
+  // Writeln('Host: Entering TMainThreadSupport.HandleLoadedCommand');
+  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 TMainThreadSupport.HandleLoadedCommand');
+end;
+
+procedure TMainThreadSupport.HandleCleanupCommand(aWorker : TWasmThread; aCommand: TWorkerCleanupCommand);
+
+Var
+  Idx : Integer;
+
+begin
+  aWorker.ThreadInfo:=Default(TThreadInfo);
+  Idx:=TJSarray(FBusyWorkers).indexOf(aWorker);
+  if Idx<>-1 then
+    Delete(FBusyWorkers,Idx,1);
+  Idx:=TJSarray(FIdleWorkers).indexOf(aWorker);
+  if Idx=-1 then
+    FIdleWorkers:=Concat(FIdleWorkers,[aWorker]);
+end;
+
+procedure TMainThreadSupport.HandleConsoleCommand(aWorker : TWasmThread; aCommand: TWorkerConsoleCommand);
+
+Var
+  Prefix : string;
+
+begin
+  Prefix:=Format('Wasm thread %d: ',[aWorker.ThreadID]);
+  if Assigned(Host.OnConsoleWrite) then
+    Host.OnConsoleWrite(Host,Prefix+aCommand.ConsoleMessage)
+  else
+    Writeln(Prefix+aCommand.ConsoleMessage);
+end;
+
+procedure TMainThreadSupport.HandleCommand(aWorker : TWasmThread; aCommand: TWorkerCommand);
+begin
+  Case aCommand.Command of
+    cmdSpawn : HandleSpawnCommand(aWorker, TWorkerSpawnThreadCommand(aCommand));
+    cmdCleanup : HandleCleanupCommand(aWorker, TWorkerCleanupCommand(aCommand));
+    cmdKill : HandleKillCommand(aWorker, TWorkerKillCommand(aCommand));
+    cmdCancel : HandleCancelCommand(aWorker, TWorkerCancelCommand(aCommand));
+    cmdLoaded : HandleLoadedCommand(aWorker, TWorkerLoadedCommand(aCommand));
+    cmdConsole : HandleConsoleCommand(aWorker, TWorkerConsoleCommand(aCommand));
+  else
+    HandleCommand(aCommand);
+  end;
+end;
+
+end.
+

packages/wasi/wasiworkerthreadhost.pas

@@ -0,0 +1,663 @@
+unit wasiworkerthreadhost;
+
+{$mode ObjFPC}
+{$modeswitch externalclass}
+
+interface
+
+uses
+  Classes, SysUtils, JS, custapp, weborworker, webworker, webassembly, wasienv, Rtl.WebThreads;
+
+Type
+  TWorkerThreadSupport = Class;
+
+  { TWASIThreadHost }
+
+  TWASIThreadHost = class(TWASIHost)
+  private
+    FSendOutputToBrowserWindow: Boolean;
+    FThreadEntryPoint: String;
+    FThreadInitInstanceEntry : String;
+    FThreadSupport: TWorkerThreadSupport;
+    procedure SetThreadSupport(AValue: TWorkerThreadSupport);
+  Protected
+    Procedure RunWebAssemblyThread(aProc : TRunWebassemblyProc); virtual;
+    Procedure PrepareWebAssemblyThread(aDescr : TWebAssemblyStartDescriptor); virtual;
+    procedure DoStdWrite(Sender: TObject; const aOutput: String); override;
+  Public
+    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
+    Property ThreadSupport : TWorkerThreadSupport Read FThreadSupport Write SetThreadSupport;
+  end;
+
+
+  // This object has the thread support that is needed by the worker that runs a thread.
+
+  { TWorkerThreadSupport }
+
+  TWorkerThreadSupport = class(TWasmThreadSupport)
+  Private
+    FStartThreadID : Integer;
+    FNextThreadID : Integer;
+    FCurrentThreadInfo : TThreadinfo;
+    FModule : TJSWebAssemblyModule;
+    FMemory : TJSWebAssemblyMemory;
+    FWasiHost: TWASIThreadHost;
+  Protected
+    // Set new thread range
+    procedure InitThreadRange(aRange: Integer);
+    // allocate new thread ID.
+    Function AllocateNewThreadID : NativeInt;
+    // Incoming messages
+    procedure LoadWasmModule(aCommand: TWorkerLoadCommand); virtual;
+    procedure RunWasmModule(aCommand: TWorkerRunCommand); virtual;
+    procedure CancelWasmModule(aCommand: TWorkerCancelCommand); virtual;
+    procedure SetThreadRange(aCommand: TWorkerThreadIDRangeCommand); virtual;
+    // outgoing messages
+    procedure RequestNewThreadBlock; virtual;
+    procedure SendLoaded; virtual;
+    Procedure SendConsoleMessage(aMessage : String); overload;
+    Procedure SendConsoleMessage(aFmt : String; const aArgs : array of const); overload;
+    Procedure SendConsoleMessage(const aArgs : array of JSValue); overload;
+    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_detach(thread_id : Integer) : Integer; override;
+    Function thread_cancel(thread_id : Integer) : Integer; override;
+    Function thread_self() : Integer; override;
+  Public
+    // Handle incoming command
+    Procedure HandleCommand(aCommand : TWorkerCommand); override;
+    // Current thread info.
+    Property CurrentThreadInfo : TThreadInfo Read FCurrentThreadInfo;
+    // The WASI host, used to run routines.
+    Property Host : TWASIThreadHost Read FWasiHost Write FWasiHost;
+  end;
+
+
+  { TWorkerWASIHostApplication }
+
+  TWorkerWASIHostApplication = class(TCustomApplication)
+  private
+    FHost : TWASIHost;
+    FThreadSupport : TWorkerThreadSupport;
+    FSendOutputToBrowser: Boolean;
+    function GetAfterStart: TAfterStartEvent;
+    function GetBeforeStart: TBeforeStartEvent;
+    function GetcPredefinedConsoleInput: TStrings;
+    function GetEnv: TPas2JSWASIEnvironment;
+    function GetExported: TWASIExports;
+    function GetOnConsoleRead: TConsoleReadEvent;
+    function GetOnConsoleWrite: TConsoleWriteEvent;
+    function GetRunEntryFunction: String;
+    procedure SetAfterStart(AValue: TAfterStartEvent);
+    procedure SetBeforeStart(AValue: TBeforeStartEvent);
+    procedure SetOnConsoleRead(AValue: TConsoleReadEvent);
+    procedure SetOnConsoleWrite(AValue: TConsoleWriteEvent);
+    procedure SetPredefinedConsoleInput(AValue: TStrings);
+    procedure SetRunEntryFunction(AValue: String);
+  protected
+    procedure HandleMessage(aEvent: TJSEvent); virtual;
+    procedure DoOnSendCommand(Sender : TObject; aCommand : TWorkerCommand);
+    function CreateHost: TWASIHost; virtual;
+    procedure DoRun; override;
+    function GetConsoleApplication: boolean; override;
+    function GetLocation: String; override;
+  public
+    Constructor Create(aOwner : TComponent); override;
+    Destructor Destroy; override;
+    procedure SendCommand(aCommand: TWorkerCommand); virtual;
+    procedure GetEnvironmentList(List: TStrings; NamesOnly: Boolean); override;
+    procedure ShowException(E: Exception); override;
+    // Load and start webassembly. If DoRun is true, then Webassembly entry point is called.
+    // If aBeforeStart is specified, then it is called prior to calling run, and can disable running.
+    // If aAfterStart is specified, then it is called after calling run. It is not called is running was disabled.
+    Procedure StartWebAssembly(aPath: string; DoRun : Boolean = True;  aBeforeStart : TBeforeStartCallback = Nil; aAfterStart : TAfterStartCallback = Nil);
+    // Environment to be used
+    Property WasiEnvironment : TPas2JSWASIEnvironment Read GetEnv;
+    // Exported functions. Also available in start descriptor.
+    Property Exported : TWASIExports Read GetExported;
+    // Name of function to run, if empty default _start symbol is used.
+    Property RunEntryFunction : String Read GetRunEntryFunction Write SetRunEntryFunction;
+    // Called after webassembly start was run. Not called if webassembly was not run.
+    Property AfterStart : TAfterStartEvent Read GetAfterStart Write SetAfterStart;
+    // Called before running webassembly. If aAllowRun is false, running is disabled
+    Property BeforeStart : TBeforeStartEvent Read GetBeforeStart Write SetBeforeStart;
+    // Send output to browser window process?
+    Property SendOutputToBrowser : Boolean Read FSendOutputToBrowser Write FSendOutputToBrowser;
+    // Default console input
+    Property PredefinedConsoleInput : TStrings Read GetcPredefinedConsoleInput Write SetPredefinedConsoleInput;
+    // Called when reading from console (stdin). If not set, PredefinedConsoleinput is used.
+    property OnConsoleRead : TConsoleReadEvent Read GetOnConsoleRead Write SetOnConsoleRead;
+    // Called when writing to console (stdout). If not set, console.log is used.
+    property OnConsoleWrite : TConsoleWriteEvent Read GetOnConsoleWrite Write SetOnConsoleWrite;
+    // Our thread support object
+    Property ThreadSupport : TWorkerThreadSupport Read FThreadSupport Write FThreadSupport;
+  end;
+
+implementation
+
+uses Types;
+
+var
+  Self_ : TJSDedicatedWorkerGlobalScope; external name 'self';
+  EnvNames: TJSObject;
+
+procedure ReloadEnvironmentStrings;
+
+var
+  I : Integer;
+  S,N : String;
+  A,P : TStringDynArray;
+
+begin
+  if Assigned(EnvNames) then
+    FreeAndNil(EnvNames);
+  EnvNames:=TJSObject.new;
+  S:=self_.Location.search;
+  S:=Copy(S,2,Length(S)-1);
+  A:=TJSString(S).split('&');
+  for I:=0 to Length(A)-1 do
+    begin
+    P:=TJSString(A[i]).split('=');
+    N:=LowerCase(decodeURIComponent(P[0]));
+    if Length(P)=2 then
+      EnvNames[N]:=decodeURIComponent(P[1])
+    else if Length(P)=1 then
+      EnvNames[N]:=''
+    end;
+end;
+
+function MyGetEnvironmentVariable(Const EnvVar: String): String;
+
+Var
+  aName : String;
+
+begin
+  aName:=Lowercase(EnvVar);
+  if EnvNames.hasOwnProperty(aName) then
+    Result:=String(EnvNames[aName])
+  else
+    Result:='';
+end;
+
+function MyGetEnvironmentVariableCount: Integer;
+begin
+  Result:=length(TJSOBject.getOwnPropertyNames(envNames));
+end;
+
+function MyGetEnvironmentString(Index: Integer): String;
+begin
+  Result:=String(EnvNames[TJSOBject.getOwnPropertyNames(envNames)[Index]]);
+end;
+
+
+{ TWASIThreadHost }
+
+procedure TWASIThreadHost.SetThreadSupport(AValue: TWorkerThreadSupport);
+begin
+  if FThreadSupport=AValue then Exit;
+  if Assigned(FThreadSupport) then
+    FThreadSupport.Host:=Nil;
+  FThreadSupport:=AValue;
+  if Assigned(FThreadSupport) then
+    FThreadSupport.Host:=Self;
+end;
+
+procedure TWASIThreadHost.RunWebAssemblyThread(aProc : TRunWebassemblyProc);
+begin
+//  Writeln('TWASIThreadHost.Entering RunWebAssemblyThread ');
+  RunWebAssemblyInstance(Nil,Nil,aProc);
+end;
+
+procedure TWASIThreadHost.PrepareWebAssemblyThread( aDescr: TWebAssemblyStartDescriptor);
+
+Var
+  func : JSValue;
+  InitFunc : TThreadInitInstanceFunction absolute func;
+  res : Integer;
+
+begin
+  PrepareWebAssemblyInstance(aDescr);
+  func:=aDescr.Exported[ThreadInitInstanceEntry];
+  if Assigned(func) then
+    begin
+    res:=InitFunc(1,0,1);
+    if Res<>0 then
+      if Assigned(ThreadSupport) then
+        ThreadSupport.SendConsoleMessage('Could not init assembly thread: %d', [Res])
+      else
+        Writeln('Could not init assembly thread: ',Res);
+    end;
+end;
+
+procedure TWASIThreadHost.DoStdWrite(Sender: TObject; const aOutput: String);
+begin
+  inherited DoStdWrite(Sender, aOutput);
+  if FSendOutputToBrowserWindow and assigned(FThreadSupport) then
+    FThreadSupport.SendConsoleMessage(aOutput);
+end;
+
+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;
+
+Var
+  P : TWorkerSpawnThreadCommand;
+
+begin
+  P:=TWorkerSpawnThreadCommand.Create(AllocateNewThreadID,Attrs,Args,thread_start_func,Thread_id);
+  SendCommand(P);
+  Env.SetMemInfoInt32(thread_id,P.ThreadID);
+  Result:=0;
+end;
+
+function TWorkerThreadSupport.thread_detach(thread_id: Integer): Integer;
+begin
+  Result:=0;
+end;
+
+function TWorkerThreadSupport.thread_cancel(thread_id: Integer): Integer;
+begin
+  Result:=0;
+end;
+
+function TWorkerThreadSupport.thread_self: Integer;
+begin
+  Result:=0;
+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;
+
+Var
+  L : TWorkerLoadedCommand;
+
+begin
+  L:=TWorkerLoadedCommand.Create();
+  SendCommand(L);
+end;
+
+procedure TWorkerThreadSupport.SendConsoleMessage(aMessage: String);
+
+Var
+  L : TWorkerConsoleCommand;
+
+begin
+  L:=TWorkerConsoleCommand.Create(aMessage,FCurrentThreadInfo.ThreadId);
+  SendCommand(L);
+end;
+
+procedure TWorkerThreadSupport.SendConsoleMessage(aFmt: String;
+  const aArgs: array of const);
+begin
+  SendConsoleMessage(Format(aFmt,aArgs));
+end;
+
+procedure TWorkerThreadSupport.SendConsoleMessage(const aArgs: array of JSValue);
+
+Var
+  L : TWorkerConsoleCommand;
+
+begin
+  L:=TWorkerConsoleCommand.Create(aArgs,FCurrentThreadInfo.ThreadId);
+  SendCommand(L);
+end;
+
+procedure TWorkerThreadSupport.CancelWasmModule(aCommand : TWorkerCancelCommand);
+
+begin
+  // todo
+end;
+
+
+procedure TWorkerThreadSupport.SendException(aError : Exception);
+
+Var
+  E : TWorkerExceptionCommand;
+
+begin
+  E:=TWorkerExceptionCommand.CreateNew(aError.ClassName,aError.Message,FCurrentThreadInfo.ThreadId);
+  SendCommand(E);
+end;
+
+procedure TWorkerThreadSupport.SendException(aError: TJSError);
+
+Var
+  aMessage,aClass : String;
+  E : TWorkerExceptionCommand;
+
+begin
+  aClass:='Error';
+  aMessage:=aError.Message;
+  E:=TWorkerExceptionCommand.CreateNew(aClass,aMessage,FCurrentThreadInfo.ThreadId);
+  SendCommand(E);
+end;
+
+
+procedure TWorkerThreadSupport.RunWasmModule(aCommand : TWorkerRunCommand);
+
+  Procedure DoRun (aExports : TWASIExports);
+
+  Var
+    aResult : Integer;
+
+  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);
+      if aResult>0 then
+        Writeln('Thread run function result ',aResult);
+    except
+      on E : Exception do
+        SendException(E);
+      on JE : TJSError do
+        SendException(JE);
+      on JE : TJSError do
+        SendException(JE)
+    end;
+
+  end;
+
+begin
+  // Writeln('Entering TWorkerThreadSupport.RunWasmModule '+TJSJSON.Stringify(aCommand));
+  // 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;
+
+procedure TWorkerThreadSupport.LoadWasmModule(aCommand: TWorkerLoadCommand);
+
+
+Var
+  WASD : TWebAssemblyStartDescriptor;
+  aTable : TJSWebAssemblyTable;
+
+  function doOK(aValue: JSValue): JSValue;
+  // We are using the overload that takes a compiled module.
+  // In that case the promise resolves to a WebAssembly.Instance, not to a InstantiateResult !
+  Var
+    aInstance : TJSWebAssemblyInstance absolute aValue;
+
+  begin
+    Result:=True;
+    WASD.Instance:=aInstance;
+    WASD.Exported:=TWASIExports(TJSObject(aInstance.exports_));
+    WASD.CallRun:=Nil;
+    Host.PrepareWebAssemblyThread(WASD);
+    SendLoaded;
+    // These 2 prevent running different instances simultaneously.
+  end;
+
+  function DoFail(aValue: JSValue): JSValue;
+
+  var
+    E: Exception;
+
+  begin
+    Result:=True;
+    E:=Exception.Create('Failed to create webassembly. Reason: '+TJSJSON.Stringify(aValue));
+    SendException(E);
+    E.Free;
+  end;
+
+
+begin
+  FMemory:=aCommand.Memory;
+  FModule:=aCommand.Module;
+  InitThreadRange(aCommand.ThreadRangeStart);
+  try
+    aTable:=TJSWebAssemblyTable.New(Host.TableDescriptor);
+    WASD:=Host.InitStartDescriptor(FMemory,aTable,Nil);
+    TJSWebAssembly.Instantiate(FModule,WASD.Imports)._then(@DoOK,@DoFail).Catch(@DoFail);
+  except
+    on E : Exception do
+      SendException(E);
+    on JE : TJSError do
+      SendException(JE);
+  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);
+
+begin
+  case aCommand.Command of
+    cmdload : LoadWasmModule(TWorkerLoadCommand(aCommand));
+    cmdRun : RunWasmModule(TWorkerRunCommand(aCommand));
+    cmdCancel : CancelWasmModule(TWorkerCancelCommand(aCommand));
+    cmdThreadIdRange : SetThreadRange(TWorkerThreadIDRangeCommand(aCommand));
+  end;
+end;
+
+
+
+{ TWorkerWASIHostApplication }
+
+function TWorkerWASIHostApplication.GetAfterStart: TAfterStartEvent;
+begin
+  Result:=FHost.AfterStart;
+end;
+
+function TWorkerWASIHostApplication.GetBeforeStart: TBeforeStartEvent;
+begin
+  Result:=FHost.BeforeStart;
+end;
+
+function TWorkerWASIHostApplication.GetcPredefinedConsoleInput: TStrings;
+begin
+  Result:=FHost.PredefinedConsoleInput;
+end;
+
+function TWorkerWASIHostApplication.GetEnv: TPas2JSWASIEnvironment;
+begin
+  Result:=FHost.WasiEnvironment;
+end;
+
+function TWorkerWASIHostApplication.GetExported: TWASIExports;
+begin
+  Result:=FHost.Exported;
+end;
+
+
+function TWorkerWASIHostApplication.GetOnConsoleRead: TConsoleReadEvent;
+begin
+  Result:=FHost.OnConsoleRead;
+end;
+
+function TWorkerWASIHostApplication.GetOnConsoleWrite: TConsoleWriteEvent;
+begin
+  Result:=FHost.OnConsoleWrite;
+end;
+
+function TWorkerWASIHostApplication.GetRunEntryFunction: String;
+begin
+  Result:=FHost.RunEntryFunction;
+end;
+
+
+procedure TWorkerWASIHostApplication.SetAfterStart(AValue: TAfterStartEvent);
+begin
+  FHost.AfterStart:=aValue;
+end;
+
+procedure TWorkerWASIHostApplication.SetBeforeStart(AValue: TBeforeStartEvent);
+begin
+  FHost.BeforeStart:=aValue;
+end;
+
+procedure TWorkerWASIHostApplication.SetOnConsoleRead(AValue: TConsoleReadEvent
+  );
+begin
+  FHost.OnConsoleRead:=aValue;
+end;
+
+procedure TWorkerWASIHostApplication.SetOnConsoleWrite(
+  AValue: TConsoleWriteEvent);
+begin
+    FHost.OnConsoleWrite:=aValue;
+end;
+
+procedure TWorkerWASIHostApplication.SetPredefinedConsoleInput(AValue: TStrings);
+begin
+  FHost.PredefinedConsoleInput:=aValue;
+end;
+
+procedure TWorkerWASIHostApplication.SetRunEntryFunction(AValue: String);
+begin
+  FHost.RunEntryFunction:=aValue;
+end;
+
+function TWorkerWASIHostApplication.CreateHost : TWASIHost;
+
+Var
+  TH : TWasiThreadHost;
+
+begin
+  TH:=TWASIThreadHost.Create(Self);
+  FThreadSupport:=TWorkerThreadSupport.Create(TH.WasiEnvironment);
+  FThreadSupport.OnSendCommand:=@DoOnSendCommand;
+  TH.ThreadSupport:=FThreadSupport; // Sets FThreadSupport.host
+  Result:=TH;
+end;
+
+procedure TWorkerWASIHostApplication.DoRun;
+begin
+  Self_.addEventListener('message',@HandleMessage);
+end;
+
+procedure TWorkerWASIHostApplication.HandleMessage(aEvent: TJSEvent);
+
+Var
+  aMessageEvent : TJSMessageEvent absolute aEvent;
+  aData : TWorkerCommand;
+
+begin
+  if IsObject(aMessageEvent.Data) and TJSObject(aMessageEvent.Data).hasOwnProperty('Command') then
+    begin
+    aData:=TWorkerCommand(aMessageEvent.Data);
+    FThreadSupport.HandleCommand(aData);
+    end
+  else
+    FThreadSupport.SendConsoleMessage('Unknown message received: '+TJSJSON.Stringify(aMessageEvent.Data));
+end;
+
+procedure TWorkerWASIHostApplication.DoOnSendCommand(Sender: TObject;
+  aCommand: TWorkerCommand);
+begin
+  SendCommand(aCommand);
+end;
+
+procedure TWorkerWASIHostApplication.SendCommand(aCommand: TWorkerCommand);
+begin
+  Self_.PostMessage(aCommand);
+end;
+
+function TWorkerWASIHostApplication.GetConsoleApplication: boolean;
+begin
+  Result:=true;
+end;
+
+function TWorkerWASIHostApplication.GetLocation: String;
+begin
+  Result:=webworker.Location.pathname;
+end;
+
+constructor TWorkerWASIHostApplication.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FHost:=CreateHost;
+end;
+
+destructor TWorkerWASIHostApplication.Destroy;
+begin
+  FreeAndNil(FHost);
+  inherited Destroy;
+end;
+
+procedure TWorkerWASIHostApplication.GetEnvironmentList(List: TStrings;
+  NamesOnly: Boolean);
+var
+  Names: TStringDynArray;
+  i: Integer;
+begin
+  Names:=TJSObject.getOwnPropertyNames(EnvNames);
+  for i:=0 to length(Names)-1 do
+  begin
+    if NamesOnly then
+      List.Add(Names[i])
+    else
+      List.Add(Names[i]+'='+String(EnvNames[Names[i]]));
+  end;
+end;
+
+procedure TWorkerWASIHostApplication.ShowException(E: Exception);
+
+begin
+  ThreadSupport.SendException(E);
+end;
+
+procedure TWorkerWASIHostApplication.StartWebAssembly(aPath: string; DoRun: Boolean;
+  aBeforeStart: TBeforeStartCallback = nil; aAfterStart: TAfterStartCallback = nil);
+
+begin
+  FHost.StartWebAssembly(aPath,DoRun,aBeforeStart,aAfterStart);
+end;
+
+Initialization
+  ReloadEnvironmentStrings;
+  OnGetEnvironmentVariable:=@MyGetEnvironmentVariable;
+  OnGetEnvironmentVariableCount:=@MyGetEnvironmentVariableCount;
+  OnGetEnvironmentString:=@MyGetEnvironmentString;
+end.
+