paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* anonymous method overloads for synchronize/queue.

Browse Source
This commit is contained in:
marcoonthegit 2022-06-01 13:54:06 +02:00
parent d38c881828
commit e5ac0b2689
26 changed files with 201 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/amicommon/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/atari/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/beos/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/embedded/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
unit Classes;

3
rtl/freertos/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
unit Classes;

3
rtl/gba/classes.pp
View File

@ -15,6 +15,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
unit Classes;

4
rtl/go32v2/classes.pp
View File

@ -14,6 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/haiku/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

4
rtl/macos/classes.pp
View File

@ -14,6 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/msdos/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/nativent/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/nds/classes.pp
View File

@ -15,6 +15,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
unit Classes;

3
rtl/netware/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/netwlibc/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

102
rtl/objpas/classes/classes.inc
View File

@ -305,9 +305,11 @@ procedure ExecuteThreadQueueEntry(aEntry: TThread.PThreadQueueEntry);
begin
if Assigned(aEntry^.Method) then
aEntry^.Method()
// enable once closures are supported
{else
aEntry^.ThreadProc();}
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
else
if Assigned(aEntry^.ThreadProc) then
aEntry^.ThreadProc
{$endif}
end;
@ -448,11 +450,74 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class procedure TThread.Synchronize(AThread: TThread; AProcedure: TThreadProcedure);
var
syncentry: PThreadQueueEntry;
thread: TThread;
begin
{$ifdef FPC_HAS_FEATURE_THREADING}
if Assigned(AThread) and (AThread.ThreadID = GetCurrentThreadID) then
{$else}
if Assigned(AThread) then
{$endif}
thread := AThread
else if Assigned(CurrentThreadVar) then
thread := CurrentThreadVar
else begin
thread := Nil;
{ use a local synchronize event }
New(syncentry);
FillChar(syncentry^, SizeOf(TThreadQueueEntry), 0);
{$ifdef FPC_HAS_FEATURE_THREADING}
syncentry^.ThreadID := GetCurrentThreadID;
syncentry^.SyncEvent := RtlEventCreate;
{$else}
syncentry^.ThreadID := 0{GetCurrentThreadID};
syncentry^.SyncEvent := nil{RtlEventCreate};
{$endif}
end;
if Assigned(thread) then begin
{ the Synchronize event is instantiated on demand }
thread.InitSynchronizeEvent;
syncentry := thread.FSynchronizeEntry;
end;
syncentry^.Exception := Nil;
syncentry^.ThreadProc := AProcedure;
try
ThreadQueueAppend(syncentry, False);
finally
syncentry^.ThreadProc := Nil;
syncentry^.Next := Nil;
if not Assigned(thread) then begin
{ clean up again }
{$ifdef FPC_HAS_FEATURE_THREADING}
RtlEventDestroy(syncentry^.SyncEvent);
{$endif}
Dispose(syncentry);
end;
end;
end;
{$endif}
procedure TThread.Synchronize(AMethod: TThreadMethod);
begin
TThread.Synchronize(self,AMethod);
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
procedure TThread.Synchronize(AProcedure: TThreadProcedure);
begin
TThread.Synchronize(self,AProcedure);
end;
{$endif}
Function PopThreadQueueHead : TThread.PThreadQueueEntry;
begin
@ -550,12 +615,24 @@ begin
Queue(Self, aMethod);
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
procedure TThread.Queue(aProcedure: TThreadProcedure);
begin
Queue(Self, aProcedure);
end;
{$endif}
class procedure TThread.Queue(aThread: TThread; aMethod: TThreadMethod); static;
begin
InternalQueue(aThread, aMethod, False);
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class procedure TThread.Queue(aThread: TThread; aProcedure: TThreadProcedure); static;
begin
InternalQueue(aThread, aProcedure, False);
end;
{$endif}
class procedure TThread.InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
var
@ -575,6 +652,25 @@ begin
ThreadQueueAppend(queueentry, aQueueIfMain);
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class procedure TThread.InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean); static;
var
queueentry: PThreadQueueEntry;
begin
New(queueentry);
FillChar(queueentry^, SizeOf(TThreadQueueEntry), 0);
queueentry^.Thread := aThread;
{$ifdef FPC_HAS_FEATURE_THREADING}
queueentry^.ThreadID := GetCurrentThreadID;
{$else}
queueentry^.ThreadID := 0{GetCurrentThreadID};
{$endif}
queueentry^.ThreadProc := aProcedure;
{ the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) }
ThreadQueueAppend(queueentry, aQueueIfMain);
end;
{$endif}
procedure TThread.ForceQueue(aMethod: TThreadMethod);
begin

23
rtl/objpas/classes/classesh.inc
View File

@ -1848,6 +1848,9 @@ type
EThreadDestroyCalled = class(EThread);
TSynchronizeProcVar = procedure;
TThreadMethod = procedure of object;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
TThreadProcedure = reference to procedure;
{$endif}
TThreadReportStatus = Procedure(Const status : String) of Object;
@ -1870,8 +1873,9 @@ type
PThreadQueueEntry = ^TThreadQueueEntry;
TThreadQueueEntry = record
Method: TThreadMethod;
// uncomment once closures are supported
//ThreadProc: TThreadProcedure;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
ThreadProc: TThreadProcedure;
{$endif}
Thread: TThread;
ThreadID: TThreadID;
Exception: TObject;
@ -1901,6 +1905,9 @@ type
class function GetCurrentThread: TThread; static;
class function GetIsSingleProcessor: Boolean; static; inline;
class procedure InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class procedure InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean); static;
{$endif}
procedure CallOnTerminate;
function GetPriority: TThreadPriority;
procedure SetPriority(Value: TThreadPriority);
@ -1918,7 +1925,13 @@ type
procedure TerminatedSet; virtual;
procedure Execute; virtual; abstract;
procedure Synchronize(AMethod: TThreadMethod);
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
procedure Synchronize(AProcedure : TThreadProcedure);
{$endif}
procedure Queue(aMethod: TThreadMethod);
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
procedure Queue(aProcedure: TThreadProcedure);
{$endif}
procedure ForceQueue(aMethod: TThreadMethod); inline;
property ReturnValue: Integer read FReturnValue write FReturnValue;
property Terminated: Boolean read FTerminated;
@ -1961,7 +1974,13 @@ type
class procedure SetReturnValue(aValue: Integer); static;
class function CheckTerminated: Boolean; static;
class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod);
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class procedure Synchronize(AThread: TThread; AProcedure : TThreadProcedure);
{$endif}
class procedure Queue(aThread: TThread; aMethod: TThreadMethod); static;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class procedure Queue(aThread: TThread; AProcedure : TThreadProcedure); static;
{$endif}
class procedure ForceQueue(aThread: TThread; aMethod: TThreadMethod); inline; static;
class procedure RemoveQueuedEvents(aThread: TThread; aMethod: TThreadMethod); static;
class procedure RemoveQueuedEvents(aMethod: TThreadMethod); static;

3
rtl/os2/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/sinclairql/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/symbian/classes.pp
View File

@ -14,6 +14,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
unit Classes;

4
rtl/unix/classes.pp
View File

@ -14,6 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$IF FPC_FULLVERSION>=30301}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

4
rtl/wasi/classes.pp
View File

@ -14,6 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

3
rtl/wii/classes.pp
View File

@ -15,6 +15,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
unit Classes;

4
rtl/win16/classes.pp
View File

@ -14,6 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

5
rtl/win32/classes.pp
View File

@ -15,6 +15,11 @@
{$mode objfpc}
{$IF FPC_FULLVERSION>=30301}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}

4
rtl/win64/classes.pp
View File

@ -14,6 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$IF FPC_FULLVERSION>=30301}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{ $define Win16Res}

4
rtl/wince/classes.pp
View File

@ -14,6 +14,10 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch FUNCTIONREFERENCES}
{$define FPC_HAS_REFERENCE_PROCEDURE}
{$endif}
{ determine the type of the resource/form file }
{$define Win16Res}