From e3139fea211474f8b31ac880c259ae68b8278c6f Mon Sep 17 00:00:00 2001
From: Nikolay Nikolov <nickysn@gmail.com>
Date: Thu, 14 Jul 2022 05:14:20 +0300
Subject: [PATCH] + setup a thread manager (functions are still not yet
 implemented), when the WASI RTL is compiled with multithreading support

---
 rtl/wasi/system.pp    |   6 +-
 rtl/wasi/systhrd.inc  | 243 ++++++++++++++++++++++++++++++++++++++++++
 rtl/wasm32/wasm32.inc |   4 +
 3 files changed, 252 insertions(+), 1 deletion(-)
 create mode 100644 rtl/wasi/systhrd.inc

diff --git a/rtl/wasi/system.pp b/rtl/wasi/system.pp
index 75cd3cf19a..07c2434b3b 100644
--- a/rtl/wasi/system.pp
+++ b/rtl/wasi/system.pp
@@ -18,7 +18,11 @@ unit system;
 interface
 
 {$define FPC_IS_SYSTEM}
-{$define USE_NOTHREADMANAGER}
+{$ifdef FPC_WASM_THREADS}
+  {$define DISABLE_NO_THREAD_MANAGER}
+{$else FPC_WASM_THREADS}
+  {$define USE_NOTHREADMANAGER}
+{$endif FPC_WASM_THREADS}
 
 {$I systemh.inc}
 
diff --git a/rtl/wasi/systhrd.inc b/rtl/wasi/systhrd.inc
new file mode 100644
index 0000000000..b558c22e67
--- /dev/null
+++ b/rtl/wasi/systhrd.inc
@@ -0,0 +1,243 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2022 by Nikolay Nikolov,
+    member of the Free Pascal development team.
+
+    WASI 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.
+
+ **********************************************************************}
+
+{$ifndef FPC_WASM_THREADS}
+  {$fatal This file shouldn't be included if thread support is disabled!}
+{$endif FPC_WASM_THREADS}
+
+var
+  WasiThreadManager : TThreadManager;
+
+function WasiInitManager: Boolean;
+begin
+  Result:=True;
+end;
+
+function WasiDoneManager: Boolean;
+begin
+  Result:=True;
+end;
+
+function WasiBeginThread(sa : Pointer;stacksize : PtrUInt; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : TThreadID;
+begin
+  {todo:implement}
+end;
+
+procedure WasiEndThread(ExitCode : DWord);
+begin
+  {todo:implement}
+end;
+
+function WasiSuspendThread(threadHandle : TThreadID) : dword;
+begin
+  {todo:implement}
+end;
+
+function WasiResumeThread(threadHandle : TThreadID) : dword;
+begin
+  {todo:implement}
+end;
+
+function WasiKillThread(threadHandle : TThreadID) : dword;
+begin
+  {todo:implement}
+end;
+
+function WasiCloseThread(threadHandle : TThreadID) : dword;
+begin
+  {todo:implement}
+end;
+
+procedure WasiThreadSwitch;
+begin
+  {todo:implement}
+end;
+
+function WasiWaitForThreadTerminate(threadHandle : TThreadID; TimeoutMs : longint) : dword;
+begin
+  {todo:implement}
+end;
+
+function WasiThreadSetPriority(threadHandle : TThreadID; Prio: longint): boolean;
+begin
+  {todo:implement}
+end;
+
+function WasiThreadGetPriority(threadHandle : TThreadID): longint;
+begin
+  {todo:implement}
+end;
+
+function WasiGetCurrentThreadId : TThreadID;
+begin
+  {todo:implement}
+end;
+
+procedure WasiThreadSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString);
+begin
+  {todo:implement}
+end;
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+procedure WasiThreadSetThreadDebugNameU(threadHandle: TThreadID; const ThreadName: UnicodeString);
+begin
+  {todo:implement}
+end;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+
+procedure WasiInitCriticalSection(var cs);
+begin
+  {todo:implement}
+end;
+
+procedure WasiDoneCriticalSection(var cs);
+begin
+  {todo:implement}
+end;
+
+procedure WasiEnterCriticalSection(var cs);
+begin
+  {todo:implement}
+end;
+
+function WasiCriticalSectionTryEnter(var cs):longint;
+begin
+  {todo:implement}
+end;
+
+procedure WasiLeaveCriticalSection(var cs);
+begin
+  {todo:implement}
+end;
+
+procedure WasiInitThreadVar(var offset : dword;size : dword);
+begin
+  {todo:implement}
+end;
+
+function WasiRelocateThreadVar(offset : dword) : pointer;
+begin
+  {todo:implement}
+end;
+
+procedure WasiAllocateThreadVars;
+begin
+  {todo:implement}
+end;
+
+procedure WasiReleaseThreadVars;
+begin
+  {todo:implement}
+end;
+
+function WasiBasicEventCreate(EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
+begin
+  {todo:implement}
+end;
+
+procedure WasiBasicEventDestroy(state:peventstate);
+begin
+  {todo:implement}
+end;
+
+procedure WasiBasicEventResetEvent(state:peventstate);
+begin
+  {todo:implement}
+end;
+
+procedure WasiBasicEventSetEvent(state:peventstate);
+begin
+  {todo:implement}
+end;
+
+function WasiBasicEventWaitFor(timeout:cardinal;state:peventstate):longint;
+begin
+  {todo:implement}
+end;
+
+function WasiRTLCreateEvent:PRTLEvent;
+begin
+  {todo:implement}
+end;
+
+procedure WasiRTLEventDestroy(AEvent:PRTLEvent);
+begin
+  {todo:implement}
+end;
+
+procedure WasiRTLEventSetEvent(AEvent:PRTLEvent);
+begin
+  {todo:implement}
+end;
+
+procedure WasiRTLEventResetEvent(AEvent:PRTLEvent);
+begin
+  {todo:implement}
+end;
+
+procedure WasiRTLEventWaitFor(AEvent:PRTLEvent);
+begin
+  {todo:implement}
+end;
+
+procedure WasiRTLEventWaitForTimeout(AEvent:PRTLEvent;timeout : longint);
+begin
+  {todo:implement}
+end;
+
+procedure InitSystemThreads;public name '_FPC_InitSystemThreads';
+begin
+  with WasiThreadManager do
+    begin
+      InitManager            := @WasiInitManager;
+      DoneManager            := @WasiDoneManager;
+      BeginThread            := @WasiBeginThread;
+      EndThread              := @WasiEndThread;
+      SuspendThread          := @WasiSuspendThread;
+      ResumeThread           := @WasiResumeThread;
+      KillThread             := @WasiKillThread;
+      CloseThread            := @WasiCloseThread;
+      ThreadSwitch           := @WasiThreadSwitch;
+      WaitForThreadTerminate := @WasiWaitForThreadTerminate;
+      ThreadSetPriority      := @WasiThreadSetPriority;
+      ThreadGetPriority      := @WasiThreadGetPriority;
+      GetCurrentThreadId     := @WasiGetCurrentThreadId;
+      SetThreadDebugNameA    := @WasiThreadSetThreadDebugNameA;
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+      SetThreadDebugNameU    := @WasiThreadSetThreadDebugNameU;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+      InitCriticalSection    := @WasiInitCriticalSection;
+      DoneCriticalSection    := @WasiDoneCriticalSection;
+      EnterCriticalSection   := @WasiEnterCriticalSection;
+      TryEnterCriticalSection:= @WasiCriticalSectionTryEnter;
+      LeaveCriticalSection   := @WasiLeaveCriticalSection;
+      InitThreadVar          := @WasiInitThreadVar;
+      RelocateThreadVar      := @WasiRelocateThreadVar;
+      AllocateThreadVars     := @WasiAllocateThreadVars;
+      ReleaseThreadVars      := @WasiReleaseThreadVars;
+      BasicEventCreate       := @WasiBasicEventCreate;
+      BasicEventDestroy      := @WasiBasicEventDestroy;
+      BasicEventResetEvent   := @WasiBasicEventResetEvent;
+      BasicEventSetEvent     := @WasiBasicEventSetEvent;
+      BasiceventWaitFOr      := @WasiBasicEventWaitFor;
+      RTLEventCreate         := @WasiRTLCreateEvent;
+      RTLEventDestroy        := @WasiRTLEventDestroy;
+      RTLEventSetEvent       := @WasiRTLEventSetEvent;
+      RTLEventResetEvent     := @WasiRTLEventResetEvent;
+      RTLEventWaitFor        := @WasiRTLEventWaitFor;
+      RTLEventWaitForTimeout := @WasiRTLEventWaitForTimeout;
+    end;
+  SetThreadManager(WasiThreadManager);
+end;
diff --git a/rtl/wasm32/wasm32.inc b/rtl/wasm32/wasm32.inc
index 97e4e9222a..cfa7d400f9 100644
--- a/rtl/wasm32/wasm32.inc
+++ b/rtl/wasm32/wasm32.inc
@@ -15,6 +15,10 @@
 
  **********************************************************************}
 
+{$ifdef FPC_WASM_THREADS}
+procedure fpc_wasm32_init_tls(memory: Pointer);external name '__wasm_init_tls';
+{$endif FPC_WASM_THREADS}
+
 procedure fpc_cpuinit;
   begin
   end;