* Seems not all was committed

rtl/objpas/classes/classes.inc

@@ -332,7 +332,7 @@ begin
 // enable for all platforms once http://bugs.freepascal.org/view.php?id=16884
 // is fixed for all platforms (in case the fix for non-unix platforms also
 // requires this field at least)
-{$if defined(unix) or defined(windows) or defined(os2) or defined(hasamiga)}
+{$if defined(unix) or defined(windows) or defined(os2) or defined(hasamiga) or defined(wasi) }
   if not FExternalThread and not FInitialSuspended then
     Resume;
 {$endif}

rtl/objpas/classes/classesh.inc

@@ -2269,7 +2269,7 @@ type
   private
     FInitialSuspended: boolean;
 {$endif}
-{$ifdef Unix}
+{$if defined(Unix) or defined(wasi)}
   private
     // see tthread.inc, ThreadFunc and TThread.Resume
     FSuspendEvent: PRTLEvent;

rtl/wasi/sysheap.inc

@@ -31,7 +31,9 @@ begin
   if res<>err then
     SysOSAlloc:=pointer(res*page_size)
   else
+    begin
     SysOSAlloc:=nil;
+    end;
 end;
 
 procedure SysOSFree(p: pointer; size: ptruint);

rtl/wasi/sysosh.inc

@@ -18,10 +18,15 @@
 {Platform specific information}
 type
   THandle = LongInt;
-  TThreadID = THandle;
+  TThreadID = Pointer;
   TOSTimestamp = LongInt;
 
   PRTLCriticalSection = ^TRTLCriticalSection;
   TRTLCriticalSection = record
-    Locked: boolean
+    Locked: LongInt; // integer so we can use wait32.
+    Count: LongInt; // Number of times locked.
+    Waiters : LongInt; // Number of waiters
+    Kind : LongInt; // Kind of mutex, Equals Ord(TMutexKind)
+    Owner : TThreadID;  // Owner thread
+    Destroying : Boolean; // Set when notifying that we're destroying the mutex.
   end;

rtl/wasi/system.pp

@@ -66,11 +66,44 @@ procedure __fpc_set_wasm_suspender(v: WasmExternRef);
 
 property __fpc_wasm_suspender: WasmExternRef read __fpc_get_wasm_suspender write __fpc_set_wasm_suspender;
 
+Procedure DebugWriteln(aString : ShortString);
+
 implementation
 
 {$I wasitypes.inc}
 {$I wasiprocs.inc}
 
+function IntToStr(I : Longint) : ShortString;
+
+Var
+  S : ShortString;
+
+begin
+  Str(I,S);
+  IntToStr:=S;
+end;
+
+Procedure DebugWriteln(aString : ShortString);
+
+var
+  our_iov: __wasi_ciovec_t;
+  our_nwritten: longint;
+  res: __wasi_errno_t;
+
+begin
+  our_iov.buf := @aString[1];
+  our_iov.buf_len := Length(aString);
+  repeat
+    res:=__wasi_fd_write(1, @our_iov, 1, @our_nwritten);
+    if res=__WASI_ERRNO_SUCCESS then
+      begin
+      our_iov.buf_len:=our_iov.buf_len-our_nwritten;
+      our_iov.buf:=our_iov.buf+our_nwritten;
+      end;
+  Until (our_iov.buf_len=0) or (res=__WASI_ERRNO_SUCCESS) or ((res<>__WASI_ERRNO_INTR) and (res<>__WASI_ERRNO_AGAIN));
+end;
+
+
 function WasiAlloc (aLength : Longint) : Pointer; [public, alias: 'wasiAlloc'];
 
 begin
@@ -83,7 +116,7 @@ begin
   FreeMem(aMem);
 end;
 
-exports 
+exports
   WasiAlloc,WasiFree;
 
 function __fpc_get_wasm_suspender: WasmExternRef;
@@ -172,7 +205,7 @@ procedure System_exit;
 begin
   if ExitCode>=126 then
     begin
-      writeln(stderr,'##WASI-EXITCODE: ',ExitCode,' -> 125##');
+      Debugwriteln('##WASI-EXITCODE: '+IntToStr(ExitCode)+' -> 125##');
       ExitCode:=125;
     end;
   __wasi_proc_exit(ExitCode);
@@ -402,13 +435,15 @@ begin
   InitHeap;
   SysInitExceptions;
   initunicodestringmanager;
-  { Setup stdin, stdout and stderr }
-  SysInitStdIO;
   { Reset IO Error }
   InOutRes:=0;
-{$ifdef FPC_HAS_FEATURE_THREADING}
+{$ifdef FPC_WASM_THREADS}
   InitSystemThreads;
+  InitThreadVars(@WasiRelocateThreadVar);
 {$endif}
+  { Setup stdin, stdout and stderr }
+  SysInitStdIO;
   Setup_Environment;
   Setup_PreopenedDirs;
+  TLSInfoBlock:=Nil;
 end.

rtl/wasi/systhrd.inc

@@ -1,3 +1,4 @@
+{%MainUnit system.pp}
 {
     This file is part of the Free Pascal run time library.
     Copyright (c) 2022 by Nikolay Nikolov,
@@ -18,185 +19,536 @@
   {$fatal This file shouldn't be included if thread support is disabled!}
 {$endif FPC_WASM_THREADS}
 
-var
+{$DEFINE DEBUGWASMTHREADS}
+
+Const
+  MaxThreadSignal = 1000; // maximum threads to signal
+
+Type
+  TThreadState = (tsNone,tsInit,tsRunning,tsCanceling,tsExit);
+  TOSTime = __wasi_timestamp_t;
+// Forwards used in mutex
+Function GetClockTime: TOSTime; forward;
+Function IsWaitAllowed : Boolean; forward;
+Function GetSelfThread : TThreadID; forward;
+Function GetThreadState(aThread : TThreadID) : TThreadState; forward;
+
+{$i wasmmem.inc}
+{$i wasmmutex.inc}
+
+Type
+  PWasmRTLEvent = ^TWasmRTLEvent;
+  TWasmRTLEvent = record
+    Signal : Longint;
+    mutex: TWasmMutex;
+    Destroying : Boolean;
+  end;
+
+  PWasmThread = ^TWasmThread;
+  TWasmThread = Record
+    ID : LongInt; // Allocated by host javascript code
+    State : TThreadState;
+    DoneEvent : PWasmRTLEvent;
+    Running : TWasmMutex;
+    ExitCode : Cardinal;
+    ThreadName : Array of byte; // UTF8 name
+  end;
+
+Var
+  MainThread : TWasmThread;
   WasiThreadManager : TThreadManager;
+  GlobalIsWorkerThread : Longint; section 'WebAssembly.Global';
+  GlobalIsMainThread : Longint; section 'WebAssembly.Global';
+  GlobalIsThreadBlockable : Longint; section 'WebAssembly.Global';
+  GlobalCurrentThread : PWasmThread; section 'WebAssembly.Global';
+
+
+
+// Forward functions
+
+
+Function IsWaitAllowed : Boolean;
+
+begin
+  IsWaitAllowed:=GlobalIsThreadBlockable<>0;
+end;
+
+
+Function GetClockTime: TOSTime;
+
+var
+  NanoSecsPast: TOSTime;
+
+begin
+  if __wasi_clock_time_get(__WASI_CLOCKID_REALTIME,1000000,@NanoSecsPast)=__WASI_ERRNO_SUCCESS then
+    GetClockTime:=NanoSecsPast
+  else
+    GetClockTime:=0;
+end;
+
+Function GetSelfThread : TThreadID;
+
+begin
+  GetSelfThread:=GlobalCurrentThread;
+end;
+
+Function GetThreadState(aThread : TThreadID) : TThreadState;
+
+begin
+  GetThreadState:=PWasmThread(aThread)^.State
+end;
+
 
 function WasiInitManager: Boolean;
 begin
-  Result:=True;
+  DebugWriteln('Initializing manager');
+  if TLSInfoBlock=Nil then
+    TLSInfoBlock:=AllocateOSInfoBlock;
+  if TLSInfoBlock = Nil then
+    DebugWriteln('Initializing manager done: failed');
+  WasiInitManager:=True;
 end;
 
 function WasiDoneManager: Boolean;
 begin
-  Result:=True;
+  WasiDoneManager:=True;
 end;
 
-function WasiBeginThread(sa : Pointer;stacksize : PtrUInt; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : TThreadID;
+{ ----------------------------------------------------------------------
+  Critical section (mutex)
+  ----------------------------------------------------------------------}
+
+
+procedure WasiInitCriticalSection(var cs);
 begin
-  {todo:implement}
+  InitMutex(TWasmMutex(CS));
 end;
 
-procedure WasiEndThread(ExitCode : DWord);
+procedure WasiDoneCriticalSection(var cs);
 begin
-  {todo:implement}
+  DoneMutex(TWasmMutex(CS));
 end;
 
-function WasiSuspendThread(threadHandle : TThreadID) : dword;
+procedure WasiEnterCriticalSection(var cs);
 begin
-  {todo:implement}
+  LockMutex(TWasmMutex(CS));
 end;
 
-function WasiResumeThread(threadHandle : TThreadID) : dword;
+function WasiCriticalSectionTryEnter(var cs):longint;
 begin
-  {todo:implement}
+  WasiCriticalSectionTryEnter:=Ord(TryLockMutex(TWasmMutex(CS)))
 end;
 
-function WasiKillThread(threadHandle : TThreadID) : dword;
+procedure WasiLeaveCriticalSection(var cs);
 begin
-  {todo:implement}
+  UnLockMutex(TWasmMutex(CS));
 end;
 
-function WasiCloseThread(threadHandle : TThreadID) : dword;
+{ ----------------------------------------------------------------------
+  RTL event
+  ----------------------------------------------------------------------}
+
+
+function WasiRTLCreateEvent:PRTLEvent;
+
+Var
+  P : PWasmRTLEvent;
+
 begin
-  {todo:implement}
+  New(P);
+  P^.Signal:=0;
+  P^.Destroying:=False;
+  InitMutex(P^.Mutex);
 end;
 
-procedure WasiThreadSwitch;
+procedure WasiRTLEventSetEvent(AEvent:PRTLEvent);
+
+Var
+  P : PWasmRTLEvent absolute aEvent;
+  a : longint;
+
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : locking mutex');{$ENDIF}
+  LockMutex(P^.Mutex);
+  P^.Signal:=1;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : unlocking mutex');{$ENDIF}
+  UnLockMutex(P^.Mutex);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventSetEvent : send signal');{$ENDIF}
+  a:=fpc_wasm32_memory_atomic_notify(@(P^.Signal),MaxThreadSignal);
 end;
 
-function WasiWaitForThreadTerminate(threadHandle : TThreadID; TimeoutMs : longint) : dword;
+procedure WasiRTLEventDestroy(AEvent:PRTLEvent);
+
+Var
+  P : PWasmRTLEvent absolute aEvent;
+
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : locking mutex');{$ENDIF}
+  LockMutex(P^.Mutex);
+  P^.Destroying:=True;
+  UnlockMutex(P^.Mutex);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : setting event to notify others');{$ENDIF}
+  WasiRTLEventSetEvent(aEvent);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventDestroy : set event to notify others');{$ENDIF}
+  FreeMem(P);
 end;
 
-function WasiThreadSetPriority(threadHandle : TThreadID; Prio: longint): boolean;
+
+procedure WasiRTLEventResetEvent(AEvent:PRTLEvent);
+
+Var
+  P : PWasmRTLEvent absolute aEvent;
+
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventResetEvent : locking mutex');{$ENDIF}
+  LockMutex(P^.Mutex);
+  P^.Signal:=0;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventResetEvent : unlocking mutex');{$ENDIF}
+  UnLockMutex(P^.Mutex);
 end;
 
-function WasiThreadGetPriority(threadHandle : TThreadID): longint;
+procedure WasiRTLEventWaitFor_WaitAllowed(AEvent:PWasmRTLEvent; aTimeoutMs : Longint);
+
+Var
+  a : Longint;
+
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitAllowed : waiting');{$ENDIF}
+  a:=fpc_wasm32_memory_atomic_wait32(@(aEvent^.Signal),1,aTimeoutMs*1000);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitAllowed : done');{$ENDIF}
 end;
 
-function WasiGetCurrentThreadId : TThreadID;
+
+procedure WasiRTLEventWaitFor_WaitNotAllowed(AEvent:PWasmRTLEvent; aTimeoutMs : Longint);
+
+Var
+  EndTime : Int64;
+  IsTimeOut : Boolean;
+  IsDone : Boolean;
+  isMain : Boolean;
+
 begin
-  {todo:implement}
+  IsMain:=GlobalIsMainThread<>0;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitNotAllowed : waiting (is main: '+intToStr(Ord(IsMain))+')');{$ENDIF}
+  EndTime:=GetClockTime+aTimeoutMs*1000;
+  Repeat
+    IsTimeOut:=(aTimeOutMS<>0) and (GetClockTime>EndTime);
+    IsDone:=(aEvent^.Signal=1) or (aEvent^.Destroying) or (Not IsMain and (GetThreadState(GetSelfThread)<>tsRunning));
+  Until isTimeOut or IsDone;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitNotAllowed : done waiting');{$ENDIF}
 end;
 
-procedure WasiThreadSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString);
+procedure WasiRTLEventWaitFor(AEvent:PRTLEvent);
+
+Var
+  P : PWasmRTLEvent absolute aEvent;
+
 begin
-  {todo:implement}
+  if IsWaitAllowed then
+    WasiRTLEventWaitFor_WaitAllowed(P,0)
+  else
+    WasiRTLEventWaitFor_WaitNotAllowed(P,0);
 end;
-{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
-procedure WasiThreadSetThreadDebugNameU(threadHandle: TThreadID; const ThreadName: UnicodeString);
+
+procedure WasiRTLEventWaitForTimeout(AEvent:PRTLEvent;timeout : longint);
+Var
+  P : PWasmRTLEvent absolute aEvent;
+
 begin
-  {todo:implement}
+  if IsWaitAllowed then
+    WasiRTLEventWaitFor_WaitAllowed(P,TimeOut)
+  else
+    WasiRTLEventWaitFor_WaitNotAllowed(P,TimeOut);
 end;
-{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
 
-procedure WasiInitCriticalSection(var cs);
+
+{ ----------------------------------------------------------------------
+  Thread
+  ----------------------------------------------------------------------}
+
+
+// Javascript definition: TThreadInitInstanceFunction = Function(IsWorkerThread : Longint; IsMainThread : Integer; CanBlock : Integer) : Integer;
+
+Function FPCWasmThreadInit(IsWorkerThread : Longint; IsMainThread : Longint; CanBlock : Longint) : Longint; [public, alias: 'FPC_WASM_THREAD_INIT'];
+
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadInit('+IntToStr(IsWorkerThread)+','+IntToStr(IsMainThread)+','+IntToStr(CanBlock)+')');{$ENDIF}
+  GlobalIsWorkerThread:=IsWorkerThread;
+  GlobalIsMainThread:=IsMainThread;
+  GlobalIsThreadBlockable:=CanBlock;
+  Result:=0;
 end;
 
-procedure WasiDoneCriticalSection(var cs);
+procedure WasiAllocateThreadVars; forward;
+
+// Javascript definition: TThreadEntryFunction = Function(ThreadId : Longint; RunFunction : Longint; Args : LongInt) : Longint;
+
+Function FPCWasmThreadEntry(ThreadID : PWasmThread; RunFunction : Pointer; Args : Pointer) : Longint; [public, alias: 'FPC_WASM_THREAD_ENTRY'];
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadEntry('+IntToStr(PtrUint(ThreadID))+','+IntToStr(PtrUint(RunFunction))+','+IntToStr(PtrUint(Args))+')');{$ENDIF}
+  GlobalCurrentThread:=ThreadID;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadEntry: allocating threadvars (thread function: '+intToStr(PtrUint(RunFunction))+')');{$ENDIF}
+  WasiAllocateThreadVars;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadEntry: calling initthread (thread function: '+intToStr(PtrUint(RunFunction))+')');{$ENDIF}
+  InitThread;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadEntry: calling thread function '+intToStr(PtrUint(RunFunction)));{$ENDIF}
+  Result:=tthreadfunc(RunFunction)(args);
 end;
 
-procedure WasiEnterCriticalSection(var cs);
+exports FPCWasmThreadInit, FPCWasmThreadEntry;
+
+Function thread_spawn(thread_id : PInteger; attrs: Pointer; thread_start_func : Pointer; args : Pointer) : LongInt;  external 'FPCThreading' name 'thread_spawn';
+
+function WasiBeginThread(sa : Pointer;stacksize : PtrUInt; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : TThreadID;
+
+Var
+  T : PWasmThread;
+
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread(sa: '+IntToStr(PtrUint(Sa))+',ss: '+IntToStr(PtrUint(StackSize))+',TF: '+IntToStr(PtrUint(ThreadFunction))+',Arg: '+IntToStr(PtrUint(P))+',fl: '+IntToStr(PtrUint(CreationFlags))+',ID: '+IntToStr(PtrUint(ThreadID))+')');{$ENDIF}
+  T:=GetMem(SizeOf(TWasmThread));
+  ThreadID:=T;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread thread ID : '+IntToStr(PtrUint(ThreadID)));{$ENDIF}
+  InitMutex(T^.Running,mkNormal);
+  T^.DoneEvent:=WasiRTLCreateEvent;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: Locked mutex');{$ENDIF}
+  if thread_spawn(@(T^.ID),Nil,ThreadFunction,P)=0 then
+    begin
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: spawn thread OK, setting result');{$ENDIF}
+    WasiBeginThread:=T;
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: spawn thread OK, done setting result');{$ENDIF}
+    end
+  else
+    begin
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: spawn thread failed');{$ENDIF}
+    FreeMem(T);
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: spawn thread failed, freeing thread struct');{$ENDIF}
+    WasiBeginThread:=TThreadID(0);
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: spawn thread failed, returning 0');{$ENDIF}
+    end
 end;
 
-function WasiCriticalSectionTryEnter(var cs):longint;
+procedure WasiEndThread(ExitCode : DWord);
+
+Var
+  T : PWasmThread;
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('EndThread('+IntToStr(ExitCode)+')');{$ENDIF}
+  T:=PWasmThread(GetSelfThread);
+  T^.ExitCode:=ExitCode;
+  // Signal that we're done
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('EndThread: Signaling end of thread');{$ENDIF}
+  WasiRTLEventSetEvent(T^.DoneEvent);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('EndThread: Unlocking mutex');{$ENDIF}
+  // Now unlock running mutex
+  UnlockMutex(T^.Running);
 end;
 
-procedure WasiLeaveCriticalSection(var cs);
+function WasiSuspendThread(threadHandle : TThreadID) : dword;
 begin
-  {todo:implement}
+  WasiSuspendThread:=DWord(-1);
 end;
 
-procedure WasiInitThreadVar(var offset : dword;size : dword);
+function WasiResumeThread(threadHandle : TThreadID) : dword;
 begin
-  {todo:implement}
+  WasiResumeThread:=DWord(-1);
 end;
 
-function WasiRelocateThreadVar(offset : dword) : pointer;
+function WasiKillThread(threadHandle : TThreadID) : dword;
 begin
-  {todo:implement}
+  WasiKillThread:=DWord(-1);
 end;
 
-procedure WasiAllocateThreadVars;
+function WasiCloseThread(threadHandle : TThreadID) : dword;
 begin
-  {todo:implement}
+  Result:=0;
 end;
 
-procedure WasiReleaseThreadVars;
+procedure WasiThreadSwitch;
 begin
+  // Normally a yield, but this does not (yet) exist in webassembly.
   {todo:implement}
 end;
 
-function WasiBasicEventCreate(EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
+function WasiWaitForThreadTerminate(threadHandle : TThreadID; TimeoutMs : longint) : dword;
+
+Var
+  Res : Integer;
+  TH : PWasmThread absolute ThreadHandle;
+
 begin
-  {todo:implement}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WaitForThreadTerminate('+IntToStr(PtrUINT(TH))+','+IntToStr(TimeoutMs)+')');{$ENDIF}
+  WasiRTLEventWaitFor(TH^.DoneEvent);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WaitForThreadTerminate('+IntToStr(PtrUINT(TH))+') : Event set, waiting for lock');{$ENDIF}
+  Case LockMuTexTimeout(PWasmThread(ThreadHandle)^.Running,TimeoutMS) of
+    lmrOK : Res:=0;
+    lmrError : Res:=-2;
+  else
+     Res:=-1;
+  end;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WaitForThreadTerminate('+IntToStr(PtrUINT(TH))+') : Got Lock');{$ENDIF}
+  UnLockMuTex(PWasmThread(ThreadHandle)^.Running);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WaitForThreadTerminate('+IntToStr(PtrUINT(TH))+') : Lock released');{$ENDIF}
+  WasiWaitForThreadTerminate:=DWord(Res);
 end;
 
-procedure WasiBasicEventDestroy(state:peventstate);
+function WasiThreadSetPriority(threadHandle : TThreadID; Prio: longint): boolean;
 begin
-  {todo:implement}
+  Result:=False;
 end;
 
-procedure WasiBasicEventResetEvent(state:peventstate);
+function WasiThreadGetPriority(threadHandle : TThreadID): longint;
 begin
-  {todo:implement}
+  Result:=0;
 end;
 
-procedure WasiBasicEventSetEvent(state:peventstate);
+function WasiGetCurrentThreadId : TThreadID;
 begin
-  {todo:implement}
+  Result:=GetSelfThread;
 end;
 
-function WasiBasicEventWaitFor(timeout:cardinal;state:peventstate;FUseComWait : Boolean=False):longint;
+procedure WasiThreadSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString);
+
+Var
+  P : PWasmThread absolute ThreadHandle;
+  Len : Integer;
 begin
-  {todo:implement}
+  Len:=Length(ThreadName);
+  SetLength(P^.ThreadName,Len);
+  if Len>0 then
+    Move(ThreadName[1],P^.ThreadName[0],Len);
 end;
 
-function WasiRTLCreateEvent:PRTLEvent;
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+procedure WasiThreadSetThreadDebugNameU(threadHandle: TThreadID; const ThreadName: UnicodeString);
+
+Var
+  P : PWasmThread absolute ThreadHandle;
+  LThreadName : RawBytestring;
+  Len : Integer;
 begin
-  {todo:implement}
+  Len:=Length(LThreadName);
+  LThreadName:=Utf8Encode(ThreadName);
+  SetLength(P^.ThreadName,Len*SizeOf(UnicodeChar));
+  if Len>0 then
+    Move(LThreadName[1],P^.ThreadName[0],Len*SizeOf(UnicodeChar));
 end;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
 
-procedure WasiRTLEventDestroy(AEvent:PRTLEvent);
+
+{ ----------------------------------------------------------------------
+  Threadvars
+  ----------------------------------------------------------------------}
+
+
+Var
+  threadvarblocksize : PtrUint;
+
+procedure WasiInitThreadVar(var offset : dword;size : dword);
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiInitThreadVar('+IntToStr(offset)+','+IntToStr(size)+')');{$ENDIF}
+  threadvarblocksize:=align(threadvarblocksize, fpc_wasm32_tls_align);
+  offset:=threadvarblocksize;
+  inc(threadvarblocksize,size);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Done WasiInitThreadVar. Total size: '+IntToStr(threadvarblocksize));{$ENDIF}
+end;
+
+
+procedure WasiAllocateThreadVars;
+
+var
+  tlsMemBlock : pointer;
+  tlsBlockSize : Integer;
+  P : POSMemBlock;
+
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiAllocateThreadVars');{$ENDIF}
+  tlsBlockSize:=fpc_wasm32_tls_size;
+  if threadvarblocksize<>tlsBlocksize then
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Warning : block sizes differ: (linker) '+IntToStr(tlsBlocksize)+'<>'+IntToStr(threadvarblocksize)+' (calculated) !');{$ENDIF}
+  P:=GetFreeOSBlock;
+  FillChar((P^.Data)^.TLSMemory,tlsBlockSize,0);
+  fpc_wasm32_init_tls(@((P^.Data)^.TLSMemory));
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Done WasiAllocateThreadVars');{$ENDIF}
+end;
+
+Function GetTLSMemory : Pointer;
+
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('GetTLSMemory Enter');{$ENDIF}
+  GetTLSMemory:=fpc_wasm32_tls_base();
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('GetTLSMemory exit: '+InttoStr(PtrUint(fpc_wasm32_tls_base())));{$ENDIF}
+end;
+
+procedure WasiReleaseThreadVars;
+
+Var
+  PTLS : PTLSMem;
+
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiReleaseThreadVars');{$ENDIF}
+  PTLS:=GetTLSMemory-Sizeof(Pointer);
+  ReleaseOSBlock(PTLS^.OSMemBlock);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiReleaseThreadVars done');{$ENDIF}
+end;
+
+procedure HookThread;
+{ Set up externally created thread }
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('HookThread');{$ENDIF}
+  WasiAllocateThreadVars;
+  InitThread(1000000000);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('HookThread done');{$ENDIF}
+end;
+
+function WasiRelocateThreadVar(offset : dword) : pointer;
+var
+  P : Pointer;
+
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRelocateThreadVar ('+IntToStr(offset)+')');{$ENDIF}
+  P:=GetTLSMemory;
+  if (P=Nil) then
+    begin
+    HookThread;
+    P:=GetTLSMemory;
+    end;
+  WasiRelocateThreadvar:=P+Offset;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRelocateThreadVar done. Result: '+IntToStr(PtrUint(P+Offset)));{$ENDIF}
+end;
+
+{ ----------------------------------------------------------------------
+  Basic event
+  ----------------------------------------------------------------------}
+
+
+
+function WasiBasicEventCreate(EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
 begin
   {todo:implement}
 end;
 
-procedure WasiRTLEventSetEvent(AEvent:PRTLEvent);
+procedure WasiBasicEventDestroy(state:peventstate);
 begin
   {todo:implement}
 end;
 
-procedure WasiRTLEventResetEvent(AEvent:PRTLEvent);
+procedure WasiBasicEventResetEvent(state:peventstate);
 begin
   {todo:implement}
 end;
 
-procedure WasiRTLEventWaitFor(AEvent:PRTLEvent);
+procedure WasiBasicEventSetEvent(state:peventstate);
 begin
   {todo:implement}
 end;
 
-procedure WasiRTLEventWaitForTimeout(AEvent:PRTLEvent;timeout : longint);
+function WasiBasicEventWaitFor(timeout:cardinal;state:peventstate;FUseComWait : Boolean=False):longint;
 begin
   {todo:implement}
 end;
 
+
 procedure InitSystemThreads;public name '_FPC_InitSystemThreads';
 begin
   with WasiThreadManager do

rtl/wasi/tthread.inc

@@ -18,6 +18,7 @@
 procedure TThread.CallOnTerminate;
 
 begin
+  FOnTerminate(self);
 end;
 
 
@@ -31,50 +32,190 @@ end;
 procedure TThread.SetPriority(Value: TThreadPriority);
 
 begin
+  // Not supported
 end;
 
 
 procedure TThread.SetSuspended(Value: Boolean);
 
 begin
+  if Value <> FSuspended then
+    if Value then
+      Suspend
+    else
+      Resume;
 end;
 
 
 procedure TThread.DoTerminate;
 
 begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
 end;
 
 
+function ThreadFunc(parameter: Pointer): ptrint;
+
+Var
+  LThread : TThread Absolute parameter;
+  LFreeOnTerminate : Boolean;
+
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('In threadfunc. Thread object: '+IntToStr(PTrUint(LThread)));{$ENDIF}
+  try
+    if LThread.FInitialSuspended then
+      begin
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('thread '+IntToStr(ptruint(LThread))+' waiting for RTLEvent '+IntToStr(ptruint(LThread.FSuspendEvent)));{$ENDIF}
+      RtlEventWaitFor(LThread.FSuspendEvent);
+      if (LThread.FTerminated) then
+        {$IFDEF DEBUGWASMTHREADS}DebugWriteln('initially created suspended, but already terminated'){$ENDIF}
+      else if LThread.FSuspended then
+        {$IFDEF DEBUGWASMTHREADS}DebugWriteln('thread '+IntToStr(PtrUint(LThread))+' initially created suspended, resumed, but still suspended?!'){$ENDIF}
+      else
+        begin
+        LThread.FInitialSuspended := false;
+        CurrentThreadVar := LThread;
+        {$IFDEF DEBUGWASMTHREADS}DebugWriteln('going into LThread.Execute (1)');{$ENDIF}
+        LThread.Execute;
+        end
+      end
+    else
+      begin
+      // The suspend internal is needed due to bug 16884
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Suspending internally');{$ENDIF}
+      LThread.FSuspendedInternal:=True;
+      RtlEventWaitFor(LThread.FSuspendEvent);
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Internal suspend done.');{$ENDIF}
+      CurrentThreadVar := LThread;
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('going into LThread.Execute (2)');{$ENDIF}
+      LThread.Execute;
+      end;
+  except
+    on e: exception do
+      begin
+      LThread.FFatalException := TObject(AcquireExceptionObject);
+      if e is EThreadDestroyCalled then
+        LThread.FFreeOnTerminate := true;
+      end;
+  end;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('thread done running');{$ENDIF}
+  Result := LThread.FReturnValue;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Result is '+IntToStr(Result));{$ENDIF}
+  LFreeOnTerminate := LThread.FreeOnTerminate;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Calling doterminate');{$ENDIF}
+  LThread.DoTerminate;
+  LThread.FFinished := True;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Thread Set to finished');{$ENDIF}
+  if LFreeOnTerminate then
+    begin
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Thread '+IntToStr(ptruint(lthread))+' should be freed');{$ENDIF}
+      LThread.Free;
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Thread freed');{$ENDIF}
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Thread func calling EndThread');{$ENDIF}
+      EndThread(Result);
+    end;
+end;
+
 procedure TThread.SysCreate(CreateSuspended: Boolean; const StackSize: SizeUInt);
 
 begin
- {IsMultiThread := TRUE; }
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('In TThread.SysCreate');{$ENDIF}
+  FSuspendEvent := RtlEventCreate;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysCreate: Created suspend event');{$ENDIF}
+  FSuspended := CreateSuspended;
+  FThreadReaped := false;
+  FInitialSuspended := CreateSuspended;
+  FSuspendedInternal := not CreateSuspended;
+  FFatalException := nil;
+  FHandle:=BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
+  if FHandle = TThreadID(0) then
+    begin
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysCreate: Failed to create thread');{$ENDIF}
+    raise EThread.create('Failed to create new thread');
+    end;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysCreate: thread created');{$ENDIF}
 end;
 
 
 procedure TThread.SysDestroy;
 
 begin
+  { exception in constructor }
+  if not assigned(FSuspendEvent) then
+    exit;
+  { exception in constructor }
+  if (FHandle = TThreadID(0)) then
+    begin
+    RtlEventDestroy(FSuspendEvent);
+    exit;
+    end;
+  { Thread itself called destroy ? }
+  if (FThreadID = GetCurrentThreadID) then
+    begin
+    if not(FFreeOnTerminate) and not FFinished then
+       raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+    FFreeOnTerminate := false;
+    end
+  else
+    begin
+    { avoid recursion}
+    FFreeOnTerminate := false;
+    { you can't join yourself, so only for FThreadID<>GetCurrentThreadID }
+    { and you can't join twice -> make sure we didn't join already       }
+    if not FThreadReaped then
+      begin
+      Terminate;
+      if (FSuspendedInternal or FInitialSuspended) then
+        Resume;
+      WaitFor;
+      end;
+    end;
+   RtlEventDestroy(FSuspendEvent);
+   FFatalException.Free;
+   FFatalException := nil;
 end;
 
 
 procedure TThread.Resume;
 
 begin
+  if FSuspendedInternal and (InterLockedExchange(longint(FSuspendedInternal),ord(false)) = longint(longbool(true))) then
+    begin
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming thread after TThread construction '+IntToStr(ptruint(self)));{$ENDIF}
+    RtlEventSetEvent(FSuspendEvent);
+    end
+  else
+    begin
+    { don't compare with ord(true) or ord(longbool(true)), }
+    { becaue a longbool's "true" value is anyting <> false }
+    if FSuspended and
+       (InterLockedExchange(longint(FSuspended),longint(false)) <> longint(longbool(false))) then
+      begin
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming '+IntToStr(ptruint(self)));{$ENDIF}
+      RtlEventSetEvent(FSuspendEvent);
+      end
+    end
 end;
 
 
 procedure TThread.Suspend;
 
 begin
+  if FThreadID<>GetCurrentThreadID then
+    Raise EThread.create('Suspending one thread from inside another one is unsupported (because it is unsafe and deadlock prone) by *nix and posix operating systems');
+  { don't compare with ord(true) or ord(longbool(true)), }
+  { becaue a longbool's "true" value is anyting <> false }
+  if not FSuspended and
+     (InterLockedExchange(longint(FSuspended),longint(longbool(true))) = longint(longbool(false))) then
+     RtlEventWaitFor(FSuspendEvent)
 end;
 
 
 function TThread.WaitFor: Integer;
 
 begin
-  WaitFor:=0;
+  WaitFor:=WaitForThreadTerminate(FThreadID,0);
 end;
 
 

rtl/wasm32/wasm32.inc

@@ -1,3 +1,4 @@
+{%MainUnit system.pp}
 {
 
     This file is part of the Free Pascal run time library.