Skip to content

Commit

Permalink
Fix RunInMainThread/RunInThread. We need everything as cdecl.
Browse files Browse the repository at this point in the history
  • Loading branch information
ollydev committed Oct 15, 2023
1 parent cb547e3 commit 25af4be
Showing 1 changed file with 58 additions and 4 deletions.
62 changes: 58 additions & 4 deletions Source/script/imports/simba/simba.import_threading.pas
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,57 @@ procedure ImportThreading(Compiler: TSimbaScript_Compiler);
implementation

uses
lptypes, lpparser, ffi,
simba.threading;
lptypes, lpparser, ffi;

// All this is because we use cdecl on win32...
type
TScriptThreadMethod = procedure() of object; cdecl;

TSyncObject = object
FMethod: TScriptThreadMethod;

procedure Execute;
end;

TThreadObject = class(TThread)
protected
FMethod: TScriptThreadMethod;

procedure Execute; override;
public
constructor Create(Method: TScriptThreadMethod); reintroduce;
end;

procedure TThreadObject.Execute;
begin
try
if Assigned(FMethod) then
FMethod();
except
on E: Exception do
DebugLn('RunInThread exception: ' + E.Message);
end;
end;

constructor TThreadObject.Create(Method: TScriptThreadMethod);
begin
inherited Create(False, DefaultStackSize div 2);

FMethod := Method;

FreeOnTerminate := True;
end;

procedure TSyncObject.Execute;
begin
try
if Assigned(FMethod) then
FMethod();
except
on E: Exception do
DebugLn('RunOnMainThread exception: ' + E.Message);
end;
end;

procedure _LapeCurrentThreadID(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
begin
Expand All @@ -32,13 +81,18 @@ procedure _LapeMainThreadID(const Params: PParamArray; const Result: Pointer); L
end;

procedure _LapeRunInMainThread(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
var
{%H-}SyncObject: TSyncObject;
begin
RunInMainThread(TThreadMethod(Params^[0]^));
SyncObject := Default(TSyncObject);
SyncObject.FMethod := TScriptThreadMethod(Params^[0]^);

TThread.Synchronize(nil, @SyncObject.Execute);
end;

procedure _LapeRunInThread(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
RunInThread(TThreadMethod(Params^[0]^), True);
TThreadObject.Create(TScriptThreadMethod(Params^[0]^));
end;

procedure ImportThreading(Compiler: TSimbaScript_Compiler);
Expand Down

0 comments on commit 25af4be

Please sign in to comment.