mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:09:42 +02:00
+ classes.mainthreadid is set now
+ rtleventresetevent + rtleventwairfor with timeout + checksynchronize with timeout * race condition in synchronize fixed
This commit is contained in:
parent
7a4ced093f
commit
710dbcef0a
@ -238,6 +238,12 @@ begin
|
||||
currenttm.rtleventsetEvent(state);
|
||||
end;
|
||||
|
||||
procedure RTLeventResetEvent(state:pRTLEvent);
|
||||
|
||||
begin
|
||||
currenttm.rtleventResetEvent(state);
|
||||
end;
|
||||
|
||||
procedure RTLeventStartWait(state:pRTLEvent);
|
||||
|
||||
begin
|
||||
@ -250,6 +256,12 @@ begin
|
||||
currenttm.rtleventWaitFor(state);
|
||||
end;
|
||||
|
||||
procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
|
||||
|
||||
begin
|
||||
currenttm.rtleventWaitForTimeout(state,timeout);
|
||||
end;
|
||||
|
||||
procedure RTLeventsync(m:trtlmethod;p:tprocedure);
|
||||
|
||||
begin
|
||||
@ -319,7 +331,11 @@ end;
|
||||
|
||||
function NoGetCurrentThreadId : dword;
|
||||
begin
|
||||
NoThreadError;
|
||||
if IsMultiThread then
|
||||
NoThreadError
|
||||
else
|
||||
ThreadingAlreadyUsed:=true;
|
||||
result:=ThreadID;
|
||||
end;
|
||||
|
||||
procedure NoCriticalSection(var CS);
|
||||
@ -411,22 +427,27 @@ begin
|
||||
end;
|
||||
|
||||
procedure NORTLeventStartWait(state:pRTLEvent);
|
||||
|
||||
begin
|
||||
NoThreadError;
|
||||
end;
|
||||
begin
|
||||
NoThreadError;
|
||||
end;
|
||||
|
||||
|
||||
procedure NORTLeventWaitFor(state:pRTLEvent);
|
||||
begin
|
||||
NoThreadError;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
NoThreadError;
|
||||
end;
|
||||
procedure NORTLeventWaitForTimeout(state:pRTLEvent;timeout : longint);
|
||||
begin
|
||||
NoThreadError;
|
||||
end;
|
||||
|
||||
|
||||
procedure NORTLeventsync(m:trtlmethod;p:tprocedure);
|
||||
|
||||
begin
|
||||
NoThreadError;
|
||||
end;
|
||||
begin
|
||||
NoThreadError;
|
||||
end;
|
||||
|
||||
|
||||
Var
|
||||
@ -468,6 +489,7 @@ begin
|
||||
rtleventStartWait :=@NortleventStartWait;
|
||||
rtleventWaitFor :=@NortleventWaitFor;
|
||||
rtleventsync :=@Nortleventsync;
|
||||
rtleventwaitfortimeout :=@NortleventWaitForTimeout;
|
||||
end;
|
||||
SetThreadManager(NoThreadManager);
|
||||
end;
|
||||
@ -475,7 +497,14 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.25 2005-04-03 19:29:28 florian
|
||||
Revision 1.26 2005-04-09 17:26:08 florian
|
||||
+ classes.mainthreadid is set now
|
||||
+ rtleventresetevent
|
||||
+ rtleventwairfor with timeout
|
||||
+ checksynchronize with timeout
|
||||
* race condition in synchronize fixed
|
||||
|
||||
Revision 1.25 2005/04/03 19:29:28 florian
|
||||
* proper error message if the cthreads unit is included too late
|
||||
uses clause
|
||||
|
||||
|
@ -44,6 +44,7 @@ type
|
||||
TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
|
||||
TBasicEventCreateHandler = function (EventAttributes :Pointer; AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
|
||||
TRTLEventHandler = procedure(AEvent:PRTLEvent);
|
||||
TRTLEventHandlerTimeout = procedure(AEvent:PRTLEvent;timeout : longint);
|
||||
TRTLCreateEventHandler = function:PRTLEvent;
|
||||
TRTLEventSyncHandler = procedure (m:trtlmethod;p:tprocedure);
|
||||
|
||||
@ -77,9 +78,11 @@ type
|
||||
RTLEventCreate : TRTLCreateEventHandler;
|
||||
RTLEventDestroy : TRTLEventHandler;
|
||||
RTLEventSetEvent : TRTLEventHandler;
|
||||
RTLEventResetEvent : TRTLEventHandler;
|
||||
RTLEventStartWait : TRTLEventHandler;
|
||||
RTLEventWaitFor : TRTLEventHandler;
|
||||
RTLEventSync : TRTLEventSyncHandler;
|
||||
RTLEventWaitForTimeout : TRTLEventHandlerTimeout;
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
@ -144,13 +147,22 @@ function basiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
|
||||
function RTLEventCreate :PRTLEvent;
|
||||
procedure RTLeventdestroy(state:pRTLEvent);
|
||||
procedure RTLeventSetEvent(state:pRTLEvent);
|
||||
procedure RTLeventResetEvent(state:pRTLEvent);
|
||||
procedure RTLeventStartWait(state:pRTLEvent);
|
||||
procedure RTLeventWaitFor(state:pRTLEvent);
|
||||
procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
|
||||
procedure RTLeventsync(m:trtlmethod;p:tprocedure);
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.28 2005-02-25 22:02:48 florian
|
||||
Revision 1.29 2005-04-09 17:26:08 florian
|
||||
+ classes.mainthreadid is set now
|
||||
+ rtleventresetevent
|
||||
+ rtleventwairfor with timeout
|
||||
+ checksynchronize with timeout
|
||||
* race condition in synchronize fixed
|
||||
|
||||
Revision 1.28 2005/02/25 22:02:48 florian
|
||||
* another "transfer to linux"-commit
|
||||
|
||||
Revision 1.27 2005/02/14 17:13:29 peter
|
||||
|
@ -527,6 +527,13 @@ begin
|
||||
pthread_mutex_unlock(@p^.mutex);
|
||||
end;
|
||||
|
||||
|
||||
procedure intRTLEventResetEvent(AEvent: PRTLEvent);
|
||||
begin
|
||||
{ events before startwait are ignored unix }
|
||||
end;
|
||||
|
||||
|
||||
procedure intRTLEventStartWait(AEvent: PRTLEvent);
|
||||
var p:pintrtlevent;
|
||||
|
||||
@ -634,7 +641,14 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.25 2005-04-03 19:29:28 florian
|
||||
Revision 1.26 2005-04-09 17:26:08 florian
|
||||
+ classes.mainthreadid is set now
|
||||
+ rtleventresetevent
|
||||
+ rtleventwairfor with timeout
|
||||
+ checksynchronize with timeout
|
||||
* race condition in synchronize fixed
|
||||
|
||||
Revision 1.25 2005/04/03 19:29:28 florian
|
||||
* proper error message if the cthreads unit is included too late
|
||||
uses clause
|
||||
|
||||
|
@ -396,18 +396,30 @@ begin
|
||||
SetEvent(THANDLE(AEvent));
|
||||
end;
|
||||
|
||||
procedure intRTLEventResetEvent(AEvent: PRTLEvent);
|
||||
begin
|
||||
ResetEvent(THANDLE(AEvent));
|
||||
end;
|
||||
|
||||
procedure intRTLEventStartWait(AEvent: PRTLEvent);
|
||||
begin
|
||||
// nothing to do, win32 events stay signalled after being set
|
||||
{ this is to get at least some common behaviour on unix and win32:
|
||||
events before startwait are lost on unix, so reset the event on
|
||||
win32 as well }
|
||||
ResetEvent(THANDLE(AEvent));
|
||||
end;
|
||||
|
||||
procedure intRTLEventWaitFor(AEvent: PRTLEvent);
|
||||
CONST
|
||||
const
|
||||
INFINITE=-1;
|
||||
begin
|
||||
WaitForSingleObject(THANDLE(AEvent), INFINITE);
|
||||
end;
|
||||
|
||||
procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
|
||||
begin
|
||||
WaitForSingleObject(THANDLE(AEvent), timeout);
|
||||
end;
|
||||
|
||||
|
||||
Var
|
||||
@ -447,8 +459,10 @@ begin
|
||||
RTLEventCreate :=@intRTLEventCreate;
|
||||
RTLEventDestroy :=@intRTLEventDestroy;
|
||||
RTLEventSetEvent :=@intRTLEventSetEvent;
|
||||
RTLEventResetEvent :=@intRTLEventResetEvent;
|
||||
RTLEventStartWait :=@intRTLEventStartWait;
|
||||
RTLEventWaitFor :=@intRTLEventWaitFor;
|
||||
RTLEventWaitForTimeout :=@intRTLEventWaitForTimeout;
|
||||
end;
|
||||
SetThreadManager(WinThreadManager);
|
||||
InitHeapMutexes;
|
||||
@ -458,7 +472,14 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2005-02-08 16:28:27 peter
|
||||
Revision 1.3 2005-04-09 17:26:08 florian
|
||||
+ classes.mainthreadid is set now
|
||||
+ rtleventresetevent
|
||||
+ rtleventwairfor with timeout
|
||||
+ checksynchronize with timeout
|
||||
* race condition in synchronize fixed
|
||||
|
||||
Revision 1.2 2005/02/08 16:28:27 peter
|
||||
pulseevent -> setevent
|
||||
|
||||
Revision 1.1 2005/02/06 13:06:20 peter
|
||||
|
Loading…
Reference in New Issue
Block a user