+ classes.mainthreadid is set now

+ rtleventresetevent
  + rtleventwairfor with timeout
  + checksynchronize with timeout
  * race condition in synchronize fixed
This commit is contained in:
florian 2005-04-09 17:26:08 +00:00
parent 7a4ced093f
commit 710dbcef0a
4 changed files with 94 additions and 18 deletions

View File

@ -238,6 +238,12 @@ begin
currenttm.rtleventsetEvent(state); currenttm.rtleventsetEvent(state);
end; end;
procedure RTLeventResetEvent(state:pRTLEvent);
begin
currenttm.rtleventResetEvent(state);
end;
procedure RTLeventStartWait(state:pRTLEvent); procedure RTLeventStartWait(state:pRTLEvent);
begin begin
@ -250,6 +256,12 @@ begin
currenttm.rtleventWaitFor(state); currenttm.rtleventWaitFor(state);
end; end;
procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
begin
currenttm.rtleventWaitForTimeout(state,timeout);
end;
procedure RTLeventsync(m:trtlmethod;p:tprocedure); procedure RTLeventsync(m:trtlmethod;p:tprocedure);
begin begin
@ -319,7 +331,11 @@ end;
function NoGetCurrentThreadId : dword; function NoGetCurrentThreadId : dword;
begin begin
NoThreadError; if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
result:=ThreadID;
end; end;
procedure NoCriticalSection(var CS); procedure NoCriticalSection(var CS);
@ -411,22 +427,27 @@ begin
end; end;
procedure NORTLeventStartWait(state:pRTLEvent); procedure NORTLeventStartWait(state:pRTLEvent);
begin
begin
NoThreadError; NoThreadError;
end; end;
procedure NORTLeventWaitFor(state:pRTLEvent); procedure NORTLeventWaitFor(state:pRTLEvent);
begin
begin
NoThreadError; NoThreadError;
end; end;
procedure NORTLeventWaitForTimeout(state:pRTLEvent;timeout : longint);
begin
NoThreadError;
end;
procedure NORTLeventsync(m:trtlmethod;p:tprocedure); procedure NORTLeventsync(m:trtlmethod;p:tprocedure);
begin
begin
NoThreadError; NoThreadError;
end; end;
Var Var
@ -468,6 +489,7 @@ begin
rtleventStartWait :=@NortleventStartWait; rtleventStartWait :=@NortleventStartWait;
rtleventWaitFor :=@NortleventWaitFor; rtleventWaitFor :=@NortleventWaitFor;
rtleventsync :=@Nortleventsync; rtleventsync :=@Nortleventsync;
rtleventwaitfortimeout :=@NortleventWaitForTimeout;
end; end;
SetThreadManager(NoThreadManager); SetThreadManager(NoThreadManager);
end; end;
@ -475,7 +497,14 @@ end;
{ {
$Log$ $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 * proper error message if the cthreads unit is included too late
uses clause uses clause

View File

@ -44,6 +44,7 @@ type
TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint; TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
TBasicEventCreateHandler = function (EventAttributes :Pointer; AManualReset,InitialState : Boolean;const Name:ansistring):pEventState; TBasicEventCreateHandler = function (EventAttributes :Pointer; AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
TRTLEventHandler = procedure(AEvent:PRTLEvent); TRTLEventHandler = procedure(AEvent:PRTLEvent);
TRTLEventHandlerTimeout = procedure(AEvent:PRTLEvent;timeout : longint);
TRTLCreateEventHandler = function:PRTLEvent; TRTLCreateEventHandler = function:PRTLEvent;
TRTLEventSyncHandler = procedure (m:trtlmethod;p:tprocedure); TRTLEventSyncHandler = procedure (m:trtlmethod;p:tprocedure);
@ -77,9 +78,11 @@ type
RTLEventCreate : TRTLCreateEventHandler; RTLEventCreate : TRTLCreateEventHandler;
RTLEventDestroy : TRTLEventHandler; RTLEventDestroy : TRTLEventHandler;
RTLEventSetEvent : TRTLEventHandler; RTLEventSetEvent : TRTLEventHandler;
RTLEventResetEvent : TRTLEventHandler;
RTLEventStartWait : TRTLEventHandler; RTLEventStartWait : TRTLEventHandler;
RTLEventWaitFor : TRTLEventHandler; RTLEventWaitFor : TRTLEventHandler;
RTLEventSync : TRTLEventSyncHandler; RTLEventSync : TRTLEventSyncHandler;
RTLEventWaitForTimeout : TRTLEventHandlerTimeout;
end; end;
{***************************************************************************** {*****************************************************************************
@ -144,13 +147,22 @@ function basiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
function RTLEventCreate :PRTLEvent; function RTLEventCreate :PRTLEvent;
procedure RTLeventdestroy(state:pRTLEvent); procedure RTLeventdestroy(state:pRTLEvent);
procedure RTLeventSetEvent(state:pRTLEvent); procedure RTLeventSetEvent(state:pRTLEvent);
procedure RTLeventResetEvent(state:pRTLEvent);
procedure RTLeventStartWait(state:pRTLEvent); procedure RTLeventStartWait(state:pRTLEvent);
procedure RTLeventWaitFor(state:pRTLEvent); procedure RTLeventWaitFor(state:pRTLEvent);
procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
procedure RTLeventsync(m:trtlmethod;p:tprocedure); procedure RTLeventsync(m:trtlmethod;p:tprocedure);
{ {
$Log$ $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 * another "transfer to linux"-commit
Revision 1.27 2005/02/14 17:13:29 peter Revision 1.27 2005/02/14 17:13:29 peter

View File

@ -527,6 +527,13 @@ begin
pthread_mutex_unlock(@p^.mutex); pthread_mutex_unlock(@p^.mutex);
end; end;
procedure intRTLEventResetEvent(AEvent: PRTLEvent);
begin
{ events before startwait are ignored unix }
end;
procedure intRTLEventStartWait(AEvent: PRTLEvent); procedure intRTLEventStartWait(AEvent: PRTLEvent);
var p:pintrtlevent; var p:pintrtlevent;
@ -634,7 +641,14 @@ finalization
end. end.
{ {
$Log$ $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 * proper error message if the cthreads unit is included too late
uses clause uses clause

View File

@ -396,18 +396,30 @@ begin
SetEvent(THANDLE(AEvent)); SetEvent(THANDLE(AEvent));
end; end;
procedure intRTLEventResetEvent(AEvent: PRTLEvent);
begin
ResetEvent(THANDLE(AEvent));
end;
procedure intRTLEventStartWait(AEvent: PRTLEvent); procedure intRTLEventStartWait(AEvent: PRTLEvent);
begin 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; end;
procedure intRTLEventWaitFor(AEvent: PRTLEvent); procedure intRTLEventWaitFor(AEvent: PRTLEvent);
CONST const
INFINITE=-1; INFINITE=-1;
begin begin
WaitForSingleObject(THANDLE(AEvent), INFINITE); WaitForSingleObject(THANDLE(AEvent), INFINITE);
end; end;
procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
begin
WaitForSingleObject(THANDLE(AEvent), timeout);
end;
Var Var
@ -447,8 +459,10 @@ begin
RTLEventCreate :=@intRTLEventCreate; RTLEventCreate :=@intRTLEventCreate;
RTLEventDestroy :=@intRTLEventDestroy; RTLEventDestroy :=@intRTLEventDestroy;
RTLEventSetEvent :=@intRTLEventSetEvent; RTLEventSetEvent :=@intRTLEventSetEvent;
RTLEventResetEvent :=@intRTLEventResetEvent;
RTLEventStartWait :=@intRTLEventStartWait; RTLEventStartWait :=@intRTLEventStartWait;
RTLEventWaitFor :=@intRTLEventWaitFor; RTLEventWaitFor :=@intRTLEventWaitFor;
RTLEventWaitForTimeout :=@intRTLEventWaitForTimeout;
end; end;
SetThreadManager(WinThreadManager); SetThreadManager(WinThreadManager);
InitHeapMutexes; InitHeapMutexes;
@ -458,7 +472,14 @@ end;
{ {
$Log$ $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 pulseevent -> setevent
Revision 1.1 2005/02/06 13:06:20 peter Revision 1.1 2005/02/06 13:06:20 peter