Browse Source

+ WebAssembly threads: initial implementation of the WASI threads proposal:

    https://github.com/WebAssembly/wasi-threads

  Note that the WASI folk have already declared this proposal 'obsolete' and
  only intended to be used for engines that support WASI v0.1. On the other
  hand, the WASI v0.2 threads proposal is an early draft and not implemented
  anywhere, so we have no choice, but to stay with v0.1 at this time, or give up
  on multithreading for who knows how long it would take for the v0.2 spec to be
  completed.

  Regarding the WASI v0.1 engines that implement WASI threads correctly and can
  be used with Free Pascal, I've discovered only one that works:

    https://github.com/bytecodealliance/wasm-micro-runtime/tree/main

  Wasmtime claims to support multithreading since version 15, however it doesn't
  seem to work. I tested all versions until the 23.0.1, and none of them works.

  Caveat: using the internal linker is not yet supported with WebAssembly and
  multithreading. Please use the external linker (the -Xe option), if you want
  to give this new feature a try.
Nikolay Nikolov 1 year ago
parent
commit
31bb06ac87
1 changed files with 103 additions and 31 deletions
  1. 103 31
      rtl/wasi/systhrd.inc

+ 103 - 31
rtl/wasi/systhrd.inc

@@ -19,7 +19,10 @@
   {$fatal This file shouldn't be included if thread support is disabled!}
 {$endif FPC_WASM_THREADS}
 
-{$DEFINE DEBUGWASMTHREADS}
+{$DEFINE FPC_WASM_MAIN_THREAD_CAN_WAIT}
+{$UNDEF FPC_WASM_WORKER_THREADS_CAN_WAIT}
+
+{//$DEFINE DEBUGWASMTHREADS}
 
 Const
   MaxThreadSignal = 1000; // maximum threads to signal
@@ -46,11 +49,17 @@ Type
 
   PWasmThread = ^TWasmThread;
   TWasmThread = Record
-    ID : LongInt; // Allocated by host javascript code
+    InitialStackPointer : Pointer;
+    InitTLSBase : Pointer;
+    ID : LongInt; // Allocated by host
+    ThreadFunction : TThreadFunc;
+    ThreadFunctionArg : Pointer;
     State : TThreadState;
     DoneEvent : PWasmRTLEvent;
     Running : TWasmMutex;
     ExitCode : Cardinal;
+    StackBlock : Pointer;
+    TLSBlock : Pointer;
     ThreadName : Array of byte; // UTF8 name
   end;
 
@@ -101,11 +110,23 @@ end;
 
 function WasiInitManager: Boolean;
 begin
-  DebugWriteln('Initializing manager');
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Initializing manager');{$ENDIF}
+  FillChar(MainThread,SizeOf(MainThread),0);
+  MainThread.State:=tsRunning;
+  GlobalIsMainThread:=1;
+  GlobalIsWorkerThread:=0;
+  GlobalCurrentThread:=@MainThread;
+{$IFDEF FPC_WASM_MAIN_THREAD_CAN_WAIT}
+  GlobalIsThreadBlockable:=1;
+{$ELSE FPC_WASM_MAIN_THREAD_CAN_WAIT}
+  GlobalIsThreadBlockable:=0;
+{$ENDIF FPC_WASM_MAIN_THREAD_CAN_WAIT}
   if TLSInfoBlock=Nil then
     TLSInfoBlock:=AllocateOSInfoBlock;
+{$IFDEF DEBUGWASMTHREADS}
   if TLSInfoBlock = Nil then
     DebugWriteln('Initializing manager done: failed');
+{$ENDIF}
   WasiInitManager:=True;
 end;
 
@@ -239,7 +260,8 @@ begin
     IsTimeOut:=(aTimeoutNs>=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}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiRTLEventWaitFor_WaitNotAllowed : done waiting (isTimeout='+intToStr(Ord(isTimeOut))+',IsDone='+intToStr(Ord(IsDone))+
+                                        ',Signal='+IntToStr(aEvent^.Signal)+',Destroying='+IntToStr(Ord(aEvent^.Destroying))+')');{$ENDIF}
 end;
 
 procedure WasiRTLEventWaitFor(AEvent:PRTLEvent);
@@ -276,45 +298,85 @@ end;
   ----------------------------------------------------------------------}
 
 
-procedure FPCWasmThreadSetStackPointer(Address: Pointer); [public, alias: 'FPC_WASM_THREAD_SET_STACK_POINTER'];
-begin
-  fpc_wasm32_set_base_pointer(Address);
-end;
+//procedure FPCWasmThreadSetStackPointer(Address: Pointer); [public, alias: 'FPC_WASM_THREAD_SET_STACK_POINTER'];
+//begin
+//  fpc_wasm32_set_base_pointer(Address);
+//end;
 
 // 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
-  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadInit('+IntToStr(IsWorkerThread)+','+IntToStr(IsMainThread)+','+IntToStr(CanBlock)+')');{$ENDIF}
-  GlobalIsWorkerThread:=IsWorkerThread;
-  GlobalIsMainThread:=IsMainThread;
-  GlobalIsThreadBlockable:=CanBlock;
-  Result:=0;
-end;
+//Function FPCWasmThreadInit(IsWorkerThread : Longint; IsMainThread : Longint; CanBlock : Longint) : Longint; [public, alias: 'FPC_WASM_THREAD_INIT'];
+//
+//begin
+//  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadInit('+IntToStr(IsWorkerThread)+','+IntToStr(IsMainThread)+','+IntToStr(CanBlock)+')');{$ENDIF}
+//  GlobalIsWorkerThread:=IsWorkerThread;
+//  GlobalIsMainThread:=IsMainThread;
+//  GlobalIsThreadBlockable:=CanBlock;
+//  Result:=0;
+//end;
 
 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
-  {$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}
+//Function FPCWasmThreadEntry(ThreadID : PWasmThread; RunFunction : Pointer; Args : Pointer) : Longint; [public, alias: 'FPC_WASM_THREAD_ENTRY'];
+//begin
+//  {$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 FPCWasmThreadStartPascal(tid: longint; start_arg: PWasmThread);
+begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadStartPascal(...)');{$ENDIF}
+  start_arg^.ID:=tid;
+  GlobalCurrentThread:=@start_arg;
+  GlobalIsMainThread:=0;
+  GlobalIsWorkerThread:=1;
+{$IFDEF FPC_WASM_WORKER_THREADS_CAN_WAIT}
+  GlobalIsThreadBlockable:=1;
+{$ELSE FPC_WASM_WORKER_THREADS_CAN_WAIT}
+  GlobalIsThreadBlockable:=0;
+{$ENDIF FPC_WASM_WORKER_THREADS_CAN_WAIT}
+
+  start_arg^.State:=tsRunning;
   InitThread;
-  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadEntry: calling thread function '+intToStr(PtrUint(RunFunction)));{$ENDIF}
-  Result:=tthreadfunc(RunFunction)(args);
+  start_arg^.ExitCode:=Cardinal(start_arg^.ThreadFunction(start_arg^.ThreadFunctionArg));
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadStartPascal: Signaling end of thread');{$ENDIF}
+  WasiRTLEventSetEvent(start_arg^.DoneEvent);
 end;
 
-exports FPCWasmThreadSetStackPointer, FPCWasmThreadInit, FPCWasmThreadEntry;
+procedure wasi_thread_start(tid: longint; start_arg: PWasmThread); assembler; nostackframe;
+asm
+  local.get 1
+  i32.load
+  global.set $__stack_pointer
 
-Function thread_spawn(thread_id : PInteger; attrs: Pointer; thread_start_func : Pointer; args : Pointer) : LongInt;  external 'FPCThreading' name 'thread_spawn';
+  local.get 1
+  i32.const 4
+  i32.add
+  i32.load
+  global.set $__tls_base
+
+  local.get 0
+  local.get 1
+  call $FPCWasmThreadStartPascal
+end;
+
+exports wasi_thread_start;
+
+Function wasi_thread_spawn(start_arg: PWasmThread) : LongInt; external 'wasi' name 'thread-spawn';
 
 function WasiBeginThread(sa : Pointer;stacksize : PtrUInt; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : TThreadID;
 
+Const
+  DefaultStackSize=1024*1024;
+  HeapAlignment=16;
 Var
   T : PWasmThread;
 
@@ -323,10 +385,20 @@ begin
   T:=GetMem(SizeOf(TWasmThread));
   ThreadID:=T;
   {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread thread ID : '+IntToStr(PtrUint(ThreadID)));{$ENDIF}
+  T^.ThreadFunction:=ThreadFunction;
+  T^.ThreadFunctionArg:=p;
+  if stacksize<=0 then
+    stacksize:=DefaultStackSize;
+  T^.StackBlock:=GetMem(stacksize);
+  T^.InitialStackPointer:=Pointer(PtrUInt(PtrUInt(T^.StackBlock)+stacksize) and $FFFFFFF0);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: InitialStackPointer='+IntToStr(PtrUint(T^.InitialStackPointer)));{$ENDIF}
+  T^.TLSBlock:=AllocMem(fpc_wasm32_tls_size+fpc_wasm32_tls_align-1);
+  T^.InitTLSBase:=Align(T^.TLSBlock,fpc_wasm32_tls_align);
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: InitTLSBase='+IntToStr(PtrUint(T^.InitTLSBase)));{$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
+  if wasi_thread_spawn(T)>0 then
     begin
     {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WasiBeginThread: spawn thread OK, setting result');{$ENDIF}
     WasiBeginThread:=T;
@@ -387,7 +459,7 @@ end;
 function WasiWaitForThreadTerminate(threadHandle : TThreadID; TimeoutMs : longint) : dword;
 
 Var
-  Res : Integer;
+  Res : LongInt;
   TH : PWasmThread absolute ThreadHandle;
   TimeoutNs : Int64;
 
@@ -400,7 +472,7 @@ begin
   WasiRTLEventWaitFor(TH^.DoneEvent);
   {$IFDEF DEBUGWASMTHREADS}DebugWriteln('WaitForThreadTerminate('+IntToStr(PtrUINT(TH))+') : Event set, waiting for lock');{$ENDIF}
   Case LockMuTexTimeout(PWasmThread(ThreadHandle)^.Running,TimeoutNs) of
-    lmrOK : Res:=0;
+    lmrOK : Res:=LongInt(TH^.ExitCode);
     lmrError : Res:=-2;
   else
      Res:=-1;